8ffc2f68c5
Five fixes shaken out by running jank-lang/clojure-test-suite: - = short-circuits on identity like Util.equiv's k1 == k2, so (= s s) on an infinite lazy seq answers true instead of walking forever. Numbers keep the exactness-aware arm ((= ##NaN ##NaN) stays false like the JVM's). - Calling a non-fn names the operator's CLASS in the ClassCastException, like the JVM — never the value, whose printed form may be unbounded: ((range)) must throw, not hang rendering an infinite seq. - realized? on a seq cell answers by its forced flag (the rest of a realized lazy chain is a cseq under jolt's seq model), and the overlay's unsupported- type error names the class, not the (possibly infinite) value. - clojure.test/is dispatches a REGISTERED assert-expr method before its by-name inline paths, like clojure.test where the built-ins are just pre-registered methods — so an alias-qualified p/thrown? (the suite's portability helper) isn't captured by the built-in thrown? path, which read its body as a class. - clojure.test tracks tests and fixtures per namespace: deftest records its defining ns, use-fixtures registers under the calling ns (no more cross-ns clobbering), (run-tests 'ns ...) runs only those namespaces like clojure.test, and each run-tests call prints/returns its own summary (global counters stay cumulative for the n-pass/n-fail harness API). Re-mint (20-coll.clj is seed; prelude only). +2 JVM-certified corpus rows; the clojure-test fixture pins the alias-qualified assert-expr, per-call summaries, and ns filtering.
65 lines
2.6 KiB
Clojure
65 lines
2.6 KiB
Clojure
;; Self-checking regression for clojure.test: the assert-expr / do-report / report
|
|
;; extension points plus the built-in is/are/testing/thrown?/use-fixtures surface.
|
|
;; Run via bin/joltc; prints a single sentinel line the smoke gate greps for.
|
|
(ns clojure-test-selfcheck
|
|
(:require [clojure.test :as t :refer [deftest is are testing use-fixtures run-tests]]))
|
|
|
|
;; a library-style custom assertion registered through the assert-expr seam
|
|
(defmethod t/assert-expr 'near? [msg form]
|
|
(let [[_ a b] form]
|
|
`(if (< (let [d# (- ~a ~b)] (if (neg? d#) (- d#) d#)) 0.01)
|
|
(clojure.test/do-report {:type :pass})
|
|
(clojure.test/do-report {:type :fail :message ~msg :form '~form}))))
|
|
|
|
;; an ALIAS-QUALIFIED registered assertion whose simple name collides with the
|
|
;; built-in thrown? — the registered method must win over the by-name inline
|
|
;; path (clojure-test-suite's portability/thrown? registers exactly this shape).
|
|
(defmethod t/assert-expr 'p/thrown? [msg form]
|
|
`(try
|
|
(do ~@(rest form))
|
|
(clojure.test/do-report {:type :fail :message ~msg :form '~form})
|
|
(catch Throwable e#
|
|
(clojure.test/do-report {:type :pass})
|
|
e#)))
|
|
|
|
;; a custom report type (how test.check surfaces trial/shrink progress)
|
|
(def trials (atom 0))
|
|
(defmethod t/report ::trial [_m] (swap! trials inc))
|
|
|
|
(def setups (atom 0))
|
|
(use-fixtures :each (fn [f] (swap! setups inc) (f)))
|
|
|
|
(deftest builtins
|
|
(testing "equality + predicate"
|
|
(is (= 1 1))
|
|
(is (vector? [1])))
|
|
(are [x y] (= x y)
|
|
2 (+ 1 1)
|
|
6 (* 2 3))
|
|
(is (thrown? clojure.lang.ExceptionInfo (throw (ex-info "x" {}))))
|
|
(is (thrown-with-msg? Exception #"bad" (throw (ex-info "bad" {}))))
|
|
(is (near? 1.0 1.005))
|
|
(is (p/thrown? (throw (ex-info "boom" {})))))
|
|
|
|
(deftest expected-fail
|
|
(is (= 1 2))
|
|
(is (near? 1.0 5.0)))
|
|
|
|
;; run-tests returns THIS call's summary; with explicit nses it runs only their
|
|
;; tests (an unknown ns runs nothing).
|
|
(def r1 (run-tests))
|
|
(def r2 (run-tests 'no.such.test-ns))
|
|
(t/do-report {:type ::trial})
|
|
(t/do-report {:type ::trial})
|
|
|
|
;; 8 pass (= + vector? + 2 are rows + thrown? + thrown-with-msg? + near? + p/thrown?),
|
|
;; 2 fail (= 1 2, near? 1.0 5.0), 0 error, 2 fixture runs, 2 custom reports
|
|
(let [ok (and (= (t/n-pass) 8) (= (t/n-fail) 2) (= (t/n-error) 0)
|
|
(= 2 (:test r1)) (= 8 (:pass r1)) (= 2 (:fail r1))
|
|
(= 0 (:test r2)) (= 0 (:pass r2))
|
|
(= @setups 2) (= @trials 2))]
|
|
(println (if ok
|
|
"CLOJURE-TEST OK"
|
|
(str "CLOJURE-TEST FAIL pass=" (t/n-pass) " fail=" (t/n-fail)
|
|
" error=" (t/n-error) " r1=" (pr-str r1) " r2=" (pr-str r2)
|
|
" setups=" @setups " trials=" @trials))))
|