b520eefa7a
The corpus carried hand-written :expected values — a regression suite but a weak spec (it checked jolt against its authors, not against Clojure). certify.clj runs every corpus row's :actual and :expected through reference JVM Clojure 1.12.5 (fresh user ns per case, output/stdin sunk, 5s per-case watchdog) and compares with =. Result: of ~2487 vanilla-certifiable rows, 2416 match real Clojure exactly. The 71 divergences are all classified in known-divergences.edn — mostly deliberate jolt-specific/host-model deltas (all-double numerics, snapshot concurrency, no-JVM host model, jolt reader features, printer, strictness), plus 4 genuine bugs filed as beads (jolt-l8e8 ex-message, jolt-hc35 munge, jolt-pqio print-nil, jolt-2507 bounded-count). certify-test.janet gates it: skips without clojure on PATH, else fails only on a NEW (unclassified) divergence or stale allowlist entry; flaky timing-dependent cases (future-cancel) tolerated either way. Full gate 155 files 0 failed.
191 lines
9.8 KiB
Clojure
191 lines
9.8 KiB
Clojure
;; certify.clj (jolt-xsfe) — certify the jolt corpus against reference JVM Clojure.
|
|
;;
|
|
;; The corpus (test/chez/corpus.edn) carries hand-written :expected values. This
|
|
;; script runs each row's :actual and :expected through REAL JVM Clojure and checks
|
|
;; whether jolt's :expected matches what canonical Clojure produces. It turns the
|
|
;; corpus from "our test cases" into "a suite pinned to the reference implementation"
|
|
;; — and surfaces any row where the hand-written answer is actually wrong.
|
|
;;
|
|
;; Each row is evaluated in a throwaway namespace so top-level defs don't leak.
|
|
;; Buckets per row:
|
|
;; :certified jolt :expected == JVM result (the good case)
|
|
;; :certified-throws :expected is :throws and JVM also throws
|
|
;; :divergent both evaluate but jolt :expected != JVM result (CORPUS BUG)
|
|
;; :throws-mismatch :expected :throws but JVM did NOT throw (or vice versa)
|
|
;; :jvm-error :actual errors on vanilla Clojure (jolt-specific / host-coupled
|
|
;; / not certifiable against the JVM) — informational, not a bug
|
|
;; :read-error :actual or :expected won't even read on the JVM reader
|
|
;;
|
|
;; Run from the repo root:
|
|
;; clojure -M test/conformance/certify.clj [corpus.edn] [--edn out.edn]
|
|
(ns certify
|
|
(:require [clojure.edn :as edn]
|
|
[clojure.string :as str]
|
|
[clojure.set]
|
|
[clojure.pprint :as pp]))
|
|
|
|
(def corpus-path
|
|
(or (first (remove #(str/starts-with? % "--") *command-line-args*))
|
|
"test/chez/corpus.edn"))
|
|
|
|
(def edn-out
|
|
(let [args (vec *command-line-args*)
|
|
i (.indexOf args "--edn")]
|
|
(when (and (>= i 0) (< (inc i) (count args))) (nth args (inc i)))))
|
|
|
|
;; Classified allowlist of known divergences (deliberate jolt-specific / host-model
|
|
;; differences + tracked bugs). The gate fails only on a NEW (unlisted) divergence
|
|
;; or throws-mismatch. Keyed by [suite label].
|
|
(def allowlist-path "test/conformance/known-divergences.edn")
|
|
(def allowlist-entries
|
|
(if (.exists (java.io.File. allowlist-path))
|
|
(:entries (edn/read-string (slurp allowlist-path)))
|
|
[]))
|
|
;; Non-flaky known divergences: gated for both NEW and STALE.
|
|
(def known
|
|
(->> allowlist-entries (remove :flaky) (map (juxt :suite :label)) set))
|
|
;; Flaky entries: the JVM result is inherently nondeterministic (e.g. future-cancel
|
|
;; racing future completion), so they are always tolerated whether or not they
|
|
;; diverge on a given run — never NEW, never stale.
|
|
(def flaky
|
|
(->> allowlist-entries (filter :flaky) (map (juxt :suite :label)) set))
|
|
|
|
;; Read a Clojure source string into a single form, wrapping multi-form bodies in
|
|
;; (do ...) so a case like "(def x 1) (inc x)" evaluates as one program. Reader
|
|
;; conditionals are allowed (a few corpus rows carry #?(:clj ...)).
|
|
(defn read-program [src]
|
|
(read-string {:read-cond :allow} (str "(do " src ")")))
|
|
|
|
;; Evaluate a Clojure source string in a FRESH `user` namespace, with output and
|
|
;; stdin sunk (a case may println, (time ...), or (read) — none should touch the
|
|
;; report or block on the terminal). The ns must be named `user` (not a gensym),
|
|
;; because that is jolt's default ns and the corpus :expected values bake it in:
|
|
;; *ns*, record print tags (#user.Pt), syntax-quote qualification (user/foo), and
|
|
;; var print (#'user/v) all render the current ns name. Recreating `user` per case
|
|
;; both names it correctly AND drops the previous case's defs. Never throws;
|
|
;; returns [:ok value] / [:throw throwable] / [:read-error throwable].
|
|
(defn eval-isolated [src]
|
|
(let [sink (java.io.StringWriter.)
|
|
empty-in (java.io.PushbackReader. (java.io.StringReader. ""))]
|
|
(try
|
|
(remove-ns 'user)
|
|
(let [the-ns (create-ns 'user)]
|
|
(binding [*ns* the-ns *out* sink *err* sink *in* empty-in]
|
|
(clojure.core/refer-clojure)
|
|
(let [form (try (read-program src)
|
|
(catch Throwable t (throw (ex-info "read" {::read t}))))]
|
|
[:ok (eval form)])))
|
|
(catch clojure.lang.ExceptionInfo e
|
|
(if (::read (ex-data e)) [:read-error (::read (ex-data e))] [:throw e]))
|
|
(catch Throwable t [:throw t]))))
|
|
|
|
(def ^:const case-timeout-ms 5000)
|
|
|
|
;; Per-case wall-clock guard: an infinite lazy seq forced, a blocking read, or a
|
|
;; deadlocked future would otherwise hang the whole run. Returns [:timeout nil] if
|
|
;; the case exceeds the budget (the worker thread is cancelled best-effort).
|
|
(defn eval-safe [src]
|
|
(let [f (future (eval-isolated src))
|
|
r (deref f case-timeout-ms ::timeout)]
|
|
(if (= r ::timeout)
|
|
(do (future-cancel f) [:timeout nil])
|
|
r)))
|
|
|
|
(defn classify [row]
|
|
(let [{:keys [expected actual]} row
|
|
throws? (= expected :throws)
|
|
a (eval-safe actual)]
|
|
(cond
|
|
;; actual exceeded the per-case time budget (infinite seq / blocking / deadlock)
|
|
(= (first a) :timeout)
|
|
{:bucket :timeout :detail (str "exceeded " case-timeout-ms "ms")}
|
|
|
|
;; actual won't read on the JVM
|
|
(= (first a) :read-error)
|
|
{:bucket :read-error :detail (str "actual read: " (.getMessage ^Throwable (second a)))}
|
|
|
|
throws?
|
|
(if (= (first a) :throw)
|
|
{:bucket :certified-throws}
|
|
{:bucket :throws-mismatch
|
|
:detail (str "jolt says :throws, JVM returned " (pr-str (second a)))})
|
|
|
|
;; actual threw on the JVM — either jolt-specific/host-coupled (informational)
|
|
(= (first a) :throw)
|
|
{:bucket :jvm-error
|
|
:detail (let [m (.getMessage ^Throwable (second a))]
|
|
(if m (str/replace m #"\s+" " ") (str (class (second a)))))}
|
|
|
|
:else
|
|
(let [e (eval-safe expected)]
|
|
(cond
|
|
(= (first e) :read-error)
|
|
{:bucket :read-error :detail (str "expected read: " (.getMessage ^Throwable (second e)))}
|
|
(= (first e) :throw)
|
|
{:bucket :jvm-error :detail (str "expected eval threw: " (.getMessage ^Throwable (second e)))}
|
|
(= (second e) (second a))
|
|
{:bucket :certified}
|
|
:else
|
|
{:bucket :divergent
|
|
:detail (str "jolt-expected=" (pr-str (second e))
|
|
" JVM-result=" (pr-str (second a)))})))))
|
|
|
|
(defn -main [& _]
|
|
(let [corpus (edn/read-string (slurp corpus-path))
|
|
results (mapv (fn [row] (assoc (classify row) :row row)) corpus)
|
|
by (group-by :bucket results)
|
|
n (count results)
|
|
cnt #(count (get by % []))]
|
|
(println (format "Certifying %d corpus rows against JVM Clojure %s\n" n (clojure-version)))
|
|
(println (format " certified %5d (jolt expected == JVM)" (cnt :certified)))
|
|
(println (format " certified-throws %5d (:throws, JVM also throws)" (cnt :certified-throws)))
|
|
(println (format " jvm-error %5d (actual not certifiable on vanilla Clojure)" (cnt :jvm-error)))
|
|
(println (format " read-error %5d (won't read on JVM reader)" (cnt :read-error)))
|
|
(println (format " timeout %5d (exceeded %dms — infinite/blocking)" (cnt :timeout) case-timeout-ms))
|
|
(println (format " throws-mismatch %5d <-- jolt/JVM disagree on throwing" (cnt :throws-mismatch)))
|
|
(println (format " DIVERGENT %5d <-- corpus :expected disagrees with JVM" (cnt :divergent)))
|
|
(let [certifiable (+ (cnt :certified) (cnt :certified-throws) (cnt :divergent) (cnt :throws-mismatch))]
|
|
(println (format "\n certifiable rows: %d (certified %d / divergent %d / throws-mismatch %d)"
|
|
certifiable (+ (cnt :certified) (cnt :certified-throws))
|
|
(cnt :divergent) (cnt :throws-mismatch))))
|
|
|
|
;; Partition divergences/throws-mismatches into known (allowlisted) vs NEW.
|
|
(let [flagged (concat (get by :divergent []) (get by :throws-mismatch []))
|
|
key-of (fn [{:keys [row]}] [(:suite row) (:label row)])
|
|
new? (fn [r] (let [k (key-of r)] (and (not (known k)) (not (flaky k)))))
|
|
news (filter new? flagged)
|
|
flagged-keys (set (map key-of flagged))
|
|
stale (clojure.set/difference known flagged-keys)]
|
|
(println (format "\n allowlist: %d entries (%d flaky); %d of %d divergences known, %d NEW, %d stale"
|
|
(+ (count known) (count flaky)) (count flaky)
|
|
(- (count flagged) (count news)) (count flagged) (count news) (count stale)))
|
|
(when (seq news)
|
|
(println "\n=== NEW divergences (not in allowlist) — gate FAILS ===")
|
|
(doseq [{:keys [row detail]} news]
|
|
(println (format " [%s] %s\n actual: %s\n %s"
|
|
(:suite row) (:label row) (:actual row) detail))))
|
|
(when (seq stale)
|
|
(println "\n=== STALE allowlist entries (no longer diverging — remove them) ===")
|
|
(doseq [[s l] (sort stale)] (println (format " [%s] %s" s l))))
|
|
(def new-divergences news)
|
|
(def stale-entries stale))
|
|
|
|
;; Full per-row divergence detail goes to the --edn report (for triage); the
|
|
;; console stays quiet about KNOWN divergences (the NEW/STALE sections above are
|
|
;; what matters for the gate).
|
|
(when edn-out
|
|
(spit edn-out (with-out-str
|
|
(pp/pprint {:corpus corpus-path
|
|
:clojure-version (clojure-version)
|
|
:counts (into {} (map (fn [[k v]] [k (count v)]) by))
|
|
:divergent (mapv (fn [r] (assoc (:row r) :detail (:detail r))) (get by :divergent))
|
|
:throws-mismatch (mapv (fn [r] (assoc (:row r) :detail (:detail r))) (get by :throws-mismatch))})))
|
|
(println (format "\nwrote machine-readable report to %s" edn-out)))
|
|
|
|
;; Gate: fail only on a NEW (unlisted) divergence or a stale allowlist entry.
|
|
;; Every current divergence is either intentional (classified in the allowlist)
|
|
;; or a tracked bug — so a clean run means the corpus matches reference Clojure
|
|
;; everywhere it claims to, modulo the documented jolt-specific deltas.
|
|
(System/exit (if (or (seq new-divergences) (seq stale-entries)) 1 0))))
|
|
|
|
(apply -main *command-line-args*)
|