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
parent
f54e99cc08
commit
6abbea3835
12 changed files with 329 additions and 345 deletions
File diff suppressed because one or more lines are too long
File diff suppressed because one or more lines are too long
|
|
@ -55,10 +55,16 @@
|
|||
|
||||
(defn prn [& xs] (apply pr xs) (__write "\n") nil)
|
||||
|
||||
;; print renders each arg non-readably (strings/chars unquoted) like str — except
|
||||
;; nil, which prints as "nil" (str yields ""). Only the top-level arg needs the
|
||||
;; guard; nil nested in a collection already renders as "nil" via the collection
|
||||
;; printer.
|
||||
(defn print [& xs]
|
||||
(__write (loop [out "" s (seq xs) first? true]
|
||||
(if s
|
||||
(recur (str out (if first? "" " ") (str (first s))) (next s) false)
|
||||
(let [x (first s)
|
||||
r (if (nil? x) "nil" (str x))]
|
||||
(recur (str out (if first? "" " ") r) (next s) false))
|
||||
out)))
|
||||
nil)
|
||||
|
||||
|
|
@ -210,7 +216,11 @@
|
|||
(recur (dec n) (next xs))
|
||||
xs)))
|
||||
|
||||
(defn bounded-count [n coll] (min n (count coll)))
|
||||
(defn bounded-count [n coll]
|
||||
(if (counted? coll)
|
||||
(count coll)
|
||||
(loop [i 0 s (seq coll)]
|
||||
(if (and s (< i n)) (recur (inc i) (next s)) i))))
|
||||
|
||||
(defn run! [proc coll] (reduce (fn [_ x] (proc x) nil) nil coll) nil)
|
||||
|
||||
|
|
@ -650,7 +660,6 @@
|
|||
(defn ex-message [e]
|
||||
(let [e (ex-unwrap e)]
|
||||
(cond (ex-info-val? e) (get e :message)
|
||||
(string? e) e
|
||||
:else nil)))
|
||||
(defn ex-cause [e]
|
||||
(let [e (ex-unwrap e)] (if (ex-info-val? e) (get e :cause) nil)))
|
||||
|
|
@ -785,8 +794,12 @@
|
|||
;; No class hierarchy on the Janet host.
|
||||
(defn supers [x] #{})
|
||||
|
||||
;; The kernel's munge only rewrote dashes; kept as-is for parity.
|
||||
(defn munge [s] (str-replace-all "-" "_" (str s)))
|
||||
;; Like Clojure's munge: rewrite dashes to underscores, preserving the argument's
|
||||
;; type — a symbol munges to a symbol, anything else to a string. (jolt only
|
||||
;; rewrites dashes, not the full Compiler CHAR_MAP.)
|
||||
(defn munge [s]
|
||||
(let [m (str-replace-all "-" "_" (str s))]
|
||||
(if (symbol? s) (symbol m) m)))
|
||||
|
||||
(defn test
|
||||
"Calls the :test fn from v's metadata; :ok if it runs, :no-test if absent."
|
||||
|
|
|
|||
|
|
@ -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])"}
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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}
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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\")"])
|
||||
|
|
|
|||
|
|
@ -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/
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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])"]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue