Chez Phase 0a+0b: value model + host-neutral contract gate
0a (host/chez/values.ss): Jolt value model on Chez — nil sentinel distinct from #f/'(), interned keywords, ns+meta symbols, exactness-aware = and consistent hash. Chez numeric tower gives ratios/bignums free. 33/33 tests. 0b (test/chez/): extract test/spec/*.janet defspec tables into corpus.edn (2655 cases, valid as both EDN and Janet data), and a runner that drives ANY jolt binary via the CLI boundary with per-case subprocess isolation. Pluggable target (JOLT_BIN) so the same corpus gates every host. Baseline vs Janet build/jolt: 2641/2655, 14 known CLI divergences allowlisted; gate fails only on NEW ones.
This commit is contained in:
parent
b60177b03a
commit
c9316dd372
7 changed files with 2965 additions and 0 deletions
38
test/chez/README.md
Normal file
38
test/chez/README.md
Normal file
|
|
@ -0,0 +1,38 @@
|
|||
# Chez port — Phase 0 test contract harness
|
||||
|
||||
The host-neutral correctness gate for the Chez re-host (epic jolt-cf1q). The
|
||||
spec corpus is data, so the SAME contract validates every host.
|
||||
|
||||
## Files
|
||||
- `extract-corpus.janet` — parses `test/spec/*.janet` `(defspec …)` tables as
|
||||
data and writes `corpus.edn` (2655 `[label expected actual]` cases). The file
|
||||
is valid as BOTH EDN (a future Chez-jolt runner) and Janet data (the runner
|
||||
below). Regenerate: `janet test/chez/extract-corpus.janet`.
|
||||
- `corpus.edn` — the extracted contract (generated; checked in for convenience).
|
||||
- `run-corpus.janet` — drives a TARGET jolt binary, one fresh subprocess per case
|
||||
(fresh ctx = per-case isolation), checking `(= expected actual)` prints `true`
|
||||
at the CLI, or that a `:throws` case exits non-zero. Pluggable target:
|
||||
- `janet test/chez/run-corpus.janet` # default build/jolt
|
||||
- `JOLT_BIN=build/jolt-chez janet test/chez/run-corpus.janet` # Phase 1+
|
||||
- `JOLT_CORPUS_LIMIT=400 …` # every-Nth stride, fast
|
||||
- `known-divergences.edn` — allowlist of cases that diverge at the CLI boundary.
|
||||
The gate fails only on a NEW divergence; known ones are reported but tolerated.
|
||||
- `values-test.ss` / `../../host/chez/values.ss` — Phase 0a value model + tests.
|
||||
|
||||
## The reference baseline (2026-06-17, Janet `build/jolt`, compile mode)
|
||||
2641/2655 pass; 14 known divergences. They split into:
|
||||
- **interpret-vs-compile leniency** — `:throws` cases where interpret mode raises
|
||||
but compile mode returns (`< nil`, `> with nil`, `neg? keyword`, `max`/`min-key`
|
||||
on non-numbers). Several are also non-canonical vs JVM Clojure.
|
||||
- **invoke-collection-as-fn** — the `transient / invokable lookup` suite invokes
|
||||
transients/collections as fns (`((transient {:x 7}) :x)`); compile mode (and
|
||||
JVM Clojure) reject it.
|
||||
- **`xml-seq walks`** — one structural case.
|
||||
|
||||
The compile-only Chez host (JVM-canonical oracle) should MATCH OR FIX these. The
|
||||
gate's job is to catch *regressions* the port introduces, not to bless these.
|
||||
|
||||
## Why the CLI boundary
|
||||
The runner tests through `jolt -e`, exactly how the Chez host will be exercised —
|
||||
not the in-process `eval-string` the Janet `defspec` harness uses. The two differ
|
||||
on a handful of cases (the allowlist), and the CLI boundary is the portable one.
|
||||
2657
test/chez/corpus.edn
Normal file
2657
test/chez/corpus.edn
Normal file
File diff suppressed because it is too large
Load diff
69
test/chez/extract-corpus.janet
Normal file
69
test/chez/extract-corpus.janet
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
# Phase 0b — extract the spec corpus into a host-neutral contract file.
|
||||
#
|
||||
# Parses every test/spec/*.janet as DATA (no eval), pulls each
|
||||
# (defspec "suite" [label expected actual] ...) triple, and writes a corpus that
|
||||
# is valid BOTH as EDN (a future Chez-jolt runner reads it) and as Janet data
|
||||
# (the current runner reads it via `parse`). Run from repo root:
|
||||
# janet test/chez/extract-corpus.janet
|
||||
(use ../../src/jolt/reader) # not needed for parse, but keeps paths obvious
|
||||
|
||||
(defn parse-all [src]
|
||||
(def p (parser/new))
|
||||
(parser/consume p src)
|
||||
(parser/eof p)
|
||||
(def out @[])
|
||||
(while (parser/has-more p) (array/push out (parser/produce p)))
|
||||
out)
|
||||
|
||||
(defn edn-str [s]
|
||||
# escape a Clojure-source string into an EDN/Janet string literal
|
||||
(def b @`"`)
|
||||
(each c s
|
||||
(cond
|
||||
(= c (chr `"`)) (buffer/push b `\"`)
|
||||
(= c (chr "\\")) (buffer/push b "\\\\")
|
||||
(= c (chr "\n")) (buffer/push b "\\n")
|
||||
(= c (chr "\t")) (buffer/push b "\\t")
|
||||
(buffer/push-byte b c)))
|
||||
(buffer/push b `"`)
|
||||
(string b))
|
||||
|
||||
(defn triples-from [form]
|
||||
# form is (defspec "suite" [l e a] ...) as a parsed tuple
|
||||
(when (and (indexed? form) (> (length form) 0) (= (first form) 'defspec))
|
||||
(def suite (in form 1))
|
||||
(def rows @[])
|
||||
(each case (slice form 2)
|
||||
(when (and (indexed? case) (>= (length case) 3))
|
||||
(def label (in case 0))
|
||||
(def expected (in case 1))
|
||||
(def actual (in case 2))
|
||||
# expected is either a Clojure-source string or the :throws keyword;
|
||||
# actual is always a Clojure-source string. Skip non-literal rows.
|
||||
(when (and (string? label) (string? actual)
|
||||
(or (string? expected) (keyword? expected)))
|
||||
(array/push rows {:suite suite :label label
|
||||
:expected expected :actual actual})))
|
||||
)
|
||||
rows))
|
||||
|
||||
(def spec-dir "test/spec")
|
||||
(def all @[])
|
||||
(each f (sort (os/dir spec-dir))
|
||||
(when (string/has-suffix? "-spec.janet" f)
|
||||
(def path (string spec-dir "/" f))
|
||||
(each form (parse-all (slurp path))
|
||||
(when-let [rows (triples-from form)]
|
||||
(array/concat all rows)))))
|
||||
|
||||
# emit EDN-and-Janet-valid corpus
|
||||
(def out @"[\n")
|
||||
(each row all
|
||||
(buffer/push out
|
||||
(string " {:suite " (edn-str (row :suite))
|
||||
" :label " (edn-str (row :label))
|
||||
" :expected " (if (keyword? (row :expected)) ":throws" (edn-str (row :expected)))
|
||||
" :actual " (edn-str (row :actual)) "}\n")))
|
||||
(buffer/push out "]\n")
|
||||
(spit "test/chez/corpus.edn" out)
|
||||
(printf "extracted %d cases from %s into test/chez/corpus.edn" (length all) spec-dir)
|
||||
14
test/chez/known-divergences.edn
Normal file
14
test/chez/known-divergences.edn
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
["max non-number throws"
|
||||
"min-key keys nonnum"
|
||||
"neg? keyword"
|
||||
"< nil"
|
||||
"> with nil"
|
||||
"max non-number"
|
||||
"neg? throws"
|
||||
"vector index"
|
||||
"map key as fn"
|
||||
"map key default"
|
||||
"set membership"
|
||||
"set miss default"
|
||||
"collection key"
|
||||
"xml-seq walks"]
|
||||
53
test/chez/run-corpus.janet
Normal file
53
test/chez/run-corpus.janet
Normal file
|
|
@ -0,0 +1,53 @@
|
|||
# Phase 0b — host-neutral parity runner.
|
||||
#
|
||||
# Feeds each corpus case to a TARGET jolt binary as a fresh subprocess (fresh
|
||||
# ctx = the per-case isolation the in-process harness gives), checking
|
||||
# (= expected actual) prints `true`, or that a :throws case exits non-zero. The
|
||||
# target is pluggable so the SAME corpus gates every host:
|
||||
# JOLT_BIN=build/jolt janet test/chez/run-corpus.janet # Janet ref
|
||||
# JOLT_BIN=build/jolt-chez ... (Phase 1+) # Chez host
|
||||
# Env: JOLT_CORPUS_LIMIT=N caps the run (every-Nth stride) for fast iteration.
|
||||
(def corpus (parse (slurp "test/chez/corpus.edn")))
|
||||
(def jolt-bin (or (os/getenv "JOLT_BIN") "build/jolt"))
|
||||
(def known (let [k @{}] (each l (parse (slurp "test/chez/known-divergences.edn")) (put k l true)) k))
|
||||
|
||||
(def cases
|
||||
(if-let [n (os/getenv "JOLT_CORPUS_LIMIT")]
|
||||
(let [stride (max 1 (math/floor (/ (length corpus) (scan-number n))))]
|
||||
(seq [i :range [0 (length corpus) stride]] (in corpus i)))
|
||||
corpus))
|
||||
|
||||
(defn run-capture [args]
|
||||
(def proc (os/spawn [jolt-bin ;args] :p {:out :pipe :err :pipe}))
|
||||
(def out (ev/read (proc :out) 0x100000))
|
||||
(ev/read (proc :err) 0x100000)
|
||||
(def code (os/proc-wait proc))
|
||||
# take the LAST non-empty line: a case may print side effects before its value
|
||||
(def lines (filter (fn [l] (not (empty? l))) (string/split "\n" (string/trim (if out (string out) "")))))
|
||||
[code (if (empty? lines) "" (last lines))])
|
||||
|
||||
(var pass 0)
|
||||
(def fails @[]) # NEW divergences — these fail the gate
|
||||
(def known-hit @[]) # expected (allowlisted) divergences
|
||||
(defn record-fail [l m]
|
||||
(if (known l) (array/push known-hit l) (array/push fails [l m])))
|
||||
(each row cases
|
||||
(def {:expected e :actual a :label l} row)
|
||||
(if (= e :throws)
|
||||
(let [[code _] (run-capture ["-e" a])]
|
||||
(if (not= code 0) (++ pass)
|
||||
(record-fail l "expected an error, exited 0")))
|
||||
(let [[code out] (run-capture ["-e" (string "(= " e " " a ")")])]
|
||||
(cond
|
||||
(not= code 0) (record-fail l (string "errored (exit " code ")"))
|
||||
(= out "true") (++ pass)
|
||||
(record-fail l (string "want true, got " out))))))
|
||||
|
||||
(printf "\ncorpus parity [%s]: %d/%d passed (%d known divergences)"
|
||||
jolt-bin pass (length cases) (length known-hit))
|
||||
(when (> (length fails) 0)
|
||||
(printf "%d NEW divergence(s) — gate FAILED:" (length fails))
|
||||
(each [l m] (slice fails 0 (min 20 (length fails)))
|
||||
(printf " FAIL [%s] %s" l m)))
|
||||
(flush)
|
||||
(os/exit (if (> (length fails) 0) 1 0))
|
||||
60
test/chez/values-test.ss
Normal file
60
test/chez/values-test.ss
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
;; Phase 0a tests — Jolt value model on Chez. Run from repo root:
|
||||
;; chez --script test/chez/values-test.ss
|
||||
(import (chezscheme))
|
||||
(load "host/chez/values.ss")
|
||||
|
||||
(define total 0)
|
||||
(define fails 0)
|
||||
(define (ok name pred)
|
||||
(set! total (+ total 1))
|
||||
(unless pred (set! fails (+ fails 1)) (printf "FAIL: ~a\n" name)))
|
||||
|
||||
;; nil distinct from #f and '()
|
||||
(ok "nil not #f" (not (eq? jolt-nil #f)))
|
||||
(ok "nil not '()" (not (eq? jolt-nil '())))
|
||||
(ok "nil? jolt-nil" (jolt-nil? jolt-nil))
|
||||
(ok "nil? not on #f" (not (jolt-nil? #f)))
|
||||
|
||||
;; truthiness: only nil and false falsey
|
||||
(ok "nil falsey" (not (jolt-truthy? jolt-nil)))
|
||||
(ok "false falsey" (not (jolt-truthy? #f)))
|
||||
(ok "true truthy" (jolt-truthy? #t))
|
||||
(ok "0 truthy" (jolt-truthy? 0))
|
||||
(ok "empty-str truthy" (jolt-truthy? ""))
|
||||
(ok "empty-list truthy" (jolt-truthy? '()))
|
||||
|
||||
;; keywords interned -> identity
|
||||
(ok "kw eq" (eq? (keyword #f "foo") (keyword #f "foo")))
|
||||
(ok "kw ns eq" (eq? (keyword "a" "foo") (keyword "a" "foo")))
|
||||
(ok "kw diff ns" (not (eq? (keyword "a" "foo") (keyword #f "foo"))))
|
||||
(ok "kw?" (keyword? (keyword #f "x")))
|
||||
(ok "kw not sym" (not (jolt-symbol? (keyword #f "x"))))
|
||||
|
||||
;; symbols NOT interned but jolt= by ns/name
|
||||
(ok "sym not eq" (not (eq? (jolt-symbol #f "x") (jolt-symbol #f "x"))))
|
||||
(ok "sym jolt=" (jolt= (jolt-symbol #f "x") (jolt-symbol #f "x")))
|
||||
(ok "sym diff name" (not (jolt= (jolt-symbol #f "x") (jolt-symbol #f "y"))))
|
||||
(ok "sym?" (jolt-symbol? (jolt-symbol "ns" "n")))
|
||||
|
||||
;; numbers: exactness-aware = (Clojure semantics)
|
||||
(ok "1 = 1" (jolt= 1 1))
|
||||
(ok "1 not= 1.0" (not (jolt= 1 1.0)))
|
||||
(ok "1.0 = 1.0" (jolt= 1.0 1.0))
|
||||
(ok "ratio =" (jolt= 1/2 1/2))
|
||||
(ok "bigint=int exact" (jolt= 2 (expt 2 1)))
|
||||
(ok "= variadic" (jolt= 3 3 3))
|
||||
(ok "= variadic false" (not (jolt= 3 3 4)))
|
||||
|
||||
;; strings / chars
|
||||
(ok "str =" (jolt= "ab" "ab"))
|
||||
(ok "str !=" (not (jolt= "ab" "ac")))
|
||||
(ok "char =" (jolt= #\a #\a))
|
||||
|
||||
;; hashing consistent with =
|
||||
(ok "hash kw stable" (= (jolt-hash (keyword #f "k")) (jolt-hash (keyword #f "k"))))
|
||||
(ok "hash sym stable" (= (jolt-hash (jolt-symbol #f "k")) (jolt-hash (jolt-symbol #f "k"))))
|
||||
(ok "hash 1 != 1.0" (not (= (jolt-hash 1) (jolt-hash 1.0))))
|
||||
(ok "hash str stable" (= (jolt-hash "abc") (jolt-hash "abc")))
|
||||
|
||||
(printf "values-test: ~a/~a passed\n" (- total fails) total)
|
||||
(exit (if (> fails 0) 1 0))
|
||||
Loading…
Add table
Add a link
Reference in a new issue