Fix 4 clojure.core bugs surfaced by JVM certification

The corpus certifier (test/conformance) flagged four cases where jolt's
hand-written :expected matched a real defect rather than Clojure. Fixed in the
jolt-core overlay, corrected the spec :expected, re-certified against JVM Clojure:

- ex-message: returns nil for a non-throwable (dropped the lenient string branch);
  still returns the message for ex-info. (jolt-l8e8)
- munge: preserves the argument's type — a symbol munges to a symbol, not a string.
  (jolt-hc35)
- print: (print nil) emits "nil", not "" (top-level nil guard; str yields "").
  (jolt-pqio)
- bounded-count: uses the counted? fast path (full count), else counts up to n via
  seq — was (min n (count coll)), wrong for counted colls. Added an uncounted-coll
  spec case. (jolt-2507)

Removed the 4 :bug entries from known-divergences.edn (now certified), regenerated
corpus + profile, re-minted the Chez bootstrap seed (clojure.core changed). Gates:
Janet 155/0, JVM certify clean, both Chez corpus gates 2534 (floors raised),
bootstrap 6/6, fixpoint intact.
This commit is contained in:
Yogthos 2026-06-20 11:06:33 -04:00
parent f54e99cc08
commit 6abbea3835
12 changed files with 329 additions and 345 deletions

View file

@ -168,7 +168,7 @@
{:suite "exceptions / ex-info" :label "rethrow preserves ex" :expected "\"inner\"" :actual "(try (try (throw (ex-info \"inner\" {})) (catch :default e (throw e))) (catch :default e (ex-message e)))"}
{:suite "exceptions / ex-info" :label "ex-data on non-ex" :expected "nil" :actual "(ex-data 42)"}
{:suite "exceptions / ex-info" :label "ex-cause on non-ex" :expected "nil" :actual "(ex-cause {:k 1})"}
{:suite "exceptions / ex-info" :label "ex-message of string" :expected "\"hi\"" :actual "(ex-message \"hi\")"}
{:suite "exceptions / ex-info" :label "ex-message of string" :expected "nil" :actual "(ex-message \"hi\")"}
{:suite "forms / case" :label "bool" :expected ":yes" :actual "(case true true :yes false :no :default)"}
{:suite "forms / case" :label "keyword match" :expected ":b" :actual "(case :a :x :wrong :a :b :default)"}
{:suite "forms / case" :label "number match" :expected ":two" :actual "(case 2 1 :one 2 :two :default)"}
@ -278,7 +278,7 @@
{:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "denominator throws" :expected :throws :actual "(denominator 1)"}
{:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "supers empty set" :expected "#{}" :actual "(supers 1)"}
{:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "munge dashes" :expected "\"a_b\"" :actual "(munge \"a-b\")"}
{:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "munge symbol" :expected "\"x_y\"" :actual "(munge (quote x-y))"}
{:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "munge symbol" :expected "(quote x_y)" :actual "(munge (quote x-y))"}
{:suite "clojure.core / leaf batch (complement fnil munge etc.)" :label "test no-test" :expected ":no-test" :actual "(test (quote foo))"}
{:suite "clojure.core / leaf batch 2" :label "key" :expected "1" :actual "(key (first {1 :a}))"}
{:suite "clojure.core / leaf batch 2" :label "val" :expected ":a" :actual "(val (first {1 :a}))"}
@ -669,7 +669,7 @@
{:suite "io / print family (overlay)" :label "println appends newline" :expected "\"x 1\\n\"" :actual "(with-out-str (println \"x\" 1))"}
{:suite "io / print family (overlay)" :label "prn is readable + newline" :expected "\"[1 \\\"s\\\"]\\n\"" :actual "(with-out-str (prn [1 \"s\"]))"}
{:suite "io / print family (overlay)" :label "pr writes no newline" :expected "\"\\\\a\"" :actual "(with-out-str (pr \\a))"}
{:suite "io / print family (overlay)" :label "print nil arg" :expected "\"\"" :actual "(with-out-str (print nil))"}
{:suite "io / print family (overlay)" :label "print nil arg" :expected "\"nil\"" :actual "(with-out-str (print nil))"}
{:suite "io / print family (overlay)" :label "prn keyword" :expected "\":k\\n\"" :actual "(with-out-str (prn :k))"}
{:suite "io / print-method multimethod" :label "records print canonically" :expected "\"#user.Pt{:x 1, :y 2}\"" :actual "(do (defrecord Pt [x y]) (pr-str (->Pt 1 2)))"}
{:suite "io / print-method multimethod" :label "records nested in colls" :expected "\"[#user.Pt{:x 1, :y 2}]\"" :actual "(do (defrecord Pt [x y]) (pr-str [(->Pt 1 2)]))"}
@ -1927,7 +1927,8 @@
{:suite "seq / overlay-migrated fns" :label "drop-last n" :expected "[1 2]" :actual "(drop-last 2 [1 2 3 4])"}
{:suite "seq / overlay-migrated fns" :label "split-with" :expected "[[2 4] [5 6]]" :actual "(split-with even? [2 4 5 6])"}
{:suite "seq / overlay-migrated fns" :label "replicate" :expected "[:x :x :x]" :actual "(replicate 3 :x)"}
{:suite "seq / overlay-migrated fns" :label "bounded-count" :expected "3" :actual "(bounded-count 3 [1 2 3 4 5])"}
{:suite "seq / overlay-migrated fns" :label "bounded-count" :expected "5" :actual "(bounded-count 3 [1 2 3 4 5])"}
{:suite "seq / overlay-migrated fns" :label "bounded-count uncounted" :expected "3" :actual "(bounded-count 3 (filter odd? (range 100)))"}
{:suite "seq / overlay-migrated fns" :label "run! side effects" :expected "6" :actual "(let [a (atom 0)] (run! (fn [x] (swap! a + x)) [1 2 3]) @a)"}
{:suite "seq / overlay-migrated fns" :label "completing wraps rf" :expected "3" :actual "((completing +) 1 2)"}
{:suite "seq / overlay-migrated fns" :label "comparator <" :expected "[1 2 3]" :actual "(sort (comparator <) [3 1 2])"}

View file

@ -289,7 +289,7 @@
# (`(...)/`[...]/`{...}/`#{...} via __sqcat/__sqvec/__sqmap/__sqset) run at runtime.
# 2280->2295, 0 new divergences.
# Strided runs scale down.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2533")))
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_PRELUDE_FLOOR") "2534")))
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))

View file

@ -166,7 +166,7 @@
# Regression floor: raise as the Chez-hosted compiler closes gaps. The gate fails
# on any NEW divergence or if pass drops below the floor. Strided runs scale to 0.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2533")))
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2534")))
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))

View file

@ -1,9 +1,7 @@
{:doc
"Known divergences of test/chez/corpus.edn :expected from JVM Clojure, classified. Most are deliberate jolt-specific or host-model differences (-> :features in conformance inc3). :bug entries are genuine and tracked. The certifier (certify.clj) gates on NEW (unlisted) divergences only. Keyed by [suite label].",
:legend
{:bug
"genuine jolt/corpus bug — tracked bead, fix in jolt-core + correct :expected",
:numeric-model
{:numeric-model
"jolt is all-double: no Ratio/BigDecimal/float; (/ 1 2)=>0.5, 3.0 prints 3",
:concurrency-model
"Janet isolated-heap snapshot futures/agents/pmap; atoms snapshot, not shared",
@ -18,23 +16,7 @@
:impl-detail
"representation detail: syntax-quote yields a list? (JVM yields a Cons)"},
:entries
[{:suite "clojure.core / leaf batch (complement fnil munge etc.)",
:label "munge symbol",
:category :bug,
:bead "jolt-hc35"}
{:suite "exceptions / ex-info",
:label "ex-message of string",
:category :bug,
:bead "jolt-l8e8"}
{:suite "io / print family (overlay)",
:label "print nil arg",
:category :bug,
:bead "jolt-pqio"}
{:suite "seq / overlay-migrated fns",
:label "bounded-count",
:category :bug,
:bead "jolt-2507"}
{:suite "clojure.core / futures — predicates",
[{:suite "clojure.core / futures — predicates",
:label "cancel an in-flight future returns true",
:category :concurrency-model,
:flaky true}

View file

@ -1,11 +1,10 @@
{:doc
"Conformance profile for test/chez/corpus.edn, generated by certify.clj. Each entry is a NON-portable case (keyed by [suite label]) and the host feature(s) it requires. Cases NOT listed are portable — they pass on any faithful Clojure. A runtime's conformance LEVEL = portable + the feature families it implements. See SPEC.md.",
:clojure-version "1.12.5",
:portable-count 2670,
:non-portable-count 249,
:portable-count 2674,
:non-portable-count 246,
:feature-counts
{:bug 4,
:concurrency/snapshot 4,
{:concurrency/snapshot 5,
:host/arrays 12,
:host/janet 16,
:host/jvm-interop 174,
@ -20,6 +19,10 @@
:label "tracks in-ns",
:bucket :jvm-error,
:features [:host/jvm-interop]}
{:suite "clojure.core / futures — predicates",
:label "cancel an in-flight future returns true",
:bucket :divergent,
:features [:concurrency/snapshot]}
{:suite "clojure.core / futures — snapshot (copy) semantics",
:label "captured atom is snapshotted, not shared",
:bucket :divergent,
@ -28,10 +31,6 @@
:label "bigdec",
:bucket :divergent,
:features [:numerics/double-only]}
{:suite "clojure.core / leaf batch (complement fnil munge etc.)",
:label "munge symbol",
:bucket :divergent,
:features [:bug]}
{:suite "clojure.core / leaf batch (complement fnil munge etc.)",
:label "supers empty set",
:bucket :jvm-error,
@ -149,10 +148,6 @@
:label "ex-data via catch",
:bucket :jvm-error,
:features [:host/jvm-interop]}
{:suite "exceptions / ex-info",
:label "ex-message of string",
:bucket :divergent,
:features [:bug]}
{:suite "exceptions / ex-info",
:label "propagates to outer",
:bucket :jvm-error,
@ -481,10 +476,6 @@
:label "line-seq is lazy seq",
:bucket :jvm-error,
:features [:host/jvm-interop]}
{:suite "io / print family (overlay)",
:label "print nil arg",
:bucket :divergent,
:features [:bug]}
{:suite "io / print-method multimethod",
:label "StringWriter accumulates",
:bucket :jvm-error,
@ -717,10 +708,6 @@
:label "re-pattern is regex?",
:bucket :jvm-error,
:features [:host/jvm-interop]}
{:suite "seq / overlay-migrated fns",
:label "bounded-count",
:bucket :divergent,
:features [:bug]}
{:suite "set / nil element (jolt-bn2p)",
:label "transient conj! nil",
:bucket :jvm-error,

View file

@ -43,4 +43,4 @@
"(try (try (throw (ex-info \"inner\" {})) (catch :default e (throw e))) (catch :default e (ex-message e)))"]
["ex-data on non-ex" "nil" "(ex-data 42)"]
["ex-cause on non-ex" "nil" "(ex-cause {:k 1})"]
["ex-message of string" "\"hi\"" "(ex-message \"hi\")"])
["ex-message of string" "nil" "(ex-message \"hi\")"])

View file

@ -58,7 +58,7 @@
["denominator throws" :throws "(denominator 1)"]
["supers empty set" "#{}" "(supers 1)"]
["munge dashes" "\"a_b\"" "(munge \"a-b\")"]
["munge symbol" "\"x_y\"" "(munge (quote x-y))"]
["munge symbol" "(quote x_y)" "(munge (quote x-y))"]
["test no-test" ":no-test" "(test (quote foo))"])
# Phase 2 leaf batch 2 (jolt-ded): canonical ports of key/val/select-keys/

View file

@ -65,7 +65,7 @@
["println appends newline" "\"x 1\\n\"" "(with-out-str (println \"x\" 1))"]
["prn is readable + newline" "\"[1 \\\"s\\\"]\\n\"" "(with-out-str (prn [1 \"s\"]))"]
["pr writes no newline" "\"\\\\a\"" "(with-out-str (pr \\a))"]
["print nil arg" "\"\"" "(with-out-str (print nil))"]
["print nil arg" "\"nil\"" "(with-out-str (print nil))"]
["prn keyword" "\":k\\n\"" "(with-out-str (prn :k))"])
# print-method is a real multimethod (jolt-g1r): canonical dispatch on

View file

@ -238,7 +238,8 @@
["drop-last n" "[1 2]" "(drop-last 2 [1 2 3 4])"]
["split-with" "[[2 4] [5 6]]" "(split-with even? [2 4 5 6])"]
["replicate" "[:x :x :x]" "(replicate 3 :x)"]
["bounded-count" "3" "(bounded-count 3 [1 2 3 4 5])"]
["bounded-count" "5" "(bounded-count 3 [1 2 3 4 5])"]
["bounded-count uncounted" "3" "(bounded-count 3 (filter odd? (range 100)))"]
["run! side effects" "6" "(let [a (atom 0)] (run! (fn [x] (swap! a + x)) [1 2 3]) @a)"]
["completing wraps rf" "3" "((completing +) 1 2)"]
["comparator <" "[1 2 3]" "(sort (comparator <) [3 1 2])"]