Fix general divergences surfaced by clojure-test-suite

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.

.gitmodules

@@ -4,3 +4,6 @@
 [submodule "vendor/sci"]
 	path = vendor/sci
 	url = https://github.com/borkdude/sci.git
+[submodule "vendor/clojure-test-suite"]
+	path = vendor/clojure-test-suite
+	url = https://github.com/jank-lang/clojure-test-suite.git

host/chez/post-prelude.ss

@@ -63,6 +63,12 @@
         ;; a lazy-seq carries its own realized? flag (lazy-bridge.ss). The overlay
         ;; realized? reads :jolt/type and throws on a jolt-lazyseq record.
         ((jolt-lazyseq? x) (jolt-lazyseq-realized? x))
+        ;; a seq cell answers by its forced flag: the rest of a realized lazy
+        ;; chain is a cseq under jolt's seq model, and (realized? (rest s)) after
+        ;; a next must be true like the JVM's realized LazySeq — never a throw
+        ;; whose message renders the (possibly infinite) seq.
+        ((cseq? x) (if (cseq-forced? x) #t #f))
+        ((empty-list-t? x) #t)
         (else (jolt-invoke overlay-realized? x))))))
 ;; clojure.edn/read over a reader: drain the jhost reader, then read through the
 ;; overlay read-string so the opts map (:readers/:default/:eof) is honored.

host/chez/seed/prelude.ss

@@ -319,7 +319,7 @@
 (guard (e (#t #f))
   (def-var! "clojure.core" "char?" (letrec ((char? (lambda (x) (let fnrec4943 ((x x)) (jolt= (jolt-get x (keyword "jolt" "type")) (keyword "jolt" "char")))))) char?)))
 (guard (e (#t #f))
-  (def-var! "clojure.core" "realized?" (letrec ((realized? (lambda (x) (let fnrec4944 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "delay?") x)) (jolt-invoke (var-deref "clojure.core" "boolean") (jolt-get x (keyword #f "realized"))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "future?") x)) (jolt-invoke (var-deref "clojure.core" "boolean") (jolt-get x (keyword #f "cached"))) (if (jolt= (keyword "jolt" "lazy-seq") (jolt-get x (keyword "jolt" "type"))) (jolt-invoke (var-deref "clojure.core" "boolean") (jolt-get x (keyword #f "realized"))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "atom?") x)) #t (if (jolt-truthy? (keyword #f "else")) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "realized? not supported on: " x)) jolt-nil))))))))) realized?)))
+  (def-var! "clojure.core" "realized?" (letrec ((realized? (lambda (x) (let fnrec4944 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "delay?") x)) (jolt-invoke (var-deref "clojure.core" "boolean") (jolt-get x (keyword #f "realized"))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "future?") x)) (jolt-invoke (var-deref "clojure.core" "boolean") (jolt-get x (keyword #f "cached"))) (if (jolt= (keyword "jolt" "lazy-seq") (jolt-get x (keyword "jolt" "type"))) (jolt-invoke (var-deref "clojure.core" "boolean") (jolt-get x (keyword #f "realized"))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "atom?") x)) #t (if (jolt-truthy? (keyword #f "else")) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "realized? not supported on: " (jolt-invoke (var-deref "clojure.core" "class") x))) jolt-nil))))))))) realized?)))
 (guard (e (#t #f))
   (def-var! "clojure.core" "force" (letrec ((force (lambda (x) (let fnrec4945 ((x x)) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "delay?") x)) (jolt-invoke (var-deref "clojure.core" "deref") x) x))))) force)))
 (guard (e (#t #f))

host/chez/seq.ss

@@ -257,12 +257,18 @@
      => (lambda (m) (apply jolt-invoke m f args)))
     ((and (reified-methods f) (hashtable-ref (reified-methods f) "invoke" #f))
      => (lambda (m) (apply jolt-invoke m f args)))
-    ;; calling a non-fn: a ClassCastException naming the operator, thrown via
+    ;; calling a non-fn: a ClassCastException naming the operator's CLASS (like
-    ;; jolt-throw so it is catchable and carries the throw-site continuation for a
+    ;; the JVM's "class clojure.lang.LazySeq cannot be cast to ... IFn" — never
-    ;; stack trace.
+    ;; the value, whose printed form may be unbounded: ((range)) must throw, not
+    ;; hang rendering an infinite seq). Thrown via jolt-throw so it is catchable
+    ;; and carries the throw-site continuation for a stack trace.
     (else (jolt-throw (jolt-host-throwable "java.lang.ClassCastException"
-                        (string-append (guard (e (#t "value")) (jolt-pr-str f))
+                        (string-append
-                                       " cannot be cast to clojure.lang.IFn"))))))
+                          "class "
+                          (guard (e (#t "value"))
+                            (let ((c (jolt-class-name f)))
+                              (if (string? c) c (jolt-pr-str f))))
+                          " cannot be cast to class clojure.lang.IFn"))))))
 
 ;; ============================================================================
 ;; chunked-seq accessors — the host side of the Clojure IChunkedSeq contract

host/chez/values.ss

@@ -96,10 +96,16 @@
     ((and (jolt-coll? a) (jolt-coll? b)) (jolt-coll=? a b))
     (else (eq? a b))))
 (define (jolt=2 a b)
+  ;; identity fast path, like Util.equiv's k1 == k2: the same object equals
+  ;; itself without a structural walk — (= s s) on an infinite lazy seq must not
+  ;; realize it. Numbers keep the exactness-aware arm (Chez may intern flonum
+  ;; literals, and (= ##NaN ##NaN) is false like the JVM's).
+  (if (and (eq? a b) (not (number? a)))
+      #t
       (let loop ((as jolt-eq-arms))
         (cond ((null? as) (jolt=2-base a b))
               (((caar as) a b) ((cdar as) a b))
-          (else (loop (cdr as))))))
+              (else (loop (cdr as)))))))
 (define (jolt= a . rest)
   (let loop ((a a) (rest rest))
     (cond ((null? rest) #t)

jolt-core/clojure/core/20-coll.clj

@@ -426,7 +426,9 @@
     (future? x) (boolean (get x :cached))
     (= :jolt/lazy-seq (get x :jolt/type)) (boolean (get x :realized))
     (atom? x) true
-    :else (throw (str "realized? not supported on: " x))))
+    ;; name the class, never the value — an error message must not render an
+    ;; arbitrary (possibly infinite) argument.
+    :else (throw (str "realized? not supported on: " (class x)))))
 
 (defn force [x] (if (delay? x) (deref x) x))
 

stdlib/clojure/test.clj

@@ -19,8 +19,8 @@
 (def jolt-report counters)                ;; alias used by the suite harness
 (def ctx-stack (atom []))
 (def registry (atom []))                ;; [{:name sym :fn thunk}]
-(def once-fixtures (atom []))
+(def once-fixtures (atom {}))           ;; ns-sym -> [fixture-fns]
-(def each-fixtures (atom []))
+(def each-fixtures (atom {}))           ;; ns-sym -> [fixture-fns]
 
 ;; clojure.test/*testing-vars* — the stack of vars under test. Real clojure.test
 ;; binds it around each test var; test.check's default reporter reads it, so a
@@ -32,8 +32,8 @@
   (reset! counters {:test 0 :pass 0 :fail 0 :error 0 :fails []})
   (reset! ctx-stack [])
   (reset! registry [])
-  (reset! once-fixtures [])
+  (reset! once-fixtures {})
-  (reset! each-fixtures []))
+  (reset! each-fixtures {}))
 
 (defn- ctx-str [] (str/join " " @ctx-stack))
 
@@ -135,6 +135,15 @@
   ([form] `(is ~form nil))
   ([form msg]
    (cond
+     ;; a library-registered custom assertion (the assert-expr extension point)
+     ;; wins over every inline path, like clojure.test, where each `is` dispatches
+     ;; assert-expr on the exact head symbol and the built-ins are just
+     ;; pre-registered methods. In particular a registered alias-qualified
+     ;; `p/thrown?` must not be captured by the by-name thrown? path below.
+     (and (seq? form) (symbol? (first form))
+          (contains? (methods clojure.test/assert-expr) (first form)))
+     (clojure.test/assert-expr msg form)
+
      ;; (is (thrown? Class body...))
      (thrown-form? form "thrown?")
      (let [klass-sym (second form)
@@ -172,13 +181,6 @@
                 (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)
-
      ;; a predicate call — (= a b), (< x y), (pred? v): evaluate the args so a
      ;; failure shows the actual values, like clojure.test's assert-predicate.
      (and (seq? form) (contains? clojure.test/reported-preds (first form)))
@@ -209,7 +211,9 @@
 (defmacro deftest [name & body]
   `(do
      (defn ~name [] ~@body)
-     (swap! clojure.test/registry conj {:name '~name :fn ~name})
+     (swap! clojure.test/registry conj {:name '~name
+                                        :ns (clojure.core/ns-name clojure.core/*ns*)
+                                        :fn ~name})
      (var ~name)))
 
 (defmacro are [argv expr & data]
@@ -222,10 +226,15 @@
 
 ;; --- fixtures + run --------------------------------------------------------
 
+;; Fixtures are per-namespace, like clojure.test (which stores them in ns
+;; metadata): use-fixtures records them under the calling ns, and only that
+;; ns's tests run through them — a suite loading many test namespaces into one
+;; process doesn't cross-apply or clobber another ns's fixtures.
 (defn use-fixtures [kind & fns]
+  (let [n (ns-name *ns*)]
     (cond
-    (= kind :once) (reset! once-fixtures (vec fns))
+      (= kind :once) (swap! once-fixtures assoc n (vec fns))
-    (= kind :each) (reset! each-fixtures (vec fns))))
+      (= kind :each) (swap! each-fixtures assoc n (vec fns)))))
 
 (defn- wrap-fixtures [fixtures body-fn]
   (if (empty? fixtures)
@@ -234,25 +243,46 @@
 
 (defn- run-one [t]
   (swap! counters update :test inc)
-  (wrap-fixtures @each-fixtures
+  (wrap-fixtures (get @each-fixtures (:ns t) [])
     (fn []
       (try
         ((:fn t))
         (catch Throwable e
           (err! (str (:name t) " crashed: " (err-text e))))))))
 
-(defn run-registered []
+;; Run the registered tests grouped by namespace (registration order preserved
-  (doseq [t @registry] (run-one t))
+;; within each ns), each group wrapped in its ns's :once fixtures. ns-set nil
+;; means all.
+(defn- run-selected [ns-set]
+  (let [ts (if ns-set (filter (fn [t] (contains? ns-set (:ns t))) @registry) @registry)]
+    (doseq [n (distinct (map :ns ts))]
+      (wrap-fixtures (get @once-fixtures n [])
+        (fn [] (doseq [t ts :when (= n (:ns t))] (run-one t))))))
   nil)
 
-(defn run-tests [& _nses]
+(defn run-registered [] (run-selected nil))
-  (wrap-fixtures @once-fixtures (fn [] (run-registered)))
+
-  (let [r @counters]
+;; (run-tests 'ns1 'ns2 …) runs only those namespaces' tests, like clojure.test.
+;; With no args it runs everything registered (a deliberate superset of the
+;; JVM's current-ns default — jolt's harnesses load then run whole suites).
+;; Prints and returns THIS call's summary; the global counters stay cumulative
+;; for the n-pass/n-fail harness API.
+(defn run-tests [& nses]
+  (let [before @counters
+        ns-set (when (seq nses)
+                 (set (map (fn [n] (if (symbol? n) n (ns-name n))) nses)))]
+    (run-selected ns-set)
+    (let [r @counters
+          d {:type :summary
+             :test  (- (:test r)  (:test before))
+             :pass  (- (:pass r)  (:pass before))
+             :fail  (- (:fail r)  (:fail before))
+             :error (- (:error r) (:error before))}]
       (println)
-    (println (str "Ran " (:test r) " tests. "
+      (println (str "Ran " (:test d) " tests. "
-                  (:pass r) " assertions passed, "
+                    (:pass d) " assertions passed, "
-                  (:fail r) " failures, " (:error r) " errors."))
+                    (:fail d) " failures, " (:error d) " errors."))
-    r))
+      d)))
 
 (defn run-test [& _] nil)
 (defn test-var [& _] nil)

test/chez/clojure-test.clj

@@ -11,6 +11,17 @@
        (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))
@@ -27,21 +38,28 @@
     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 (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)
+;; 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})
 
-;; 7 pass (= + vector? + 2 are rows + thrown? + thrown-with-msg? + near?),
+;; 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) 7) (= (t/n-fail) 2) (= (t/n-error) 0)
+(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) " setups=" @setups " trials=" @trials))))
+                  " error=" (t/n-error) " r1=" (pr-str r1) " r2=" (pr-str r2)
+                  " setups=" @setups " trials=" @trials))))

test/chez/corpus.edn

@@ -3513,4 +3513,6 @@
   {:suite "reduce / IReduceInit" :label "a deftype reduce honors reduced short-circuit" :expected "3" :actual "(do (deftype Rng [n] clojure.lang.IReduceInit (reduce [_ f init] (loop [i 0 acc init] (if (< i n) (let [a (f acc i)] (if (reduced? a) @a (recur (inc i) a))) acc)))) (reduce (fn [acc x] (if (= x 3) (reduced acc) (+ acc x))) 0 (->Rng 10)))"}
   {:suite "exceptions / typed throw" :label "a jolt-raised NumberFormatException reports its real class and message" :expected "[\"java.lang.NumberFormatException\" \"For input string: \\\"xyz\\\"\"]" :actual "(try (Long/parseLong \"xyz\") (catch Throwable e [(.getName (class e)) (.getMessage e)]))"}
   {:suite "exceptions / hierarchy catch" :label "a typed throwable matches its superclasses, not unrelated ones" :expected "[true true true false]" :actual "(let [e (try (Long/parseLong \"z\") (catch Throwable e e))] [(instance? NumberFormatException e) (instance? IllegalArgumentException e) (instance? Exception e) (instance? java.io.IOException e)])"}
+  {:suite "equality / identity" :label "= short-circuits on identity without realizing a lazy seq (Util.equiv k1 == k2)" :expected "0" :actual "(let [n (atom 0) s (map (fn [x] (swap! n inc) x) [1 2 3])] (= s s) @n)"}
+  {:suite "realized? / lazy seq" :label "realized? reads a lazy seq's realization flag" :expected "[false true]" :actual "(let [s (map inc [1 2 3])] [(realized? s) (do (doall s) (realized? s))])"}
 ]

vendor/clojure-test-suite

@@ -0,0 +1 @@
+Subproject commit 489b6743e8421687ef96cec557830acf258d1886