diff --git a/host/chez/smoke.sh b/host/chez/smoke.sh index 11eacf4..25818ae 100755 --- a/host/chez/smoke.sh +++ b/host/chez/smoke.sh @@ -46,5 +46,17 @@ check '(== 3 3.0)' 'true' check_loc '(throw (ex-info "boom" {}))' ' at 1:' check_loc '(do (+ 1 1) (/ 1 0))' ' at 1:' +# clojure.test extension points (assert-expr / do-report / report) need separate +# top-level forms — assert-expr must register before `is` expands — so this is a +# multi-form `joltc run`, not an -e one-liner. The file self-checks its tallies. +ct_out="$(bin/joltc run test/chez/clojure-test.clj 2>/dev/null)" +if printf '%s' "$ct_out" | grep -q 'CLOJURE-TEST OK'; then + pass=$((pass + 1)) +else + echo " FAIL: clojure.test extension points" + echo " $(printf '%s' "$ct_out" | grep CLOJURE-TEST | tail -1)" + fails=$((fails + 1)) +fi + echo "cli smoke: $pass passed, $fails failed" [ "$fails" -eq 0 ] diff --git a/stdlib/clojure/test.clj b/stdlib/clojure/test.clj index 8968ebd..420da95 100644 --- a/stdlib/clojure/test.clj +++ b/stdlib/clojure/test.clj @@ -66,6 +66,42 @@ (defmulti report :type) (defmethod report :default [_m] nil) +;; do-report routes a {:type …} report map through the report multimethod — the +;; seam clojure.test assertions emit through. The built-in :pass/:fail/:error +;; methods feed jolt's counters; a library can add report types (test.check's +;; ::trial/::shrunk/::complete) and they dispatch here. +(defn- report-line [m] + (str (when (:message m) (str (:message m) + (when (or (:form m) (contains? m :expected) (contains? m :actual)) " "))) + (when (:form m) (pr-str (:form m))) + (when (contains? m :expected) (str " expected: " (pr-str (:expected m)))) + (when (contains? m :actual) (str " actual: " (pr-str (:actual m)))))) +(defmethod report :pass [_m] (inc-pass!)) +(defmethod report :fail [m] (fail! (report-line m))) +(defmethod report :error [m] (err! (report-line m))) +(defn do-report [m] (report m)) + +;; assert-expr is the macro-level extension point: `is` expands a form by calling +;; (assert-expr msg form), dispatched on the form's first symbol (or :default / +;; :always-fail). A library registers a custom assertion via +;; (defmethod assert-expr 'my-pred [msg form] ). +;; 2-arg [msg form] signature matches clojure.test. `is` routes here only for a +;; symbol with an explicitly registered method, so built-in forms are unaffected. +(defmulti assert-expr (fn [_msg form] + (cond (nil? form) :always-fail + (and (seq? form) (symbol? (first form))) (first form) + :else :default))) +(defmethod assert-expr :always-fail [msg form] + `(clojure.test/do-report {:type :fail :message ~msg :form '~form})) +(defmethod assert-expr :default [msg form] + `(try + (if ~form + (clojure.test/do-report {:type :pass}) + (clojure.test/do-report {:type :fail :message ~msg :form '~form})) + (catch Throwable e# + (clojure.test/do-report {:type :error :message ~msg :form '~form + :actual (clojure.test/err-text e#)})))) + ;; --- class matching for thrown? -------------------------------------------- (defn- last-seg [s] @@ -130,6 +166,13 @@ (clojure.test/inc-pass!) (clojure.test/fail! (str "expected throw of " ~klass " matching " ~re " but got " (clojure.core/class e#) ": " m#))))))) + ;; a library-registered custom assertion (the assert-expr extension point); + ;; only fires for a symbol with an explicitly registered method, so built-in + ;; predicate forms keep the inline path below. + (and (seq? form) (symbol? (first form)) + (contains? (methods clojure.test/assert-expr) (first form))) + (clojure.test/assert-expr msg form) + :else `(try (if ~form diff --git a/test/chez/clojure-test.clj b/test/chez/clojure-test.clj new file mode 100644 index 0000000..e222ae3 --- /dev/null +++ b/test/chez/clojure-test.clj @@ -0,0 +1,47 @@ +;; 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})))) + +;; 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))) + +(deftest expected-fail + (is (= 1 2)) + (is (near? 1.0 5.0))) + +(run-tests) +(t/do-report {:type ::trial}) +(t/do-report {:type ::trial}) + +;; 7 pass (= + vector? + 2 are rows + thrown? + thrown-with-msg? + near?), +;; 2 fail (= 1 2, near? 1.0 5.0), 0 error, 2 fixture runs, 2 custom reports +(let [ok (and (= (t/n-pass) 7) (= (t/n-fail) 2) (= (t/n-error) 0) + (= @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) " setups=" @setups " trials=" @trials))))