clojure.test: assert-expr / do-report / report extension points

jolt's `is` was a fixed macro with no assert-expr multimethod, and the runner
bypassed the report multimethod, so libraries couldn't register custom
assertions or custom report types (e.g. test.check's ::trial/::shrunk).

Add assert-expr (2-arg [msg form], dispatch on the form's first symbol /
:default / :always-fail), do-report routing through report, and report
:pass/:fail/:error methods that feed the counters. `is` dispatches to an
explicitly-registered assert-expr method before its inline path, so thrown?/
thrown-with-msg?/= and every built-in form stay byte-identical.

Runtime stdlib only, no re-mint. test/chez/clojure-test.clj self-checks the
extension points + full is/are/testing/thrown?/use-fixtures surface; smoke gate
runs it.

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 ]

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] <code returning an assertion 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

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))))