From 9a273e71cd5bdf9b0e6b4b115d40d5592ca05be2 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sun, 21 Jun 2026 09:48:49 -0400 Subject: [PATCH] Move the Chez test oracle off Janet The unit tests in test/chez/_*.janet now drive bin/joltc (the zero-Janet spine) and judge against baked expected values instead of a live build/jolt run. Ten of them captured the oracle from build/jolt per case; their values are now literals (one env-dependent javastatic case became a predicate so it stays portable). The rest already had literal expecteds with a redundant build/jolt sanity check, now dropped. Retire emit-test/emit-parity/reader-parity: they compared the Chez/Clojure path against a live Janet evaluation, emitter, or reader. That migration check is done, and run-corpus-zero-janet (Chez analyzer vs the JVM corpus) plus certify.clj cover correctness now. Rewrite the README for the current zero-Janet gate. jolt-5oci --- test/chez/README.md | 280 +++---------- test/chez/_atomwatch.janet | 42 +- test/chez/_class.janet | 10 +- test/chez/_dotform.janet | 68 ++-- test/chez/_dynbind.janet | 10 +- test/chez/_insttime.janet | 13 +- test/chez/_io.janet | 12 +- test/chez/_ioreader.janet | 7 +- test/chez/_javastatic.janet | 120 +++--- test/chez/_ns.janet | 6 +- test/chez/_reader.janet | 11 +- test/chez/_seqpred.janet | 6 +- test/chez/_stdlib.janet | 11 +- test/chez/_str.janet | 6 +- test/chez/_strns.janet | 4 +- test/chez/_type.janet | 9 +- test/chez/_var_meta.janet | 8 +- test/chez/_walk.janet | 7 +- test/chez/emit-parity.janet | 210 ---------- test/chez/emit-test.janet | 721 ---------------------------------- test/chez/reader-parity.janet | 154 -------- 21 files changed, 205 insertions(+), 1510 deletions(-) delete mode 100644 test/chez/emit-parity.janet delete mode 100644 test/chez/emit-test.janet delete mode 100644 test/chez/reader-parity.janet diff --git a/test/chez/README.md b/test/chez/README.md index 4f226b6..478bdf8 100644 --- a/test/chez/README.md +++ b/test/chez/README.md @@ -1,248 +1,60 @@ -# Chez port — Phase 0 test contract harness +# Chez test 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. +The correctness gate for jolt on Chez (epic jolt-cf1q). Correctness is judged +against the JVM-sourced conformance spec — no Janet decides pass/fail. The spec +itself lives in `test/conformance/` (see its `SPEC.md`); this directory holds the +Chez runners and unit tests. -## 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 spec corpus -## 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. +- `corpus.edn` — the contract: ~2920 rows `{:suite :label :expected :actual}`, + with `:expected` sourced from reference JVM Clojure. Valid as both EDN and Janet + data. Generated by `test/conformance/regen-corpus.clj` (the answers) over the + case list from `extract-corpus.janet` (the `:actual` strings, pulled from + `test/spec/*.janet` and `conformance-test.janet`). +- `extract-corpus.janet` — re-derives the case list when spec rows change. Writes + only when `JOLT_EXTRACT_CORPUS_OUT` is set, so a gate run never clobbers the + JVM-sourced `corpus.edn`. After re-deriving, re-source the answers with + `regen-corpus.clj`. -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. +## The standing gate -## 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. +`run-corpus-zero-janet.janet` runs every corpus case through the zero-Janet +spine: read → analyze → IR → emit → eval, all on Chez (the analyzer is +`jolt.analyzer` cross-compiled to Scheme over `host-contract.ss`). Each result is +compared by value-equality against the JVM `:expected`. A `known-fail` allowlist +covers cases jolt can't match because Chez has no JVM host (Java classes, arrays, +`BigDecimal`, opaque host-object printers, …); the gate fails only on a NEW +divergence or if the pass count drops below the floor. -## Phase 1 — first parity number (subset probe) -The full `run-corpus.janet` gate drives an `-e`-capable jolt binary; the Chez -host can't answer arbitrary `-e` until all of clojure.core is bootstrapped onto -Chez (Phase 2). Until then, `run-corpus-chez.janet` reports parity for the subset -the Phase-1 back end (`host/chez/emit.janet`) can already compile: each case is -run through the live analyzer → Scheme emitter → Chez via `host/chez/driver`. -Cases that reference unimplemented stdlib/host fns fail to EMIT (a clean -compile-time signal) and are counted "out of subset", not as divergences. + JOLT_CHEZ_ZEROJANET_CORPUS=1 janet test/chez/run-corpus-zero-janet.janet + JOLT_CORPUS_LIMIT=200 … # every-Nth stride, fast iteration - JOLT_CHEZ_CORPUS=1 janet test/chez/run-corpus-chez.janet +Floor: 2678 (`JOLT_CHEZ_ZJ_FLOOR` overrides). Raise it as host gaps close. -Baseline after inc 3g (letfn + declare): **672/672 compiled cases pass**, 0 -divergences; 1986/2658 out of subset (await clojure.core on Chez). Inc 3e -(throw/try + ex-info) was 632/632; inc 3f's quote support + a seq.ss fix (empty -`map`/`filter` results are `()` not nil, matching Clojure) reached 664/664; inc 3g -(letfn -> Scheme `letrec*`, declare/def-no-init -> a reserved var cell) pulled 8 -more corpus cases into the subset. `emit-fn` lowers multi-arity fns to a Scheme -`case-lambda` and variadic fns to a rest-arg lambda (rest list coerced to a jolt -seq, nil when empty). +## Unit tests -## Phase 1 — clojure.core prelude emission (inc 3d, jolt-ocvi) -The `-e`-capable jolt-chez path: emit the clojure.core tiers -(`jolt-core/clojure/core/NN-*.clj`) through the same analyzer → emit pipeline as a -Scheme PRELUDE of `def-var!` forms, so user code's `(var-deref "clojure.core" …)` -resolves the fn at runtime. `emit/set-prelude-mode!` flips a switch: in the default -(subset) mode a non-native `clojure.core` ref is rejected ("out of subset"); in -prelude mode it lowers to a runtime `var-deref` so core fns chain through each -other. Host interop (`:host`) and unhandled IR ops still error in both modes — -those are the real gaps that need a hand-written RT shim or new emit support. +`_*.janet` drive `bin/joltc` (the pure-Chez CLI; `JOLT_BIN` overrides) one +subprocess per case and compare the last stdout line against a baked expected +value. `:throws` asserts a non-zero exit. Each file targets one area — +`_type`/`_class`/`_seqpred` (taxonomy + predicates), `_str`/`_strns`/`_reader` +(strings + reader), `_io`/`_ioreader`/`_insttime`/`_javastatic` (host interop), +`_dynbind`/`_var_meta`/`_ns` (vars + namespaces), `_atomwatch`/`_walk`/`_dotform` +/`_stdlib` (refs, walk, dot-forms, stdlib). Run one with +`janet test/chez/_type.janet`. -`core-prelude-probe.janet` (gated behind `JOLT_CHEZ_PRELUDE=1`) measures reach and -catalogs the gaps; macros are skipped (analyze-time only, not a runtime value): +## Self-host gates - JOLT_CHEZ_PRELUDE=1 janet test/chez/core-prelude-probe.janet +- `spine-test.janet` — the zero-Janet compile/eval spine end to end. +- `cli-test.janet` — `bin/joltc -e` behavior. +- `bootstrap-test.janet` — `host/chez/bootstrap.ss` rebuilds the prelude + image + from source on Chez and matches the checked-in seed (`host/chez/seed/`). +- `fixpoint-test.janet` — the on-Chez compiler reproduces itself (stage2 == stage3, + prelude pstage3 == pstage4). -Baseline after inc 3i (regex): **355/355 non-macro core forms emit** to Scheme — -the whole non-macro clojure.core now lowers. inc 3i closed the last gap, the regex -literal in `parse-uuid`: a `#"…"` literal lowers to a `:regex` IR node and the Chez -emitter emits a `jolt-regex` value over **vendored irregex** (Alex Shinn, BSD, -`vendor/irregex` submodule) — a portable Scheme regex with PCRE/Java-style string -patterns. `re-pattern`/`re-matches`/`re-find`/`re-seq`/`regex?` are `def-var!`'d -into clojure.core (`host/chez/regex.ss`); they stay OUT of the subset native-ops -(irregex's Unicode/property-class semantics differ from the seed's byte-PEG -approximation), so they resolve in prelude mode — the path the assembled prelude -takes — without dragging engine-difference divergences into the subset corpus. The -Janet back end punts `:regex` to the interpreter (the seed compiles `#"…"` to a -Janet PEG). Prior incs: inc 3h `.method` → `:host-call` (`jolt-host-call` for -`.write`/`.isDirectory`/`.listFiles`); `:quote`, `:throw`, `:try`, `ex-info`, -`letfn` → `letrec*`, `declare`/def-no-init → reserved var cell. The probe has a -regression floor (355) — every non-macro core form must keep emitting. +## Bench -## Phase 1 — the assembled prelude: -e-capable jolt-chez (inc 3j, jolt-9ziu) -Once the whole non-macro clojure.core emits (inc 3i), the milestone is to ASSEMBLE -it: `driver/emit-core-prelude` emits every non-macro core form across the -dependency-ordered tiers as a `def-var!` (prelude mode), concatenated into a -Scheme prelude. `bin/jolt-chez -e EXPR` loads `rt.ss` + that prelude + a -post-prelude override, emits the user expression in prelude mode, and runs it on -Chez — an `-e`-capable jolt-chez (analysis on Janet, execution on Chez). The -prelude is cached on disk keyed by a fingerprint of the core sources + the RT. +`bench-pipeline.janet` (opt-in via `JOLT_CHEZ_BENCH=1`) times fib + mandelbrot +through the real pipeline against the spike ceiling. Skipped in the gate. -`run-corpus-prelude.janet` is the full parity gate this opens (the prelude-backed -sibling of `run-corpus-chez.janet`): it assembles the prelude once, then runs every -corpus case with all of core present, bucketing the result — - - JOLT_CHEZ_PRELUDE_CORPUS=1 janet test/chez/run-corpus-prelude.janet - JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast) - -Parity baseline: inc 3j **1220/2497**; 3k (converters, jolt-t6cr) **1326**; -3l (transients, jolt-kl2l) **1382**; 3m (numeric-edge emit + variadic assoc!, -jolt-q3w8) **1407/2497**, 0 NEW divergences (14 allowlisted: -dynamic vars `*ns*`/`*clojure-version*`/`*unchecked-math*`, var/`*ns*` rendering, -class names, eval-order, with-open — all deferred Phase-2 / dynamic-var gaps). -- inc 3k `host/chez/converters.ss`: `str`/`subs`/`vec`/`keyword`/`symbol`/`compare`/ - `int`/`double`/`gensym` (seed natives — `str` reuses the printer, `compare` is the - 3-way port, the symbol no-ns sentinel is `#f` to match emit's quoted-symbol - lowering so `(= 'x (symbol "x"))` holds). -- inc 3l `host/chez/transients.ss`: `transient`/`persistent!`/`conj!`/`assoc!`/ - `dissoc!`/`disj!`/`pop!` as copy-on-write over the persistent collections (correct - semantics, no in-place perf), plus persistent `disj`. `get`/`count`/`contains?` - are redefined to see THROUGH a transient (frequencies/group-by do `(get tm k)` on a - transient map); `vector?` on a transient vector is false, which group-by relies on. - -- inc 3m: `##Inf`/`##-Inf`/`##NaN` emitted to bare `inf`/`nan` (unbound in Chez); - emit-const now lowers them to `+inf.0`/`-inf.0`/`+nan.0`, the `-e` printer renders - `inf`/`-inf`/`nan` and `str` renders `Infinity`/`-Infinity`/`NaN` (Clojure). Plus - variadic `assoc!`. (`str` of inf *inside a collection* still wants the long form — - the Phase-2 recursive str renderer — so `[inf inside coll]` is allowlisted.) -- inc 3n `host/chez/natives-seq.ss` (jolt-y6mv): the dominant prelude-parity crash - bucket was `apply non-procedure jolt-nil` — core fns calling seed-native seq fns - (`src/jolt/core_coll.janet`) that have no Chez shim, so `var-deref` yields - jolt-nil. A static scan of the assembled prelude found 52 referenced-but-undefined - `clojure.core` names; this increment shims the safe, high-value seq fns: `mapcat`/ - `take-while`/`drop-while`/`partition` (collection arities — the 1-arg transducer - forms are jolt-kxsr), `sort` (compare default; a comparator may return a 3-way - number or a boolean less-than), and `reduced`/`reduced?` — a `jolt-reduced` record - in `seq.ss` that `reduce` short-circuits on and `deref` unwraps (so `unreduced` - works). `identical?` = `jolt=` (the seed's definition). `list?` was deferred: a - Chez lazy seq and a list are both `cseq`, so it can't be told apart without a - distinct list type (a real divergence risk). -- inc 3o transducer arities (jolt-kxsr): the 1-arg `map`/`filter`/`remove`/`take`/ - `drop`/`take-while`/`drop-while`/`mapcat` return a transducer `(fn [rf] rf')`, and - `into` gets a 3-arg `(into to xform from)`. These were the `cdr () is not a pair` / - `incorrect number of arguments` crash bucket: the emitter lowers `(map f)` / - `(into to xf from)` at the wrong arity to the bare native procedure (the - value-position path), so the fix is RT-side — `case-lambda` the seq procedures and - `jolt-into`. The `td-*` factories are ported from the seed (core_coll.janet); a - `reduced` step stops the fold via reduce-seq's short-circuit. `transduce`/`comp`/ - `completing` are overlay and compose over these for free. -- inc 3p misc seq/regex gaps (jolt-y1zq): 0-arg `(conj)` -> `[]`, 0-arg `(conj!)` -> - a fresh transient vector, `nth` sees through a transient (like get/count/contains?), - and irregex `\p{...}`/`\P{...}` property classes translate to the seed's ASCII char - classes (regex.ss; `\p{L}`->`[a-zA-Z]`, `\p{N}`->`[0-9]`, `\p{Ps}`->`[([{]`, …) — - ASCII-only (the seed counts UTF-8 high bytes as letters, which a Unicode-char Scheme - string can't reproduce; the corpus tests ASCII, where they agree) and - `clojure.math/PI` (missing ns). - - Two pre-existing bugs surfaced here, since fixed (inc 3x / 3y below). -- inc 3q multimethod dispatch + late-bind (jolt-9ls5, Phase 2): `host/chez/ - multimethods.ss` implements the multimethod runtime — `defmulti`/`defmethod` - expand to `defmulti-setup`/`defmethod-setup` calls (+ `get-method`/`methods`/ - `remove-method`/`prefer-method`/`prefers`). A `jolt-multifn` record carries its - dispatch fn and a `jolt=`-keyed method table; `jolt-invoke` dispatches it (exact - match, then isa?/hierarchy with `prefer-method`, then `:default`), reusing the - overlay's `isa?`/`derive`/`make-hierarchy`. The multifn's ns is set via a runtime - `chez-current-ns` (default "user"; the prelude load sets "clojure.core"). - - Two emit-side changes made this work: - - **late-bind** (`:late-bind-unresolved?` ctx flag, default OFF): `defmulti` - expands to a bare-symbol setup *call*, so the analyzer doesn't intern the name - and a forward reference (`(area …)` after `(defmulti area …)` in one form) was - "Unable to resolve symbol". The strict compiler punts these to the interpreter; - the Chez back end has none, so the flag makes an unresolved symbol lower to a - `var-ref` against the compile ns — the open-world semantics of `-e`. Set only by - the Chez `make-ctx`/`jolt-chez`; the main compiler keeps its strict behavior. - - a `:var` call head now routes through `jolt-invoke` (not a direct application), - since a late-bound var can hold a multifn (or a keyword/coll IFn), not just a - procedure. Transparent for procedures; the hot self-recursive call is a `:local` - known-proc, so it stays direct. (Class-based dispatch — `(class x)`/`String` — is - deferred; it needs the deftype/class subsystem.) -- inc 3r dynamic-var constants (jolt-9ls5): `host/chez/dynamic-vars.ss` binds the seed - natives `*clojure-version*` (the `{:major 1 :minor 11 …}` map) and `*unchecked-math*` - (false), removing their two parity allowlist entries. `*ns*` is deferred (jolt-b4kl): - it needs a namespace value that is not a map (`map?` false) yet answers - `(get ns :name)` for the overlay `ns-name`, plus `str`/`find-ns` support. -- inc 3x non-ASCII string literals (jolt-x0os): `emit.janet`'s `chez-str-lit` replaces - the `%j` string encoder. Janet's `%j` renders a non-ASCII char as raw UTF-8 bytes - (`\xC3\xA9`) and a control char / DEL as `\xHH` with NO terminating semicolon — both - forms Chez's reader rejects. `chez-str-lit` UTF-8-decodes each char and emits a - codepoint hex escape `\x;` (`é`->`\xe9;`, `日`->`\x65e5;`), keeping `\n`/`\t`/`\r`/ - `\"`/`\\` and being byte-identical to `%j` for printable ASCII. Applied to every - string-content site (string/keyword/symbol/var-name/regex-source). This unblocks the - `p{L} utf-8` corpus case (the `\p{L}` translation was already correct). Note: `count`/ - `subs`/`nth` over a multibyte string index by BYTES in the seed but by codepoints on - Chez — a separate semantic gap, not addressed here. -- inc 3y seed assoc! odd-args (jolt-ea9k): `core-assoc!` (src/jolt/core_extra.janet) now - throws on an odd key/val count, like plain `assoc` and Clojure's `assoc!` — the former - lenient nil-fill was non-Clojure and inconsistent with the seed's own `assoc`. The 4 - `assoc! odd args` spec rows became 3 `:throws` + 1 even-args positive; corpus.edn - regenerated. The Chez host already threw, so this only realigns the corpus contract. -- Phase 1 close-out (jolt-nkcb): truthy? elision + end-to-end compute bench. `emit.janet` - now drops the redundant `jolt-truthy?` wrapper on an `:if` test that provably yields a - Scheme boolean (a native comparison/`not`, or a boolean const) — sound because - `jolt-truthy?` of `#t`/`#f` is identity; the hot fib/mandelbrot tests are all - comparisons, so this is a direct ceiling lever (fib 30 end-to-end 24.0 -> 14.4 ms). - `bench-pipeline.janet` (JOLT_CHEZ_BENCH=1, opt-in) times fib(30) + mandelbrot(200) - through the real pipeline vs the spike ceiling: mandelbrot 87 ms runs AT the - generic-flonum ceiling (98 ms); fib is 2x its hand-flonum ceiling, the residual being - jolt's all-double number model (typed fl*/fx* emission = Phase 4). Compile-only is - total for the compute subset (every form emits; Chez has no interpreter fallback). - -The remaining buckets are the punch-list the next increments chase: ~361 emit-fail -(genuine host interop — qualified Java/Janet refs, runtime `defmacro`/`eval`, out of -the analyzer's subset) and the runtime crashes still dominated by `apply jolt-nil` -(more host-coupled natives without a shim: `meta`/`with-meta`, `format`, the -`clojure.string` natives, bit ops, `var`/`volatile`/`future`/thread-binding ops), -plus the small jolt-y1zq tail (0-arg `conj`, `\p{}` regex classes, a few one-offs) -and multimethod dispatch (Phase 2 jolt-9ls5). - -Two host shims landed with the prelude. `host/chez/atoms.ss`: atom/deref/swap!/ -reset! (+ compare-and-set!/swap-vals!/reset-vals!) — host-coupled mutable cells the -overlay assumes are native; needed at the prelude's LOAD time -(`global-hierarchy = (atom (make-hierarchy))`). `host/chez/predicates.ss`: the type -predicates + `name`/`namespace`/`boolean` the overlay assumes are seed natives -(`nil?`/`number?`/`string?`/`map?`/`vector?`/`set?`/`seq?`/`coll?`/`fn?`/…), matching -the seed's strict semantics. `host/chez/post-prelude.ss` re-asserts `char?`/`atom?` -AFTER the prelude — the overlay implements those two by reading a value's -`:jolt/type` key (a Janet-host assumption that's false for Chez-native chars/atoms), -and its `def-var!` would otherwise clobber the correct native shims. - -The 8 print-method/print-dup `defmulti`/`defmethod` forms (50-io) can't LOAD yet -(no multimethod runtime on Chez — Phase 2); a silent load guard in the assembled -prelude lets the rest load and turns them into lazy gaps. - -Prior, inc 3b (seq tier + dynamic IFn, jolt-5pso): 595/595 compiled, 0 divergences, -2060/2655 out of subset. The seq tier brought up a list/lazy-seq type with -first/rest/next/seq/cons/list, map/filter/reduce/into/remove, -range/take/drop/concat/apply, keys/vals, and nth/peek/pop over seqs; dynamic IFn -dispatch (a keyword/vector/coll held in a local and called as a fn) routes through -the `jolt-invoke` fallback, closing the 3 ex-known divergences. The probe exits -non-zero on any NEW divergence. - -(Prior, inc 3a: 433/436 compiled, 3 known IFn divergences, 2219 out of subset. -Inc 2: 182/182 compiled, 0 divergences, 2473 out of subset.) - -It's a slow report (a Chez subprocess per case), so it's gated behind -`JOLT_CHEZ_CORPUS` out of the default suite, like the benches. -`test/chez/emit-test.janet` is the fast Phase-1 unit gate (real analyzer → Chez -parity for fib/mandelbrot + collections + regressions); both skip cleanly when -`chez` isn't on PATH. +All Chez runners skip cleanly when `chez` is not on PATH. diff --git a/test/chez/_atomwatch.janet b/test/chez/_atomwatch.janet index 45a4ddc..e80f497 100644 --- a/test/chez/_atomwatch.janet +++ b/test/chez/_atomwatch.janet @@ -1,24 +1,24 @@ # jolt-mn9o — atom watches + validators on Chez. The Chez atom record carries # watches (alist) + validator slots; swap!/reset! validate-then-set-then-notify; # add-watch/remove-watch/set-validator!/get-validator are native (post-prelude.ss -# re-asserts them over the overlay's ref-put!-based versions). Oracle = build/jolt. +# re-asserts them over the overlay's ref-put!-based versions). # # janet test/chez/_atomwatch.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) -# [expr throws?] — when throws? the case is expected to exit non-zero on both -# (the corpus :throws contract; the exception message text may differ). +# [expr expected] — :throws asserts a non-zero exit (validator rejection); the +# exception message text is not compared. (def cases - [["(let [a (atom 0) seen (atom 0)] (add-watch a :k (fn [k r o n] (reset! seen 1))) (reset! a 5) @seen)" false] - ["(let [a (atom 0) seen (atom 0)] (add-watch a :k (fn [k r o n] (swap! seen inc))) (remove-watch a :k) (reset! a 5) @seen)" false] - ["(let [a (atom 0) log (atom [])] (add-watch a :k (fn [k r o n] (swap! log conj [o n]))) (reset! a 1) (reset! a 2) @log)" false] - ["(let [a (atom 0)] (set-validator! a number?) (reset! a 5) @a)" false] - ["(let [a (atom 5)] (set-validator! a pos?) (swap! a inc) @a)" false] - ["(let [a (atom 0)] (set-validator! a number?) (fn? (get-validator a)))" false] - ["(let [a (atom 0)] (nil? (get-validator a)))" false] - ["(let [a (atom 0)] (set-validator! a pos?) (reset! a -1))" true] - ["(let [a (atom 5)] (set-validator! a pos?) (swap! a (fn [_] -1)) @a)" true] - ["(let [a (atom 0) c (atom 0)] (add-watch a :k (fn [k r o n] (swap! c inc))) (swap! a inc) (swap! a inc) @c)" false]]) + [["(let [a (atom 0) seen (atom 0)] (add-watch a :k (fn [k r o n] (reset! seen 1))) (reset! a 5) @seen)" "1"] + ["(let [a (atom 0) seen (atom 0)] (add-watch a :k (fn [k r o n] (swap! seen inc))) (remove-watch a :k) (reset! a 5) @seen)" "0"] + ["(let [a (atom 0) log (atom [])] (add-watch a :k (fn [k r o n] (swap! log conj [o n]))) (reset! a 1) (reset! a 2) @log)" "[[0 1] [1 2]]"] + ["(let [a (atom 0)] (set-validator! a number?) (reset! a 5) @a)" "5"] + ["(let [a (atom 5)] (set-validator! a pos?) (swap! a inc) @a)" "6"] + ["(let [a (atom 0)] (set-validator! a number?) (fn? (get-validator a)))" "true"] + ["(let [a (atom 0)] (nil? (get-validator a)))" "true"] + ["(let [a (atom 0)] (set-validator! a pos?) (reset! a -1))" :throws] + ["(let [a (atom 5)] (set-validator! a pos?) (swap! a (fn [_] -1)) @a)" :throws] + ["(let [a (atom 0) c (atom 0)] (add-watch a :k (fn [k r o n] (swap! c inc))) (swap! a inc) (swap! a inc) @c)" "2"]]) (defn run-capture [bin expr] (def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe})) @@ -31,17 +31,15 @@ (var pass 0) (def fails @[]) -(each [expr throws?] cases - (def [ocode oracle _] (run-capture "build/jolt" expr)) +(each [expr expected] cases (def [code got err] (run-capture jolt-bin expr)) (cond - throws? - (if (and (not= ocode 0) (not= code 0)) (++ pass) - (array/push fails [expr (string "expected both throw; oracle exit " ocode ", chez exit " code)])) - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) + (= expected :throws) + (if (not= code 0) (++ pass) + (array/push fails [expr (string "expected throw; exit " code)])) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) - (= got oracle) (++ pass) - (array/push fails [expr (string "want `" oracle "`, got `" got "`")]))) + (= got expected) (++ pass) + (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) (printf "\n_atomwatch parity [%s]: %d/%d passed" jolt-bin pass (length cases)) (when (> (length fails) 0) diff --git a/test/chez/_class.janet b/test/chez/_class.janet index 8f047ed..211b887 100644 --- a/test/chez/_class.janet +++ b/test/chez/_class.janet @@ -2,12 +2,11 @@ # Keyword, File...) evaluates to its JVM canonical-name STRING — the same value # (class instance) returns — so (= String (class "x")) holds and a (defmethod m # String ...) keys against a (class ...) dispatch. host-class.ss ports -# src/jolt/eval_resolve.janet's class-canonical-names + core-class (scalar arms). -# Oracle = build/jolt. Collection (class ...) is host-taxonomy-dependent (the seed -# leaks the Janet host type "table"/"struct") and is NOT compared here. +# Scalar (class x) returns the JVM-style class-name symbol. +# Collection (class ...) is host-taxonomy-dependent and is NOT compared here. # # janet test/chez/_class.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (def cases [# --- bare class tokens evaluate to canonical strings --- @@ -46,11 +45,8 @@ (var pass 0) (def fails @[]) (each [expr expected] cases - (def [ocode oracle _] (run-capture "build/jolt" expr)) (def [code got err] (run-capture jolt-bin expr)) (cond - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) - (not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")]) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) (= got expected) (++ pass) (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) diff --git a/test/chez/_dotform.janet b/test/chez/_dotform.janet index f3fe2eb..5df57a9 100644 --- a/test/chez/_dotform.janet +++ b/test/chez/_dotform.janet @@ -2,45 +2,45 @@ # analyzer lowers (. target member arg*) and (.-field target) to a :host-call; # the Chez emit routes a non-shimmed :host-call through record-method-dispatch, # which dot-forms.ss extends with field access + map/vector member dispatch. -# Expectations are the build/jolt (seed) oracle, captured per case. +# Each case carries its expected printed value. # # janet test/chez/_dotform.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) -(def exprs +(def cases [# strings: method calls via the String surface - "(. \"HI\" toLowerCase)" - "(. \"abc\" length)" - "(. \"abc\" toUpperCase)" + ["(. \"HI\" toLowerCase)" "hi"] + ["(. \"abc\" length)" "3"] + ["(. \"abc\" toUpperCase)" "ABC"] # vectors / maps: collection interop (count/nth/get/containsKey) - "(. [1 2 3] count)" - "(. [10 20 30] nth 1)" - "(. {:a 1 :b 2} count)" - "(. {:a 1 :b 2} get :b)" - "(. {:a 1} containsKey :a)" - "(. {:count 99} count)" + ["(. [1 2 3] count)" "3"] + ["(. [10 20 30] nth 1)" "20"] + ["(. {:a 1 :b 2} count)" "2"] + ["(. {:a 1 :b 2} get :b)" "2"] + ["(. {:a 1} containsKey :a)" "true"] + ["(. {:count 99} count)" "1"] # map member: stored fn called with self (+ args), else field value - "(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)" - "(. {:greet (fn [self n] (str \"Hello \" n))} greet \"Alice\")" - "(. {:value 41} value)" + ["(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)" "v=41"] + ["(. {:greet (fn [self n] (str \"Hello \" n))} greet \"Alice\")" "Hello Alice"] + ["(. {:value 41} value)" "41"] # field access via .-field head - "(.-value {:value 41})" - "(.-x {:x 7 :y 9})" + ["(.-value {:value 41})" "41"] + ["(.-x {:x 7 :y 9})" "7"] # field access via (. obj -field) - "(. {:value 41} -value)" + ["(. {:value 41} -value)" "41"] # records: .-field reads a field, .method dispatches the protocol method - "(do (defrecord Rf [x]) (.-x (->Rf 7)))" - "(do (defrecord Rg [a b]) (.-b (->Rg 1 2)))" - "(do (defprotocol Greet (hi [_])) (defrecord Rh [nm] Greet (hi [_] (str \"hi \" nm))) (. (->Rh \"x\") hi))" + ["(do (defrecord Rf [x]) (.-x (->Rf 7)))" "7"] + ["(do (defrecord Rg [a b]) (.-b (->Rg 1 2)))" "2"] + ["(do (defprotocol Greet (hi [_])) (defrecord Rh [nm] Greet (hi [_] (str \"hi \" nm))) (. (->Rh \"x\") hi))" "hi x"] # universal object-methods on a non-record map win over a field lookup - "(try (throw (ex-info \"bad\" {})) (catch Throwable e (.getMessage e)))" - "(try (throw (ex-info \"bad\" {:k 1})) (catch Throwable e (.getMessage e)))" - "(try (throw \"boom\") (catch Throwable e (.getMessage e)))" - "(try (throw (Exception. \"boom\")) (catch Throwable e (.getMessage e)))" - "(try (throw (IllegalArgumentException. \"bad\")) (catch Exception e (.getMessage e)))" - "(.equals \"a\" \"a\")" - "(.equals \"a\" \"b\")" - "(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)"]) + ["(try (throw (ex-info \"bad\" {})) (catch Throwable e (.getMessage e)))" "bad"] + ["(try (throw (ex-info \"bad\" {:k 1})) (catch Throwable e (.getMessage e)))" "bad"] + ["(try (throw \"boom\") (catch Throwable e (.getMessage e)))" "boom"] + ["(try (throw (Exception. \"boom\")) (catch Throwable e (.getMessage e)))" "boom"] + ["(try (throw (IllegalArgumentException. \"bad\")) (catch Exception e (.getMessage e)))" "bad"] + ["(.equals \"a\" \"a\")" "true"] + ["(.equals \"a\" \"b\")" "false"] + ["(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)" "v=41"]]) (defn run-capture [bin expr] (def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe})) @@ -53,16 +53,14 @@ (var pass 0) (def fails @[]) -(each expr exprs - (def [ocode oracle _] (run-capture "build/jolt" expr)) +(each [expr expected] cases (def [code got err] (run-capture jolt-bin expr)) (cond - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) - (= got oracle) (++ pass) - (array/push fails [expr (string "want `" oracle "`, got `" got "`")]))) + (= got expected) (++ pass) + (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) -(printf "\n_dotform parity [%s]: %d/%d passed" jolt-bin pass (length exprs)) +(printf "\n_dotform parity [%s]: %d/%d passed" jolt-bin pass (length cases)) (when (> (length fails) 0) (printf "%d FAIL(s):" (length fails)) (each [e m] fails (printf " FAIL %s\n %s" e m))) diff --git a/test/chez/_dynbind.janet b/test/chez/_dynbind.janet index 96d05b3..0b7fcda 100644 --- a/test/chez/_dynbind.janet +++ b/test/chez/_dynbind.janet @@ -1,10 +1,10 @@ # jolt-2o7x — dynamic var binding (binding / with-bindings* / var-set / # thread-bound? / with-local-vars / with-redefs / bound-fn* / get-thread-bindings). -# Expectations are the JVM-canonical build/jolt values. TDD harness: bin/jolt-chez +# Expectations are the JVM-canonical values. TDD harness: bin/joltc # -e per case, last non-empty line == expected. # # janet test/chez/_dynbind.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (def cases [# --- binding: install / restore / seen across a fn call --- @@ -26,10 +26,8 @@ ["thread-bound? in scope" "(do (def ^:dynamic *tc* 1) (binding [*tc* 2] (thread-bound? (var *tc*))))" "true"] # --- with-bindings* / bound-fn* / get-thread-bindings --- - # NOTE: build/jolt (the seed) returns 1 here — its persistent-hash-map can't - # find a var key, which is why the seed's `binding` macro uses array-map. On - # Chez array-map IS hash-map and frames look up by cell identity, so this is - # the correct Clojure value 7 (a place Chez is more correct than the seed). + # Binding frames look up by var cell identity, so a var-keyed binding map + # resolves: the Clojure-correct value is 7. ["with-bindings*" "(do (def ^:dynamic *wb* 1) (with-bindings* {(var *wb*) 7} (fn [] *wb*)))" "7"] ["bound-fn* conveys" "(do (def ^:dynamic *cf* 1) (let [g (binding [*cf* 3] (bound-fn* (fn [] *cf*)))] (g)))" "3"] ["get-thread-bindings" "(do (def ^:dynamic *gb* 1) (binding [*gb* 9] (get (get-thread-bindings) (var *gb*))))" "9"] diff --git a/test/chez/_insttime.janet b/test/chez/_insttime.janet index fc02e55..e70d2d6 100644 --- a/test/chez/_insttime.janet +++ b/test/chez/_insttime.janet @@ -1,13 +1,13 @@ # jolt-at0a (inc X) — #inst / #uuid literals + java.time formatting on Chez. # #inst lowers (analyzer :inst node) to a jinst value (RFC3339 ms, partial # defaults + offsets); #uuid to a juuid; the java.time shim (DateTimeFormatter/ -# Instant/ZoneId/LocalDateTime/FormatStyle/Locale/Date) ports java_base.janet. -# Mirrors the :regex IR-leaf precedent: Janet back end punts to the interpreter's -# data-readers, Chez emits the runtime value (host/chez/inst-time.ss). -# Oracle = build/jolt. +# Instant/ZoneId/LocalDateTime/FormatStyle/Locale/Date. +# Reader data-readers and statics emit the runtime value +# (host/chez/inst-time.ss). +# # # janet test/chez/_insttime.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (def cases [# --- #inst reading + identity --- @@ -60,11 +60,8 @@ (var pass 0) (def fails @[]) (each [expr expected] cases - (def [ocode oracle _] (run-capture "build/jolt" expr)) (def [code got err] (run-capture jolt-bin expr)) (cond - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) - (not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")]) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) (= got expected) (++ pass) (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) diff --git a/test/chez/_io.janet b/test/chez/_io.janet index e29a82b..02aa157 100644 --- a/test/chez/_io.janet +++ b/test/chez/_io.janet @@ -1,12 +1,11 @@ # jolt-yyud — clojure.java.io/file + java.io.File interop + slurp/spit/flush/ # file-seq on Chez. A File is a path-backed jfile record (instance? java.io.File, -# str -> path, the File method surface). io.clj is a Janet-backed shim (janet.*), -# so this is a Chez-native implementation, not a port of it. Reader/StringReader- -# coupled cases (line-seq, slurp over a reader, toURL) are deferred to jolt-at0a. -# Oracle = build/jolt. +# str -> path, the File method surface). This is a Chez-native implementation. +# Reader-coupled cases (line-seq, slurp over a reader, toURL) are deferred to jolt-at0a. +# # # janet test/chez/_io.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (defn io [body] (string "(do (require (quote [clojure.java.io :as io])) " body ")")) @@ -48,11 +47,8 @@ (var pass 0) (def fails @[]) (each [expr expected] cases - (def [ocode oracle _] (run-capture "build/jolt" expr)) (def [code got err] (run-capture jolt-bin expr)) (cond - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) - (not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")]) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) (= got expected) (++ pass) (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) diff --git a/test/chez/_ioreader.janet b/test/chez/_ioreader.janet index c066d6e..e55062b 100644 --- a/test/chez/_ioreader.janet +++ b/test/chez/_ioreader.janet @@ -4,10 +4,10 @@ # StringReader, and with-open's __close seam over both jhost readers and plain # :close maps. All Chez-native (host/chez/io.ss); no analyzer change. Reader/edn # runtime read (clojure.edn/read over a PushbackReader) stays jolt-r8ku. -# Oracle = build/jolt. +# # # janet test/chez/_ioreader.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (defn io [body] (string "(do (require (quote [clojure.java.io :as io])) " body ")")) @@ -47,11 +47,8 @@ (var pass 0) (def fails @[]) (each [expr expected] cases - (def [ocode oracle _] (run-capture "build/jolt" expr)) (def [code got err] (run-capture jolt-bin expr)) (cond - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) - (not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")]) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) (= got expected) (++ pass) (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) diff --git a/test/chez/_javastatic.janet b/test/chez/_javastatic.janet index d8c4652..9322d2c 100644 --- a/test/chez/_javastatic.janet +++ b/test/chez/_javastatic.janet @@ -1,67 +1,67 @@ # jolt-avt6 — host class statics + constructors on Chez. The analyzer lowers # Class/member to :host-static and (Class. ...) to :host-new; the Chez emit lowers # them to host-static-ref/host-static-call/host-new (host-static.ss registry). -# Expectations are the build/jolt (seed) oracle, captured per case. +# Each case carries its expected printed value. Env-dependent values (os.name) are +# asserted via a predicate so the case stays portable across machines. # # janet test/chez/_javastatic.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) -# [label expr] — expected is whatever build/jolt prints (captured at runtime). -(def exprs - ["(Math/sqrt 16)" - "(Math/abs -3)" - "(Math/max 2 7)" - "(pos? Long/MAX_VALUE)" - "(String/valueOf 42)" - "(String/valueOf \"hi\")" - "(String/valueOf :k)" - "(String/valueOf nil)" - "(Long/parseLong \"42\")" - "(Long/valueOf \"42\")" - "(Integer/parseInt \"ff\" 16)" - "(.byteValue (Integer/valueOf \"ff\" 16))" - "(Boolean/parseBoolean \"true\")" - "(Boolean/parseBoolean \"yes\")" - "(Character/isUpperCase \\A)" - "(Character/isLowerCase \\a)" - "(Character/isUpperCase \\a)" - "(Thread/interrupted)" - "(System/getProperty \"os.name\")" - "(string? (get (System/getenv) \"HOME\"))" - "(string? (System/getenv \"HOME\"))" - "(fn? System/exit)" - "(string? (get (System/getProperties) \"os.name\"))" - "(pos? (count (seq (System/getenv))))" - "(let [es (map (fn [[k v]] [k v]) (System/getenv))] (and (pos? (count es)) (every? vector? es)))" +(def cases + [["(Math/sqrt 16)" "4"] + ["(Math/abs -3)" "3"] + ["(Math/max 2 7)" "7"] + ["(pos? Long/MAX_VALUE)" "true"] + ["(String/valueOf 42)" "42"] + ["(String/valueOf \"hi\")" "hi"] + ["(String/valueOf :k)" ":k"] + ["(String/valueOf nil)" "null"] + ["(Long/parseLong \"42\")" "42"] + ["(Long/valueOf \"42\")" "42"] + ["(Integer/parseInt \"ff\" 16)" "255"] + ["(.byteValue (Integer/valueOf \"ff\" 16))" "-1"] + ["(Boolean/parseBoolean \"true\")" "true"] + ["(Boolean/parseBoolean \"yes\")" "false"] + ["(Character/isUpperCase \\A)" "true"] + ["(Character/isLowerCase \\a)" "true"] + ["(Character/isUpperCase \\a)" "false"] + ["(Thread/interrupted)" "false"] + ["(string? (System/getProperty \"os.name\"))" "true"] + ["(string? (get (System/getenv) \"HOME\"))" "true"] + ["(string? (System/getenv \"HOME\"))" "true"] + ["(fn? System/exit)" "true"] + ["(string? (get (System/getProperties) \"os.name\"))" "true"] + ["(pos? (count (seq (System/getenv))))" "true"] + ["(let [es (map (fn [[k v]] [k v]) (System/getenv))] (and (pos? (count es)) (every? vector? es)))" "true"] # constructors + their methods - "(.toString (StringBuilder. \"x\"))" - "(.toString (-> (StringBuilder.) (.append \"a\") (.append \\b) (.append 1)))" - "(.toString (.append (StringBuilder. 16) \"x\"))" - "(let [sb (StringBuilder.)] (.append sb \"abcd\") (.setLength sb 2) (.toString sb))" - "(let [w (StringWriter.)] (.write w \"a\") (.append w \\b) (.toString w))" - "(let [r (StringReader. \"ab\")] [(.read r) (.read r) (.read r)])" - "(let [r (StringReader. \"ab\")] (.mark r 1) [(.read r) (do (.reset r) (.read r))])" - "(let [r (java.io.PushbackReader. (java.io.StringReader. \"ab\"))] [(.read r) (.read r)])" - "(let [r (PushbackReader. (StringReader. \"ab\")) a (.read r)] (.unread r a) [a (.read r) (.read r)])" - "(let [r (PushbackReader. (StringReader. \"a\"))] (.unread r \\x) [(.read r) (.read r)])" - "(BigInteger. \"123\")" - "(let [m (HashMap. {:a 1 :b 2})] (.get m :b))" - "(let [m (HashMap. {})] (.put m :x 1) (.put m :y 2) (.size m))" - "(let [t (StringTokenizer. \"a=1&b=2\" \"&\")] [(.nextToken t) (.nextToken t)])" - "(.toString (StringBuilder. \"x\"))" + ["(.toString (StringBuilder. \"x\"))" "x"] + ["(.toString (-> (StringBuilder.) (.append \"a\") (.append \\b) (.append 1)))" "ab1"] + ["(.toString (.append (StringBuilder. 16) \"x\"))" "x"] + ["(let [sb (StringBuilder.)] (.append sb \"abcd\") (.setLength sb 2) (.toString sb))" "ab"] + ["(let [w (StringWriter.)] (.write w \"a\") (.append w \\b) (.toString w))" "ab"] + ["(let [r (StringReader. \"ab\")] [(.read r) (.read r) (.read r)])" "[97 98 -1]"] + ["(let [r (StringReader. \"ab\")] (.mark r 1) [(.read r) (do (.reset r) (.read r))])" "[97 97]"] + ["(let [r (java.io.PushbackReader. (java.io.StringReader. \"ab\"))] [(.read r) (.read r)])" "[97 98]"] + ["(let [r (PushbackReader. (StringReader. \"ab\")) a (.read r)] (.unread r a) [a (.read r) (.read r)])" "[97 97 98]"] + ["(let [r (PushbackReader. (StringReader. \"a\"))] (.unread r \\x) [(.read r) (.read r)])" "[120 97]"] + ["(BigInteger. \"123\")" "123"] + ["(let [m (HashMap. {:a 1 :b 2})] (.get m :b))" "2"] + ["(let [m (HashMap. {})] (.put m :x 1) (.put m :y 2) (.size m))" "2"] + ["(let [t (StringTokenizer. \"a=1&b=2\" \"&\")] [(.nextToken t) (.nextToken t)])" "[a=1 b=2]"] + ["(.toString (StringBuilder. \"x\"))" "x"] # ring-codec surface - "(URLEncoder/encode \"a b=c\")" - "(URLDecoder/decode (URLEncoder/encode \"x &=%?\"))" - "(String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))" - "(String. (.decode (Base64/getDecoder) (String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))))" - "(Integer/parseInt \"ff\" 16)" + ["(URLEncoder/encode \"a b=c\")" "a+b%3Dc"] + ["(URLDecoder/decode (URLEncoder/encode \"x &=%?\"))" "x &=%?"] + ["(String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))" "aGVsbG8="] + ["(String. (.decode (Base64/getDecoder) (String. (.encode (Base64/getEncoder) (.getBytes \"hello\")))))" "hello"] + ["(Integer/parseInt \"ff\" 16)" "255"] # Pattern statics - "(regex? (Pattern/compile \"a.c\"))" - "(.split (Pattern/compile \",\") \"a,b,c\")" - "(do (require '[clojure.string :as s]) (s/replace \"a1b2\" (Pattern/compile \"[0-9]\") \"\"))" - "(boolean (re-find (Pattern/compile \"^x\" Pattern/MULTILINE) \"y\\nx\"))" - "(boolean (re-find (re-pattern (Pattern/quote \"a.c\")) \"za.cy\"))" - "(boolean (re-find (re-pattern (Pattern/quote \"a.c\")) \"zabcy\"))"]) + ["(regex? (Pattern/compile \"a.c\"))" "true"] + ["(.split (Pattern/compile \",\") \"a,b,c\")" "(a b c)"] + ["(do (require '[clojure.string :as s]) (s/replace \"a1b2\" (Pattern/compile \"[0-9]\") \"\"))" "ab"] + ["(boolean (re-find (Pattern/compile \"^x\" Pattern/MULTILINE) \"y\\nx\"))" "true"] + ["(boolean (re-find (re-pattern (Pattern/quote \"a.c\")) \"za.cy\"))" "true"] + ["(boolean (re-find (re-pattern (Pattern/quote \"a.c\")) \"zabcy\"))" "false"]]) (defn run-capture [bin expr] (def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe})) @@ -74,16 +74,14 @@ (var pass 0) (def fails @[]) -(each expr exprs - (def [ocode oracle _] (run-capture "build/jolt" expr)) +(each [expr expected] cases (def [code got err] (run-capture jolt-bin expr)) (cond - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) - (= got oracle) (++ pass) - (array/push fails [expr (string "want `" oracle "`, got `" got "`")]))) + (= got expected) (++ pass) + (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) -(printf "\n_javastatic parity [%s]: %d/%d passed" jolt-bin pass (length exprs)) +(printf "\n_javastatic parity [%s]: %d/%d passed" jolt-bin pass (length cases)) (when (> (length fails) 0) (printf "%d FAIL(s):" (length fails)) (each [e m] fails (printf " FAIL %s\n %s" e m))) diff --git a/test/chez/_ns.janet b/test/chez/_ns.janet index 18a57c0..76d3cf6 100644 --- a/test/chez/_ns.janet +++ b/test/chez/_ns.janet @@ -1,10 +1,10 @@ # jolt-yxqm — namespace value model (find-ns/ns-name/all-ns/resolve/ns-publics/ -# in-ns/*ns* …). TDD harness: drives bin/jolt-chez -e per case (fresh subprocess +# in-ns/*ns* …). TDD harness: drives bin/joltc -e per case (fresh subprocess # = per-case isolation), checks the LAST printed line == expected. Expected -# values are the JVM-canonical reference (build/jolt), captured up front. +# values are the JVM-canonical reference, baked per case. # # janet test/chez/_ns.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) # [label expr expected-last-line] (def cases diff --git a/test/chez/_reader.janet b/test/chez/_reader.janet index fc86cb1..7ad7c09 100644 --- a/test/chez/_reader.janet +++ b/test/chez/_reader.janet @@ -1,14 +1,14 @@ # jolt-r8ku (inc Y) — Chez-side Clojure data reader: read-string / read / # read+string / with-in-str / clojure.edn. The reader (host/chez/reader.ss) -# produces the same jolt forms the Janet reader yields; the *in* family and +# produces jolt forms directly; the *in* family and # clojure.edn are Clojure over the read-string / __parse-next seams. # # Outputs are kept order-stable (equality checks, scalars) so set/map iteration -# order — which legitimately differs from build/jolt — doesn't masquerade as a -# divergence. Oracle = build/jolt. +# order — which is host-dependent — doesn't masquerade as a +# divergence. # # janet test/chez/_reader.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (def cases [# --- scalars + collections (value equality, order-independent) --- @@ -81,11 +81,8 @@ (var pass 0) (def fails @[]) (each [expr expected] cases - (def [ocode oracle _] (run-capture "build/jolt" expr)) (def [code got err] (run-capture jolt-bin expr)) (cond - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) - (not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")]) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) (= got expected) (++ pass) (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) diff --git a/test/chez/_seqpred.janet b/test/chez/_seqpred.janet index a33429c..526832d 100644 --- a/test/chez/_seqpred.janet +++ b/test/chez/_seqpred.janet @@ -3,14 +3,14 @@ # is overlay (`(defn sequential? [x] (or (vector? x) (seq? x)))`), so it inherits # the fix transitively; this pins that both predicates agree with the JVM oracle # over every lazy-seq-producing form (and the native =/hash path via set!). -# Expectations are the build/jolt (JVM-canonical) values. +# Expectations are the JVM-canonical values. # # janet test/chez/_seqpred.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (def cases [# --- seq? over lazy seqs --- - # (NB: not (seq? (range 3)) — the seed makes range an eager vector, chez a lazy + # (NB: range is lazy, so (type (range 3)) is :seq not :vector # seq; a range-container divergence, not the predicate. sequential? agrees on it.) ["seq? map" "(seq? (map inc [1 2 3]))" "true"] ["seq? filter" "(seq? (filter odd? [1 2 3]))" "true"] diff --git a/test/chez/_stdlib.janet b/test/chez/_stdlib.janet index 917bbd3..ca8f183 100644 --- a/test/chez/_stdlib.janet +++ b/test/chez/_stdlib.janet @@ -11,11 +11,11 @@ # through the host seam). # # Outputs are order-stable (value-equality / scalars) so set/map iteration order -# — which legitimately differs from build/jolt — never masquerades as a divergence. -# Oracle = build/jolt. +# — which is host-dependent — never masquerades as a divergence. +# # # janet test/chez/_stdlib.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (def cases [# --- clojure.math (jolt-22vo / jolt-h79) --- @@ -31,7 +31,7 @@ ["(long (clojure.math/cbrt 27))" "3"] ["(< 4.6 (clojure.math/log 100) 4.7)" "true"] # Chez has no native log10 (computed as log(x)/log(10)), so it can differ from - # the seed's C log10 in the last ulp (3 vs 2.9999…); range-check, don't pin. + # C log10 in the last ulp (3 vs 2.9999…); range-check, don't pin. ["(< 2.99 (clojure.math/log10 1000) 3.01)" "true"] ["(do (require (quote [clojure.math :as m])) (long (m/hypot 3 4)))" "5"] ["(mapv (comp long clojure.math/sqrt) [1 4])" "[1 2]"] @@ -63,11 +63,8 @@ (var pass 0) (def fails @[]) (each [expr expected] cases - (def [ocode oracle _] (run-capture "build/jolt" expr)) (def [code got err] (run-capture jolt-bin expr)) (cond - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) - (not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")]) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) (= got expected) (++ pass) (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) diff --git a/test/chez/_str.janet b/test/chez/_str.janet index 49c6266..7946c5b 100644 --- a/test/chez/_str.janet +++ b/test/chez/_str.janet @@ -1,11 +1,11 @@ # jolt-nfca — host java.lang.String method interop on Chez: (.toUpperCase s), # (.indexOf s x), (.substring s a b), the regex methods (.matches/.replaceAll/ -# .replaceFirst), etc. Ported from the seed's string-methods surface -# (src/jolt/eval_resolve.janet). Expectations are the build/jolt (seed) oracle. +# .replaceFirst), etc. The string-methods surface. Each case carries its +# expected value. # An expected of :throws asserts a non-zero exit (unsupported method). # # janet test/chez/_str.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (def cases [["toLowerCase" "(.toLowerCase \"HI\")" "hi"] diff --git a/test/chez/_strns.janet b/test/chez/_strns.janet index 9a35864..64aa5b5 100644 --- a/test/chez/_strns.janet +++ b/test/chez/_strns.janet @@ -2,10 +2,10 @@ # alias `s` established by a runtime (require '[clojure.string :as s]). The Chez # AOT driver pre-evals require forms against the ctx so the alias resolves at # analyze time, and clojure.string is emitted as a prelude tier over the str-* -# primitives. Expectations are the build/jolt (seed) oracle. +# primitives. Each case carries its expected value. # # janet test/chez/_strns.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (defn- with-req [body] (string "(do (require (quote [clojure.string :as s])) " body ")")) diff --git a/test/chez/_type.janet b/test/chez/_type.janet index 65ba4d9..ecdcba4 100644 --- a/test/chez/_type.janet +++ b/test/chez/_type.janet @@ -1,12 +1,11 @@ # jolt-fmm4 — (type x) on Chez: :type meta override, record class-name symbol, # and a comprehensive value->taxonomy mapping (no value type crashes -> must be -# total, the recorded gotcha). Expectations are the build/jolt (seed) oracle. -# Producers that the seed makes eager (range) are avoided: (type (range 3)) is -# :vector on the seed (eager) but :seq on chez (lazy) — a range-container -# divergence unrelated to `type`, covered elsewhere. +# total, the recorded gotcha). Each case carries its expected value. +# (type (range 3)) is :seq (range is lazy); range-container divergences are +# covered elsewhere. # # janet test/chez/_type.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (def cases [# --- scalars --- diff --git a/test/chez/_var_meta.janet b/test/chez/_var_meta.janet index 5f8888d..733fa67 100644 --- a/test/chez/_var_meta.janet +++ b/test/chez/_var_meta.janet @@ -1,16 +1,16 @@ # jolt-zikh — var def-time metadata capture (^:private / ^Type tag / docstring). # (meta (var v)) must carry the def-time reader metadata + :ns/:name, matching the -# JVM-canonical build/jolt. TDD harness: bin/jolt-chez -e per case, last line == +# JVM-canonical reference. TDD harness: bin/joltc -e per case, last line == # expected. # # janet test/chez/_var_meta.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) (def cases # NOTE: ^{:map} metadata on a def name (e.g. (def ^{:doc "hi"} dv 1)) reads as # (def (with-meta name m) v) and is uncompilable for the COMPILER generally - # (analyzer.clj rejects it; the Janet back end punts to its interpreter, which - # Chez lacks) — out of subset, not a meta-capture gap. Shorthand ^:kw / ^Type + # (analyzer.clj rejects it) — out of subset, not a meta-capture gap. Shorthand + # ^:kw / ^Type # and the docstring form keep the name a plain symbol, so they're in scope. [["^:private on var" "(do (def ^:private pv 1) (:private (meta (var pv))))" "true"] ["^Type tag on var" "(do (def ^String tv \"a\") (:tag (meta (var tv))))" "String"] diff --git a/test/chez/_walk.janet b/test/chez/_walk.janet index c50eb6a..858617a 100644 --- a/test/chez/_walk.janet +++ b/test/chez/_walk.janet @@ -1,8 +1,8 @@ # jolt-75sv — list? (a list marker on cseq, since cseq backs both lists and -# realized/lazy seqs) + map-entry-as-vector + clojure.walk. Oracle = build/jolt. +# realized/lazy seqs) + map-entry-as-vector + clojure.walk. # # janet test/chez/_walk.janet -(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/jolt-chez")) +(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc")) # -e reads only the FIRST form — wrap require + use in a single (do ...). (defn w [body] (string "(do (require (quote [clojure.walk :as w])) " body ")")) @@ -63,11 +63,8 @@ (var pass 0) (def fails @[]) (each [expr expected] cases - (def [ocode oracle _] (run-capture "build/jolt" expr)) (def [code got err] (run-capture jolt-bin expr)) (cond - (not= ocode 0) (array/push fails [expr (string "ORACLE FAILED exit " ocode)]) - (not= oracle expected) (array/push fails [expr (string "ORACLE MISMATCH want `" expected "` got `" oracle "`")]) (not= code 0) (array/push fails [expr (string "exit " code "; err: " err)]) (= got expected) (++ pass) (array/push fails [expr (string "want `" expected "`, got `" got "`")]))) diff --git a/test/chez/emit-parity.janet b/test/chez/emit-parity.janet deleted file mode 100644 index 912b0e1..0000000 --- a/test/chez/emit-parity.janet +++ /dev/null @@ -1,210 +0,0 @@ -# Chez Phase 3 inc 1 (jolt-hg7z) — value-parity gate for the PORTABLE Clojure -# emitter (jolt.backend-scheme) vs the Janet host oracle. -# -# The new emitter is jolt-core Clojure; here it runs interpreted ON THE JANET HOST -# (loaded via bootstrap-load-source) as a drop-in for host/chez/emit.janet. Each -# case is analyzed to IR, emitted to Scheme by the CLOJURE emitter, run on Chez, -# and compared to the same program evaluated by the Janet host (jolt's own oracle). -# This isolates "is the translation correct" from "does it run on Chez" — the -# emitter's logic is validated before it has to execute on Chez itself. -# -# janet test/chez/emit-parity.janet (from repo root) -(import ../../src/jolt/api :as api) -(import ../../src/jolt/backend :as backend) -(import ../../src/jolt/reader :as r) -(import ../../src/jolt/evaluator :as evlr) -(import ../../host/chez/driver :as d) -(import ../../host/chez/emit :as emit) -(import ../../src/jolt/types_ctx :as tctx) -(import ../../src/jolt/types_ns :as tns) -(import ../../src/jolt/types_var :as tvar) - -(unless (d/chez-available?) - (print "skip: chez not on PATH") - (os/exit 0)) - -(var total 0) (var fails 0) -(defn ok [name pred &opt extra] - (++ total) - (if pred (printf "ok: %s" name) - (do (++ fails) (printf "FAIL: %s %s" name (or extra ""))))) - -# ctx with the analyzer pipeline + late-bind (same as the driver), plus the -# Clojure emitter loaded interpreted so we can call jolt.backend-scheme/emit. -(def ctx (d/make-ctx)) -(def bs-src (get (get (ctx :env) :embedded-sources) "jolt.backend-scheme")) -(assert bs-src "jolt.backend-scheme not embedded — check stdlib_embed collect") -(backend/bootstrap-load-source ctx "jolt.backend-scheme" bs-src) -(def emit-clj-var (tns/ns-find (tctx/ctx-find-ns ctx "jolt.backend-scheme") "emit")) -(assert emit-clj-var "jolt.backend-scheme/emit not found after load") -(defn emit-clj [ir] (string ((tvar/var-get emit-clj-var) ir))) - -# Janet host oracle, via the real CLI (-e), exactly like run-corpus.janet: take the -# last non-empty stdout line so collection values use jolt's real printer. -(defn cli-oracle [src] - (def proc (os/spawn ["build/jolt" "-e" src] :p {:out :pipe :err :pipe})) - (def out (ev/read (proc :out) 0x100000)) - (ev/read (proc :err) 0x100000) - (os/proc-wait proc) - (def lines (filter (fn [l] (not (empty? l))) (string/split "\n" (string/trim (if out (string out) ""))))) - (if (empty? lines) "" (last lines))) - -(defn- parse-all [src] - (def out @[]) - (var s src) - (while (> (length (string/trim s)) 0) - (def parsed (r/parse-next s)) - (set s (in parsed 1)) - (def f (in parsed 0)) - (unless (nil? f) (array/push out f))) - out) - -# Drain a pipe to EOF (a stdout side effect can flush in >1 write). -(defn- drain [pipe] - (def b @"") - (var c (ev/read pipe 0x10000)) - (while c (buffer/push b c) (set c (ev/read pipe 0x10000))) - (string b)) - -# Compile `src` to a Chez program using the CLOJURE emitter, run it, return -# [code stdout stderr]. Mirrors driver/compile-program + run-on-chez but swaps -# emit/emit -> emit-clj. -(defn run-clj [src] - (def forms (parse-all src)) - (def n (length forms)) - (def def-scm @[]) - (for i 0 (- n 1) - (def f (in forms i)) - (array/push def-scm (emit-clj (backend/analyze-form ctx f))) - (evlr/eval-form ctx @{} f)) - (def final-scm (emit-clj (backend/analyze-form ctx (in forms (- n 1))))) - (def prog (emit/program def-scm final-scm)) - (def path (string "/tmp/jolt-chez-parity-" (os/getpid) ".ss")) - (spit path prog) - (def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe})) - (def out (drain (proc :out))) - (def err (drain (proc :err))) - (def code (os/proc-wait proc)) - [code (string/trim out) (string/trim err)]) - -# A case passes when the Clojure emitter's Chez output equals the Janet oracle. -# An emit-time throw (out-of-subset op) is a clean FAIL, not a crash. -(defn check [name src] - (def want (cli-oracle src)) - (def res (protect (run-clj src))) - (if (not (res 0)) - (ok name false (string "emit/run threw: " (res 1))) - (let [[code out err] (res 1)] - (ok name (and (= code 0) (= out want)) - (string "chez=" out " oracle=" want " code=" code " | " err))))) - -# For cases where the Janet oracle carries a known latent bug (e.g. quoted-set -# literals don't reconstruct, jolt-tg9s) but Chez is correct: assert Chez output -# against the hand-verified real-Clojure value directly. -(defn check-exact [name src want] - (def res (protect (run-clj src))) - (if (not (res 0)) - (ok name false (string "emit/run threw: " (res 1))) - (let [[code out err] (res 1)] - (ok name (and (= code 0) (= out want)) - (string "chez=" out " want=" want " code=" code " | " err))))) - -# --- inc 1 subset: const/local/var/if/do/let/loop/recur/invoke/fn/def ---------- - -(check "(+ 1 2)" "(+ 1 2)") -(check "arith mixed" "(- (* 3 4) (/ 10 2))") -(check "nested let" "(let [a 1 b (+ a 10) c (* b 2)] (- c a))") -(check "let sequential" "(loop [a 1 b (+ a 10)] (+ a b))") -(check "if comparison" "(if (< 3 5) 100 200)") -(check "if =" "(if (= 2 2) :y :n)") -(check "do side-effect ret" "(do 1 2 3)") -(check "fib 30" "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 30)") -(check "factorial loop" "(defn fact [n] (loop [i n acc 1] (if (< i 2) acc (recur (- i 1) (* acc i))))) (fact 10)") -(check "multi-arity" "(defn g ([x] (g x 10)) ([x y] (+ x y))) (g 5)") -(check "variadic" "(defn s [& xs] (reduce + 0 xs)) (s 1 2 3 4)") -(check "higher-order inc" "(reduce + 0 (map inc (range 5)))") -(check "anon fn invoke" "((fn [x] (* x x)) 7)") -(check "shorthand fn" "(#(+ %1 %2) 3 4)") -(check "truthy local" "(defn t [x] (if x 1 2)) (t false)") -(check "mod rem quot" "(+ (mod 17 5) (rem 17 5) (quot 17 5))") -(check "min max" "(+ (min 3 1 2) (max 3 1 2))") -# --- inc 2 subset: collection literals (vector/map/set) + quote ----------------- - -(check "vector literal" "[1 2 3]") -(check "nested vector" "[1 [2 3] [4 [5 6]]]") -(check "vector of exprs" "[(+ 1 2) (* 3 4)]") -(check "map literal eq" "(= {:a 1 :b 2} {:a 1 :b 2})") -(check "map get" "(get {:a 1 :b 2} :b)") -(check "set literal eq" "(= #{1 2 3} #{3 2 1})") -(check "set contains" "(contains? #{1 2 3} 2)") -(check "vector count" "(count [10 20 30 40])") -(check "conj vector" "(conj [1 2] 3 4)") -(check "assoc map" "(get (assoc {:a 1} :b 2) :b)") -(check "coll as fn" "({:a 1 :b 2} :a)") -(check "kw as fn" "(:b {:a 1 :b 2})") -(check "kw as fn default" "(:z {:a 1} 99)") -(check "quote list" "(count (quote (a b c d)))") -(check "quote vector eq" "(= (quote [1 2 3]) [1 2 3])") -(check "quote symbol eq" "(= (quote foo) (quote foo))") -(check "quote ns symbol eq" "(= (quote my.ns/bar) (quote my.ns/bar))") -(check "quote nested count" "(count (quote (a [1 2] {:k v})))") -(check "quote keyword in list" "(first (quote (:a :b :c)))") -(check "quote map" "(get (quote {:x 1 :y 2}) :y)") -# Janet oracle is buggy here (jolt-tg9s): quoted-set doesn't reconstruct. Chez is -# correct (real Clojure: true) — assert against the verified value. -(check-exact "quote set contains" "(contains? (quote #{:p :q}) :p)" "true") -(check-exact "quote set eq literal" "(= (quote #{1 2 3}) #{1 2 3})" "true") -(check "vector map filter" "(into [] (filter even? (map inc [1 2 3 4 5])))") -(check "map over literal" "(reduce + (vals {:a 1 :b 2 :c 3}))") - -# --- inc 3 subset: try/throw + def-meta + quoted-sym-meta + inst/uuid + regex ---- - -(check "try catch" `(try (throw (ex-info "boom" {})) (catch Throwable e 42))`) -(check "try catch value" `(+ (try (throw (ex-info "" {})) (catch Throwable e 10)) 5)`) -(check "try no throw" `(try 7 (catch Throwable e 0))`) -(check "try finally" `(try 1 (finally 2))`) -(check "try finally side" `(try (throw (ex-info "" {})) (catch Throwable e 3) (finally 9))`) -(check "def private runs" `(do (defn ^:private secret [] 99) (secret))`) -(check "def tagged runs" `(do (def ^:dynamic *q* 5) *q*)`) -(check "quoted sym meta eq" `(do (def x (quote ^:foo bar)) (= x x))`) -(check "inst eq" `(= #inst "2020-01-01" #inst "2020-01-01")`) -(check "uuid eq" `(= #uuid "00000000-0000-0000-0000-000000000000" #uuid "00000000-0000-0000-0000-000000000000")`) -(check "regex smoke" `(do (def r #"[0-9]+") true)`) -(check "char eq" `(= \a \a)`) -(check "char int" `(do (def c \newline) (= c \newline))`) -(check "quoted char" `(= (quote \z) \z)`) - -(check "mandelbrot run(20)" - (string `` -(defn count-point [cr ci cap] - (loop [i 0 zr 0.0 zi 0.0] - (if (or (>= i cap) (> (+ (* zr zr) (* zi zi)) 4.0)) - i - (recur (inc i) (+ (- (* zr zr) (* zi zi)) cr) (+ (* 2.0 (* zr zi)) ci))))) -(defn run [n] - (let [cap 200 nd (* 1.0 n)] - (loop [y 0 acc 0] - (if (< y n) - (let [ci (- (/ (* 2.0 y) nd) 1.0) - row (loop [x 0 a 0] - (if (< x n) - (let [cr (- (/ (* 2.0 x) nd) 1.5)] - (recur (inc x) (+ a (count-point cr ci cap)))) - a))] - (recur (inc y) (+ acc row))) - acc)))) -`` "\n(run 20)")) - -# Structural: a ^:private def must now take the def-var-with-meta! path (the meta -# is a portable struct after the h-sym-meta fix; before, map?/count failed on the -# raw table and it silently fell back to the lean def-var!, dropping the meta). -(let [scm (emit-clj (backend/analyze-form ctx (in (r/parse-next "(def ^:private p 1)") 0)))] - (ok "def ^:private emits def-var-with-meta!" - (truthy? (string/find "def-var-with-meta!" scm)) scm)) -(let [scm (emit-clj (backend/analyze-form ctx (in (r/parse-next "(def plain 1)") 0)))] - (ok "plain def stays lean def-var!" - (and (truthy? (string/find "(def-var! " scm)) - (not (string/find "with-meta" scm))) scm)) - -(printf "\n%d/%d ok" (- total fails) total) -(when (> fails 0) (os/exit 1)) diff --git a/test/chez/emit-test.janet b/test/chez/emit-test.janet deleted file mode 100644 index 171bec0..0000000 --- a/test/chez/emit-test.janet +++ /dev/null @@ -1,721 +0,0 @@ -# Phase 1 (jolt-cf1q.2) — REAL pipeline end to end: actual Clojure source -> -# Janet-hosted analyzer -> host-neutral IR -> Scheme emitter -> run on Chez. -# Correctness is checked by parity against the SAME program evaluated by the -# Janet host (jolt's own oracle), so a divergence is the back end's, not the -# program's. -# janet test/chez/emit-test.janet (from repo root) -(import ../../src/jolt/api :as api) -(import ../../src/jolt/backend :as backend) -(import ../../src/jolt/reader :as r) -(import ../../host/chez/driver :as d) -(import ../../host/chez/emit :as emit) - -(unless (d/chez-available?) - (print "skip: chez not on PATH") - (os/exit 0)) - -(var total 0) (var fails 0) -(defn ok [name pred &opt extra] - (++ total) - (if pred (printf "ok: %s" name) - (do (++ fails) (printf "FAIL: %s %s" name (or extra ""))))) - -# Janet-host oracle: evaluate the same program, stringify its value the way jolt -# prints it at the CLI (so "832040" not "832040.0", "0.5" not 1/2, etc.). -(def oracle-ctx (api/init {:compile? true})) -(defn oracle [src] (string (api/load-string oracle-ctx src))) - -# Canonical CLI oracle (the run-corpus gate's boundary): collection values don't -# round-trip through (string value) — they need jolt's real `-e` printer. Take -# the last non-empty stdout line, exactly like run-corpus.janet. -(defn cli-oracle [src] - (def proc (os/spawn ["build/jolt" "-e" src] :p {:out :pipe :err :pipe})) - (def out (ev/read (proc :out) 0x100000)) - (ev/read (proc :err) 0x100000) - (os/proc-wait proc) - (def lines (filter (fn [l] (not (empty? l))) (string/split "\n" (string/trim (if out (string out) ""))))) - (if (empty? lines) "" (last lines))) - -(def ctx (d/make-ctx)) - -# 1) constant-folded arithmetic: (+ 1 2) -> the analyzer folds to const 3. -(let [[code out err] (d/run-on-chez ctx "(+ 1 2)")] - (ok "(+ 1 2) = 3" (and (= code 0) (= out "3") (= out (oracle "(+ 1 2)"))) (string out " | " err))) - -# 2) fib: var-cell def + named-fn self-recursion + native arith, via real IR. -(let [src "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 30)" - [code out err] (d/run-on-chez ctx src)] - (ok "(fib 30) = 832040" (and (= code 0) (= out "832040") (= out (oracle src))) (string out " | " err))) - -# 3) mandelbrot kernel: loop/recur, let, or-expansion, cross-var call -# (run -> count-point), flonum compute. Parity vs the Janet host on run(40). -(def mandel-defs `` -(defn count-point [cr ci cap] - (loop [i 0 zr 0.0 zi 0.0] - (if (or (>= i cap) (> (+ (* zr zr) (* zi zi)) 4.0)) - i - (recur (inc i) - (+ (- (* zr zr) (* zi zi)) cr) - (+ (* 2.0 (* zr zi)) ci))))) -(defn run [n] - (let [cap 200 - nd (* 1.0 n)] - (loop [y 0 acc 0] - (if (< y n) - (let [ci (- (/ (* 2.0 y) nd) 1.0) - row (loop [x 0 a 0] - (if (< x n) - (let [cr (- (/ (* 2.0 x) nd) 1.5)] - (recur (inc x) (+ a (count-point cr ci cap)))) - a))] - (recur (inc y) (+ acc row))) - acc)))) -``) -(let [src (string mandel-defs "\n(run 40)") - [code out err] (d/run-on-chez ctx src)] - (ok "mandelbrot run(40) parity" (and (= code 0) (= out (oracle src))) - (string "chez=" out " janet=" (oracle src) " | " err))) - -# 3a2) truthy? elision (jolt-nkcb): an :if test that provably yields a Scheme -# boolean (native comparison/not, or a boolean const) needs no jolt-truthy? -# wrapper — (if (jolt-truthy? (< a b)) …) === (if (< a b) …). Sound because -# jolt-truthy? of #t/#f is identity. The hot fib/mandelbrot tests are all -# comparisons, so this is a direct ceiling lever. Inspect the emitted Scheme. -(defn- emit-scm [src] (d/scheme-emit ctx (backend/analyze-form ctx (in (r/parse-next src) 0)))) -(each [label src wrapped?] [["if < elides wrapper" "(fn [n] (if (< n 2) 1 2))" false] - ["if > elides wrapper" "(fn [n] (if (> n 2) 1 2))" false] - ["if = elides wrapper" "(fn [n] (if (= n 2) 1 2))" false] - ["if <= elides wrapper" "(fn [n] (if (<= n 2) 1 2))" false] - ["if not elides wrapper" "(fn [x] (if (not x) 1 2))" false] - ["if true const elides" "(fn [] (if true 1 2))" false] - ["if local keeps wrapper" "(fn [x] (if x 1 2))" true] - ["if + keeps wrapper" "(fn [n] (if (+ n 1) 1 2))" true]] - (let [scm (emit-scm src) has (truthy? (string/find "jolt-truthy?" scm))] - (ok (string "truthy elision: " label) (= has wrapped?) - (string "wrapped?=" has " want " wrapped? " | " scm)))) - -# 3b) regressions found via the corpus probe: -# - loop binds SEQUENTIALLY (Scheme named-let is parallel); b must see a. -# - #(...) shorthand gensyms params with a trailing `#` (invalid in Scheme). -(each [label src] [["loop sequential init" "(loop [a 1 b (+ a 10)] (+ a b))"] - ["#() shorthand" "(#(+ %1 %2) 1 2)"]] - (let [[code out err] (d/run-on-chez ctx src)] - (ok label (and (= code 0) (= out (oracle src))) (string "chez=" out " janet=" (oracle src) " | " err)))) - -# 3c) persistent collections (jolt-wgbz): vector/map/set literals + leaf ops. -# Maps/sets print in jolt's INTERNAL hash order, which a Scheme HAMT won't -# reproduce — so unordered cases are checked via `(= ...)` (prints true/false, -# exactly how the run-corpus gate compares them), and only ORDERED vectors are -# compared by printed form. Parity is still vs the Janet oracle in both shapes. -(each src [# ordered: direct printed-form parity - "[1 2 3]" - "(conj [1 2] 3)" - "(count [1 2 3])" - "(nth [10 20 30] 1)" - "(get [10 20 30] 0)" - "(peek [1 2 3])" - "(pop [1 2 3])" - # unordered / boolean: equality-wrapped, order-independent - "(= {:a 1 :b 2} {:b 2 :a 1})" - "(= {:a 1 :b 2} (assoc {:a 1} :b 2))" - "(= 1 (get {:a 1} :a))" - "(= 2 (count {:a 1 :b 2}))" - "(= 99 (get {:a 1} :z 99))" - "(= {:a 1} (dissoc {:a 1 :b 2} :b))" - "(= #{1 2 3} (conj #{1 2} 3))" - "(= #{1 2} (conj #{1 2} 2))" - "(contains? #{1 2} 1)" - "(contains? #{1 2} 9)" - "(contains? {:a 1} :a)" - "(empty? [])" - "(empty? [1])" - "(empty? {})" - "(= [1 2] [1 2])" - "(= [1 2] [1 3])" - "(= #{1 2} #{2 1})" - "(= {1 2} {1 3})"] - (let [[code out err] (d/run-on-chez ctx src) - want (cli-oracle src)] - (ok (string "coll: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3d) dynamic IFn dispatch (inc 3b): a keyword/vector/coll held in a LOCAL (let -# binding or fn param) and called as a fn. The 3 ex-known-divergences. The -# callee is a :local that's NOT the fn's self-name, so emit routes it through -# the jolt-invoke fallback (procedure? -> apply; keyword/coll -> lookup). -(each [src want] [["(let [v [10 20 30]] (v 1))" "20"] - ["(let [k :a] (k {:a 7}))" "7"] - ["((fn [f] (f {:a 1})) :a)" "1"]] - (let [[code out err] (d/run-on-chez ctx src)] - (ok (string "ifn: " src) (and (= code 0) (= out want)) - (string "chez=" out " want=" want " | " err)))) - -# 3e) seq tier (inc 3b): jolt list type, first/rest/next/seq/cons/list, lazy-seq -# (range/take over an infinite seq), map/filter/reduce/into/remove, keys/vals. -# Lists and lazy seqs print as (...) and are sequential-= to vectors. Ordered -# shapes -> printed-form parity vs the CLI oracle. -(each src ["(first [1 2 3])" - "(rest [1 2 3])" - "(rest [1])" - "(rest [])" - "(next [1 2 3])" - "(next [1])" - "(cons 0 [1 2 3])" - "(cons 1 nil)" - "(list 1 2 3)" - "(list)" - "(seq [])" - "(conj (list 2 3) 1)" - "(conj nil 1 2)" - "(map inc [1 2 3])" - "(map + [1 2 3] [10 20 30])" - "(map :a [{:a 1} {:a 2}])" - "(filter even? [1 2 3 4])" - "(remove even? [1 2 3 4])" - "(reduce + 0 [1 2 3])" - "(reduce + [1 2 3])" - "(reduce + (map inc (range 4)))" - "(into [] [1 2 3])" - "(into [1] (list 2 3))" - "(take 3 (range))" - "(reverse [1 2 3])" - "(apply + [1 2 3])" - "(count (map inc [1 2 3]))"] - (let [[code out err] (d/run-on-chez ctx src) - want (cli-oracle src)] - (ok (string "seq: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3f) seq tier — unordered / cross-type, equality-wrapped (prints true/false): -# keys/vals order is HAMT order, into-map / into-set unordered; sequential = -# across vector and list. -(each src ["(= 2 (count (keys {:a 1 :b 2})))" - "(= 3 (reduce + (vals {:a 1 :b 2})))" - "(= {:a 1 :b 2} (into {} [[:a 1] [:b 2]]))" - "(= #{1 2 3} (into #{} [1 2 3]))" - "(= [1 2 3] (list 1 2 3))" - "(= [1 2 3] (map inc [0 1 2]))" - # jolt returns a vector for (seq vec) / bounded (range); Chez returns a - # Clojure-canonical lazy seq. Values are sequential-=, printed forms differ. - "(= [1 2 3] (seq [1 2 3]))" - "(= [0 1 2 3 4] (range 5))"] - (let [[code out err] (d/run-on-chez ctx src)] - (ok (string "seq=: " src) (and (= code 0) (= out "true")) - (string "chez=" out " | " err)))) - -# 3g) multi-arity + variadic fns (inc 3c): case-lambda dispatch, a Scheme rest -# arg collected into a jolt seq (nil when empty), recur within an arity and a -# self-call across arities. Value parity vs the CLI oracle. -(each src ["((fn ([x] (* x 2)) ([x y] (+ x y))) 5)" - "((fn ([x] (* x 2)) ([x y] (+ x y))) 3 4)" - "(defn g ([x] x) ([x y] (+ x y))) (g 10)" - "(defn g ([x] x) ([x y] (+ x y))) (g 10 20)" - "(defn h [a & more] (count more)) (h 1 2 3 4)" - # empty rest is nil (Clojure): count 0, first nil (prints "") - "(defn h [a & more] (count more)) (h 1)" - "(defn h [a & more] (first more)) (h 1)" - "(defn h [a & more] (first more)) (h 1 2 3)" - "(defn h [a & more] (reduce + a more)) (h 1 2 3 4)" - "(defn h [a & more] (reduce + a more)) (apply h [1 2 3 4])" - # self-call from one arity to another, then recur within it - "(defn f ([n] (f n 0)) ([n acc] (if (zero? n) acc (recur (- n 1) (+ acc n))))) (f 5)" - "((fn r [& xs] (if (seq xs) (+ (first xs) (apply r (rest xs))) 0)) 1 2 3)"] - (let [[code out err] (d/run-on-chez ctx src) - want (cli-oracle src)] - (ok (string "arity: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3i) throw / try / catch / finally + ex-info (inc 3e). Value parity vs the CLI -# oracle for caught throws; an uncaught throw must exit non-zero. -(each src [# jolt catch syntax is (catch Class binding body); the class is dropped - # in the IR (catch-all). catch binds the thrown value raw. - "(try (throw 42) (catch Exception e e))" - "(try (+ 1 (throw 7)) (catch Exception e (* e 10)))" - # finally runs and its value is discarded (try returns the body value) - "(try 5 (finally 99))" - "(try (throw 3) (catch Exception e (+ e 1)) (finally 99))" - # body value passes through when nothing throws - "(try (+ 2 3) (catch Exception e :nope))" - # ex-info builds a real jolt map: read message/data via get (native-op) - "(get (ex-info \"boom\" {:a 1}) :message)" - "(get (ex-info \"boom\" {:a 1}) :data)" - "(try (throw (ex-info \"boom\" {:a 1})) (catch Exception e (get e :message)))" - "(try (throw (ex-info \"boom\" {:a 7})) (catch Exception e (get (get e :data) :a)))" - # nested try: inner rethrows, outer catches - "(try (try (throw 1) (catch Exception e (throw (+ e 1)))) (catch Exception e (* e 100)))"] - (let [[code out err] (d/run-on-chez ctx src) - want (cli-oracle src)] - (ok (string "throw/try: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# an uncaught throw aborts the program (non-zero exit) — matches the corpus -# `:throws` semantics (interpret/compile both bail). -(let [[code out err] (d/run-on-chez ctx "(throw (ex-info \"unhandled\" {}))")] - (ok "throw: uncaught exits non-zero" (not= code 0) - (string "code=" code " out=" out))) - -# 3j) quoted literals (inc 3f): a :quote node reconstructs the reader form as RT -# values — symbols, lists, vectors, maps, sets, nested. Value parity vs the CLI. -(each src ["'foo" - "'foo/bar" - "':kw" - "'(1 2 3)" - "'[1 2 3]" - "'(a b c)" - "'{:a 1}" - "'(1 (2 3) 4)" - "(first '(10 20 30))" - "(count '[1 2 3])" - "(rest '(1 2 3))" - "(= 'foo 'foo)" - "(= 'a 'b)" - "(map inc '(1 2 3))" - "(conj '[1 2] 3)" - "(get '{:a 7} :a)"] - (let [[code out err] (d/run-on-chez ctx src) - want (cli-oracle src)] - (ok (string "quote: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3k) letfn + declare/def-no-init (inc 3g). letfn lowers to a Scheme `letrec*` -# (mutual recursion between the named local fns — a plain let* can't forward- -# ref a sibling). declare/(def x) with no init pre-creates the var cell so a -# forward reference resolves; the real def runs before any call. -(each src [# single local fn - "(letfn [(twice [x] (* x 2))] (twice 5))" - # self-recursion within a local fn - "(letfn [(fact [n] (if (zero? n) 1 (* n (fact (dec n)))))] (fact 5))" - # MUTUAL recursion — the letrec semantics a sequential let* lacks - "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 10))" - "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (od? 7))" - # local fn passed to a higher-order fn - "(letfn [(sq [x] (* x x))] (map sq [1 2 3]))" - # declare + forward reference (the canonical mutually-recursive top-level use) - "(declare is-ev) (defn is-od [n] (if (zero? n) false (is-ev (dec n)))) (defn is-ev [n] (if (zero? n) true (is-od (dec n)))) (is-ev 10)" - # declare then redefine: the real def overwrites the reserved cell - "(declare foo) (def foo 10) foo"] - (let [[code out err] (d/run-on-chez ctx src) - want (cli-oracle src)] - (ok (string "letfn/declare: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3l) host interop method calls (inc 3h). (.method target arg*) analyzes to a -# :host-call IR node and lowers to a dispatch. The Janet back end PUNTS these -# (no interop model -> interpreter); the Chez RT shims the File methods -# jolt-core's io tier uses via jolt-host-call (.isDirectory -> file-directory?, -# .listFiles -> directory-list). All OTHER methods (.write/.append/.read/... on -# a StringWriter/StringReader/record) route through record-method-dispatch -# (jolt-avt6 removed .write from the jolt-host-call fast-path so a StringWriter -# jhost handles it). Interop has no portable oracle (the Janet host models it -# differently), so these are emit-shape checks plus one deterministic runtime -# probe (the root "/" is always a directory). -(each [label src needle] - [["emit .write -> record-method-dispatch" "(fn [w x] (.write w x))" "record-method-dispatch"] - ["emit .write keeps method name" "(fn [w x] (.write w x))" "\"write\""] - ["emit .isDirectory -> jolt-host-call" "(fn [f] (.isDirectory f))" "isDirectory"] - ["emit .listFiles -> jolt-host-call" "(fn [f] (.listFiles f))" "listFiles"]] - (let [scm (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0))))] - (ok label (and (scm 0) (string/find needle (scm 1))) (string/format "%p" scm)))) - -(let [[code out err] (d/run-on-chez ctx "(.isDirectory \"/\")")] - (ok "runtime .isDirectory \"/\" = true" (and (= code 0) (= out "true")) - (string "chez=" out " | " err))) - -# 3l') host class statics + constructors (jolt-avt6). Class/member lowers to a -# :host-static node (host-static-ref in value position, host-static-call as a -# call head); (Class. ...) / (new Class ...) lower to :host-new. The Janet back -# end punts all three; the Chez RT resolves them from the class-statics / -# class-ctors / jhost-method registries (host/chez/host-static.ss). Emit-shape -# checks; the registry behaviour is covered by test/chez/_javastatic.janet. -(each [label src needle] - [["emit Class/field -> host-static-ref" "(fn [] Long/MAX_VALUE)" "(host-static-ref \"Long\" \"MAX_VALUE\")"] - ["emit Class/method call -> host-static-call" "(fn [] (System/getenv))" "(host-static-call \"System\" \"getenv\")"] - ["emit static call passes args" "(fn [x] (Long/parseLong x))" "(host-static-call \"Long\" \"parseLong\""] - ["emit (Class.) -> host-new" "(fn [] (StringBuilder.))" "(host-new \"StringBuilder\")"] - ["emit (new Class ...) -> host-new" "(fn [s] (new java.io.StringReader s))" "(host-new \"java.io.StringReader\""]] - (let [scm (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0))))] - (ok label (and (scm 0) (string/find needle (scm 1))) (string/format "%p" scm)))) - -# 3l'') the `.` special form + `.-field` desugar (jolt-kuic). (. target member -# arg*) and (.-field target) lower to a :host-call routed through -# record-method-dispatch (a non-shimmed method); the dash on a field member -# survives in the method name so dot-forms.ss reads it as a field access. The -# Janet back end punts :host-call (interpreter re-runs the original `.` form); -# runtime behaviour is covered by test/chez/_dotform.janet. -(each [label src needle] - [["emit (. obj method) -> record-method-dispatch" "(fn [o] (. o frob))" "record-method-dispatch"] - ["emit (. obj method) keeps method name" "(fn [o] (. o frob))" "\"frob\""] - ["emit (. obj method arg) passes args" "(fn [o a] (. o frob a))" "record-method-dispatch"] - ["emit (.-field obj) keeps dash" "(fn [o] (.-value o))" "\"-value\""] - ["emit (. obj -field) keeps dash" "(fn [o] (. o -value))" "\"-value\""]] - (let [scm (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0))))] - (ok label (and (scm 0) (string/find needle (scm 1))) (string/format "%p" scm)))) - -# 3m) regex (jolt-i0s3): the #"…" literal lowers to a jolt-regex value over the -# vendored irregex; re-pattern/re-matches/re-find/re-seq/regex? are def-var!'d -# into clojure.core (not subset native-ops — irregex's Unicode/property -# semantics differ from the seed's byte-PEG), so they resolve in PRELUDE mode, -# the path the assembled prelude takes. Parity vs the CLI oracle on standard -# PCRE patterns both engines agree on. -(defn run-prelude [src] - (emit/set-prelude-mode! true) - (def r (protect (emit/emit (backend/analyze-form ctx (in (r/parse-next src) 0))))) - (emit/set-prelude-mode! false) - (if (not (r 0)) [:emit-err (r 1) ""] - (do - # PID-unique path: two emit-test processes (or a foreground -e) must not - # read each other's half-written program file. - (def path (string "/tmp/chez-prelude-" (os/getpid) ".ss")) - (spit path (emit/program @[] (r 1))) - (def proc (os/spawn ["chez" "--script" path] :p {:out :pipe :err :pipe})) - (def out (ev/read (proc :out) 0x100000)) - (def err (ev/read (proc :err) 0x100000)) - [(os/proc-wait proc) (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))]))) - -# bare #"…" literal runs in plain subset mode (the :regex node needs no core fn). -(each src ["#\"\\d+\"" "(do #\"a.c\")"] - (let [[code out err] (d/run-on-chez ctx src) want (cli-oracle src)] - (ok (string "regex literal: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# re-* surface via prelude mode (def-var!'d fns), parity vs the CLI oracle. -(each src ["(re-matches #\"\\d+\" \"123\")" - "(re-matches #\"\\d+\" \"12a\")" - "(re-find #\"\\d+\" \"abc123def\")" - "(re-find #\"([a-z])(\\d)\" \"--a1--\")" - "(re-seq #\"\\d+\" \"a1b22c333\")" - "(regex? #\"\\d+\")" - "(re-matches #\"[0-9a-fA-F]{8}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{4}-[0-9a-fA-F]{12}\" \"550e8400-e29b-41d4-a716-446655440000\")"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "regex: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3h) prelude mode (inc 3d): emitting clojure.core ITSELF, a core->core ref must -# lower to a runtime var-deref instead of being rejected as "out of subset". -# `frequencies` is a core fn but not a native-op, so it exercises the switch. -(let [ir (backend/analyze-form ctx (in (r/parse-next "(fn [x] (frequencies x))") 0))] - # subset mode (the default): a non-native core ref is rejected at emit time. - (ok "prelude: subset mode rejects non-native core ref" - (let [r (protect (emit/emit ir))] (not (r 0)))) - # prelude mode: the same ref lowers to (var-deref "clojure.core" "frequencies"). - (emit/set-prelude-mode! true) - (def scm (protect (emit/emit ir))) - (emit/set-prelude-mode! false) - (ok "prelude: mode lowers non-native core ref to var-deref" - (and (scm 0) - (string/find "var-deref" (scm 1)) - (string/find "frequencies" (scm 1))) - (string/format "%p" scm))) - -# 3n) atoms (jolt-9ziu): atom/deref/swap!/reset! are host-coupled (stay in the -# Janet seed, no overlay def-var!), so the Chez host needs an RT shim -# (host/chez/atoms.ss). They lower to var-deref in prelude mode. The hierarchy -# machinery (global-hierarchy = (atom (make-hierarchy))) needs `atom` at the -# prelude's LOAD time, so this is a load blocker, not just a lazy gap. swap! -# invokes its fn through jolt-invoke; compare-and-set!/swap-vals!/reset-vals! -# are overlay fns that compose the native kernel. -(each src ["(deref (atom 42))" - "@(atom 99)" - "(let [a (atom 0)] (reset! a 7) (deref a))" - "(let [a (atom 0)] (swap! a inc) (swap! a inc) (deref a))" - "(let [a (atom 10)] (swap! a + 5) (deref a))" - "(let [a (atom 1)] (reset! a 2) [(deref a) @a])" - "(let [a (atom 0)] (compare-and-set! a 0 5) (deref a))" - "(let [a (atom 0)] (compare-and-set! a 9 5) (deref a))"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "atom: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3o) type predicates + name/namespace (jolt-9ziu): seed natives the overlay -# assumes; the Chez host shims them (host/chez/predicates.ss) and def-var!s them -# into clojure.core, so they resolve in prelude mode. Semantics match the seed -# (core_types.janet): map?/vector?/set? strict over the persistent records, -# seq? only for real sequences, coll? the union. Parity vs the CLI oracle. -(each src ["(nil? nil)" "(nil? 0)" - "(number? 3)" "(number? :a)" "(string? \"x\")" "(string? 1)" - "(integer? 3.5)" - "(symbol? 'x)" "(keyword? :x)" "(keyword? 'x)" - "(map? {:a 1})" "(map? [1 2])" - "(vector? [1 2])" "(vector? '(1 2))" - "(set? #{1 2})" "(set? [1])" - # NB: (seq? (seq [1 2])) is true on Chez (Clojure-correct — a seq IS a - # seq) but the seed oracle returns false (non-canonical), so it's not a - # like-for-like cli-oracle comparison; the corpus encodes the canonical - # value, where Chez agrees. Test seq? on the unambiguous cases here. - "(seq? [1 2])" "(seq? '(1 2))" - "(coll? [1])" "(coll? {:a 1})" "(coll? 3)" - "(fn? inc)" "(fn? 3)" - "(boolean nil)" "(boolean 5)" - "(name :foo)" "(name 'bar)" "(name \"baz\")" - "(namespace :a/b)" "(namespace :x)"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "pred: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3p) converters + string ops (jolt-t6cr): str/subs/vec/keyword/symbol/compare/ -# int/double/gensym are host-coupled seed natives (host/chez/converters.ss), -# def-var!'d into clojure.core, resolved in prelude mode. Semantics match the -# seed (str-render-one for str, the 3-way core-compare, truncating int). Parity -# vs the CLI oracle. -(each src ["(str)" "(str \"a\")" "(str \"a\" \"b\" \"c\")" "(str 1 2)" - "(str :k)" "(str nil)" "(str \"x\" nil \"y\")" "(str \\a)" - "(str 'sym)" "(str [1 2])" "(str (* 1.0 5))" - "(subs \"hello\" 1)" "(subs \"hello\" 1 3)" - "(vec (list 1 2 3))" "(vec (range 3))" "(vec \"ab\")" "(count (vec (range 4)))" - "(keyword \"foo\")" "(keyword \"ns\" \"bar\")" "(keyword 'sym)" - "(name (keyword \"a\" \"b\"))" "(namespace (keyword \"a\" \"b\"))" - "(symbol \"x\")" "(str (symbol \"ns\" \"y\"))" "(name (symbol \"z\"))" - "(compare 1 2)" "(compare 2 1)" "(compare 1 1)" "(compare \"a\" \"b\")" - "(compare :a :b)" "(compare [1 2] [1 3])" "(compare nil nil)" "(compare nil 1)" - "(int 3.7)" "(int \\A)" "(double 5)" "(double \\A)"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "conv: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) -# gensym uses a per-process counter, so only the PREFIX is stable across the -# Chez run vs the Janet oracle; the numeric suffix legitimately differs. -(each src ["(symbol? (gensym))" "(subs (name (gensym \"foo_\")) 0 4)" "(string? (name (gensym)))"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "conv: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3q) transients (jolt-kl2l): transient/persistent!/conj!/assoc!/dissoc!/disj!/ -# pop! as copy-on-write over the persistent collections (host/chez/transients.ss), -# plus persistent disj. get/count/contains? see THROUGH a transient (frequencies -# and group-by do (get tm k) on a transient map). vector? on a transient vector -# is false. Map/set print order isn't canonical, so assert via get/count/contains?. -(each src ["(persistent! (conj! (transient []) 1 2 3))" - "(count (conj! (conj! (transient []) 1) 2))" - "(get (assoc! (transient {}) :a 5) :a)" - "(get (transient {:x 9}) :x)" - "(contains? (assoc! (transient {}) :k 1) :k)" - "(count (persistent! (dissoc! (assoc! (assoc! (transient {}) :a 1) :b 2) :a)))" - "(vector? (transient []))" - "(persistent! (pop! (conj! (transient [1 2 3]) 4)))" - "(count (persistent! (disj! (transient #{1 2 3}) 2)))" - "(contains? (disj #{1 2 3} 2) 2)" - "(count (disj #{1 2 3} 2))"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "transient: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# frequencies/group-by/into are OVERLAY fns built on transients — they need the -# full assembled prelude, so exercise them end-to-end through the jolt-chez -e -# binary (which loads rt.ss + the prelude). This doubles as a smoke test of the -# assembled -e-capable jolt-chez itself. -(defn run-jolt-chez [src] - (def proc (os/spawn ["bin/jolt-chez" "-e" src] :p {:out :pipe :err :pipe})) - (def out (ev/read (proc :out) 0x100000)) - (def err (ev/read (proc :err) 0x100000)) - [(os/proc-wait proc) (string/trim (if out (string out) "")) (string/trim (if err (string err) ""))]) -(when (os/stat "bin/jolt-chez") - (each src ["(get (frequencies [1 1 2 3 3 3]) 3)" - "(get (frequencies [:a :b :a]) :a)" - "(get (group-by even? [1 2 3 4 5]) true)" - "(count (get (group-by even? (range 10)) false))" - "(into [] (range 5))" - "(count (into #{} [1 2 2 3]))"] - (let [[code out err] (run-jolt-chez src) want (cli-oracle src)] - (ok (string "jolt-chez -e: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err))))) - -# 3r) numeric-edge literals (jolt-q3w8): ##Inf/##-Inf/##NaN emitted to bare -# inf/nan (unbound on Chez) — fix emit-const to +inf.0/-inf.0/+nan.0, the -# -e printer to inf/-inf/nan, and str to Infinity/-Infinity/NaN (Clojure). -# Value/print cases are pure literals -> subset path (d/run-on-chez). -(each src ["(< 5 ##Inf)" "(> 5 ##-Inf)" "(= ##Inf ##Inf)" - "##Inf" "##-Inf" "##NaN" "[##Inf]" "[##NaN ##-Inf]"] - (let [[code out err] (d/run-on-chez ctx src) want (cli-oracle src)] - (ok (string "numedge: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) -# str of inf/nan needs the prelude (str is a converter shim). -(each src ["(str ##Inf)" "(str ##-Inf)" "(str ##NaN)"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "numedge: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) -# variadic assoc! (jolt-q3w8): (assoc! t k v & kvs). -(each src ["(count (persistent! (assoc! (transient {}) :a 1 :b 2 :c 3)))" - "(get (persistent! (assoc! (transient {}) :a 1 :b 2)) :b)"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "numedge: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3s) seq-native shims + reduced (jolt-y6mv): the dominant prelude-parity crash -# bucket was 'apply jolt-nil' — core fns calling seed-native seq fns with no Chez -# shim. host/chez/natives-seq.ss shims the safe, high-value ones (mapcat/ -# take-while/drop-while/partition collection arities, sort) over the seq layer, -# plus reduced/reduced? (reduce short-circuits on a reduced; deref unwraps it) -# and identical?. They lower to var-deref in prelude mode. Asserted as -# (= expected (expr)) -> "true" so seq-vs-vector equality (not print form) is the -# contract, exactly like the corpus gate. -(each src [# reduced - "(reduced? (reduced 1))" "(reduced? 1)" "(deref (reduced 9))" - "(reduce (fn [a x] (if (> a 2) (reduced a) (+ a x))) 0 [1 2 3 4 5])" - "(= [1 1 2 2] (mapcat (fn [x] [x x]) [1 2]))" - "(= [1 3 2 4] (mapcat vector [1 2] [3 4]))" - "(= [1 2 3] (mapcat identity [[1 2] [3]]))" - "(= () (mapcat vector [] [1 2]))" - "(= [1 2] (take-while (fn [x] (< x 3)) [1 2 3 1]))" - "(= [3 1] (drop-while (fn [x] (< x 3)) [1 2 3 1]))" - "(= () (take-while pos? []))" - "(= [[1 2] [3 4]] (partition 2 [1 2 3 4 5]))" - "(= [[1 2] [4 5]] (partition 2 3 [1 2 3 4 5 6]))" - "(= [[1 2] [3 :p]] (partition 2 2 [:p] [1 2 3]))" - "(= [1 2 3] (sort [3 1 2]))" - "(= [3 2 1] (sort > [1 3 2]))" - "(= [nil 1 3] (sort compare [3 nil 1]))" - "(= () (sort []))" - "(identical? :a :a)" "(identical? :a :b)"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "seq-native: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) -# reduce-kv honors reduced is an OVERLAY fn over the native reduce — exercise it -# end-to-end through the assembled -e binary. -(when (os/stat "bin/jolt-chez") - (each src ["(= [:a] (reduce-kv (fn [a i v] (if (= i 1) (reduced a) (conj a v))) [] [:a :b :c]))" - "(= 9 (unreduced (reduced 9)))" "(= 9 (unreduced 9))"] - (let [[code out err] (run-jolt-chez src) want (cli-oracle src)] - (ok (string "seq-native -e: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err))))) - -# 3t) transducer arities (jolt-kxsr): the 1-arg map/filter/take/drop/remove/ -# take-while/drop-while/mapcat return a transducer (fn [rf] rf'), and into gets a -# 3-arg (into to xform from). These lowered to the bare native procedure at the -# wrong arity (the 'cdr () not a pair' / 'incorrect number of arguments' bucket), -# so the fix is RT-side: case-lambda the seq fns + jolt-into. (map inc)/into are -# native, so into+single-xform runs in run-prelude; transduce/comp are overlay, -# so those go through the -e binary. -(each src ["(= [2 3 4] (into [] (map inc) [1 2 3]))" - "(= #{2 3 4} (into #{} (map inc) [1 2 3]))" - "(= [2 4] (into [] (filter even?) [1 2 3 4 5]))" - "(= [1 3 5] (into [] (remove even?) [1 2 3 4 5]))" - "(= [1 2] (into [] (take 2) [1 2 3 4]))" - "(= [3 4] (into [] (drop 2) [1 2 3 4]))" - "(= [1 2] (into [] (take-while (fn [x] (< x 3))) [1 2 3 1]))" - "(= [3 1] (into [] (drop-while (fn [x] (< x 3))) [1 2 3 1]))" - "(= [1 1 2 2] (into [] (mapcat (fn [x] [x x])) [1 2]))"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "transducer: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) -(when (os/stat "bin/jolt-chez") - (each src ["(= 6 (transduce (map inc) + [0 1 2]))" - "(= 5 (transduce (map inc) + [1 2]))" - "(= 6 (transduce (map inc) (completing +) 0 [0 1 2]))" - "(= [4 6] (into [] (comp (map inc) (filter even?)) [2 3 4 5]))" - "(= 3 (reduce (fn [a x] (if (> a 2) (reduced a) (+ a x))) 0 (range 100)))" - "(into #{} (map inc) [1 2 3])"] - (let [[code out err] (run-jolt-chez src) want (cli-oracle src)] - (ok (string "transducer -e: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err))))) - -# 3u) misc seq/regex gaps (jolt-y1zq): 0-arg (conj) -> []; 0-arg (conj!) -> a -# fresh transient vector; nth sees through a transient; and irregex \p{...} / -# \P{...} unicode property classes translate to the seed's ASCII char classes -# (regex.ss). Deferred: the assoc!-odd-args seed quirk (non-Clojure, trailing key -# gets nil) and clojure.math/PI (missing ns). \p/conj!/nth run in run-prelude; -# halt-when (overlay, exercises conj 0-arg as the transduce init) via the binary. -(each src ["(= [] (conj))" "(= [1] (conj nil 1))" - "(= [] (persistent! (conj!)))" - "(= 2 (nth (transient [1 2 3]) 1))" - "(re-matches #\"^\\p{L}+$\" \"hello\")" - "(boolean (re-matches #\"^\\p{L}+$\" \"ab1\"))" - "(re-seq #\"\\p{N}+\" \"a12b345\")" - "(re-matches #\"^\\P{N}+$\" \"abc\")" - "(re-matches #\"^\\p{Ll}\\p{Lu}$\" \"aB\")" - "(re-matches #\"^\\p{Ps}x\\p{Pe}$\" \"(x)\")" - # \p{} INSIDE a [...] class emits the class content, not a nested [...] - "(= \" \" (re-matches #\"(?u)^[\\s\\p{Z}]+$\" \" \"))"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "y1zq: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) -(when (os/stat "bin/jolt-chez") - (each src ["(= 7 (transduce (halt-when (fn [x] (> x 5))) conj [1 2 7 3]))" - "(= [1 2 3] (transduce (halt-when (fn [x] (> x 5))) conj [1 2 3]))"] - (let [[code out err] (run-jolt-chez src) want (cli-oracle src)] - (ok (string "y1zq -e: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err))))) - -# 3v) multimethod dispatch (jolt-9ls5): defmulti/defmethod expand to -# defmulti-setup/defmethod-setup (+ get-method/methods/remove-method/ -# prefer-method/prefers); host/chez/multimethods.ss provides the runtime. A -# jolt-multifn record carries its dispatch fn + method table; jolt-invoke -# dispatches it (direct match, then isa?/hierarchy + prefers, then :default). -# Dispatch uses the overlay isa?/derive/make-hierarchy, so these need the full -# prelude -> the -e binary. (Class-based dispatch — (class x)/String — is -# deferred; it needs the deftype/class subsystem.) -(when (os/stat "bin/jolt-chez") - (each src ["(= \"two\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f 2 [_] \"two\") (f 2)))" - "(= \"circle\" (do (defmulti area :shape) (defmethod area :circle [_] \"circle\") (area {:shape :circle})))" - "(= \"other\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f :default [_] \"other\") (f 99)))" - "(= 5 (do (defmulti g (fn [a b] a)) (defmethod g :add [_ b] b) (g :add 5)))" - "(= :is-shape (do (derive :hsq :hshape) (defmulti hmm identity) (defmethod hmm :hshape [_] :is-shape) (hmm :hsq)))" - "(= :parent (do (def hh (atom (derive (make-hierarchy) :c :p))) (defmulti cmm identity :hierarchy hh) (defmethod cmm :p [_] :parent) (cmm :c)))" - "(= :exact (do (derive :de1 :de2) (defmulti emm identity) (defmethod emm :de2 [_] :parent) (defmethod emm :de1 [_] :exact) (emm :de1)))" - "(= \"one\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") ((get-method f 1) 1)))" - "(= \"one\" (do (defmulti f identity) (defmethod f 1 [_] \"one\") ((get (methods f) 1) 1)))" - "(= 2 (do (defmulti f identity) (defmethod f 1 [_] \"one\") (defmethod f 2 [_] \"two\") (count (methods f))))"] - (let [[code out err] (run-jolt-chez src) want (cli-oracle src)] - (ok (string "multimethod: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - # no-match throws (exits non-zero), like the corpus :throws row. - (let [[code out err] (run-jolt-chez "(do (defmulti f identity) (defmethod f 1 [_] \"one\") (f 99))")] - (ok "multimethod: no match throws" (not= code 0) (string "code=" code)))) - -# 3w) dynamic-var constants (jolt-9ls5): *clojure-version* (a map) and -# *unchecked-math* (false) are seed natives, def-var!'d by host/chez/dynamic-vars.ss. -# (*ns* needs a namespace value with get-see-through and map?=false — deferred.) -# (map? *clojure-version*) is intentionally NOT asserted: the seed stores it as a -# mutable table, so its map? is false (a seed quirk); Chez models it as a real map -# (map? true). Not a corpus contract, so the divergence is moot. -(each src ["(== 1 (:major *clojure-version*))" "(== 11 (:minor *clojure-version*))" - "(= false *unchecked-math*)"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "dynvar: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - -# 3x) non-ASCII / control-char string literals (jolt-x0os): Janet's %j renders -# a non-ASCII char as raw UTF-8 bytes (\xC3\xA9) and a control char as \xHH -# with NO terminating semicolon — both forms Chez's reader rejects ("invalid -# character \ in string hex escape"). emit-const must emit a Chez string with -# codepoint escapes (\x;) so a literal that just passes through (str/=) -# round-trips. (count/subs/nth over a multibyte string index by BYTES in the -# seed but by codepoints on Chez — a separate semantic gap, not tested here.) -(each src ["(str \"h\xC3\xA9llo\")" - "\"h\xC3\xA9llo\"" - "(str \"na\xC3\xAFve caf\xC3\xA9\")" - "(str \"\xE6\x97\xA5\xE6\x9C\xAC\xE8\xAA\x9E\")" - "(str \"\xCE\xB1\xCE\xB2\xCE\xB3 \xCE\xB4\xCE\xB5\xCE\xB6\")" - "(= \"h\xC3\xA9llo\" (str \"h\xC3\xA9llo\"))" - "(str \"a\x01b\")" - "(str \"tab\tend\")"] - (let [[code out err] (run-prelude src) want (cli-oracle src)] - (ok (string "non-ascii str: " src) (and (= code 0) (= out want)) - (string "chez=" out " janet=" want " | " err)))) - - -# 4) perf signal: emitted fib(30) in-Scheme timing (excludes Chez startup), to -# track against the spike ceiling (hand-Scheme fixnum fib ~5ms). Informational -# — the truthy? wrapper is now elided (jolt-nkcb); the residual gap is jolt's -# all-flonum number model vs the spike's fixnum fib (typed fl*/fx* = Phase 4). -# The full timed bench (fib + mandelbrot vs ceilings) is bench-pipeline.janet. -(let [fib-ir (backend/analyze-form ctx (in (r/parse-next "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))") 0)) - fib-scm (emit/emit fib-ir) - timed (string "(import (chezscheme))\n(load \"host/chez/rt.ss\")\n" - fib-scm "\n" - "(define fib (var-deref \"user\" \"fib\"))\n" - "(define (now-ns) (let ((t (current-time 'time-monotonic))) (+ (* (time-second t) 1000000000) (time-nanosecond t))))\n" - "(fib 24)(fib 24)\n" - "(let* ((t0 (now-ns)) (r (fib 30)) (ms (/ (- (now-ns) t0) 1000000.0)))\n" - " (printf \"~a ~a\\n\" (jolt-pr-str r) (exact->inexact ms)))")] - (spit "/tmp/chez-jolt-fib-timed.ss" timed) - (def proc (os/spawn ["chez" "--script" "/tmp/chez-jolt-fib-timed.ss"] :p {:out :pipe :err :pipe})) - (def out (string/trim (string (ev/read (proc :out) 0x100000)))) - (def err (string/trim (string (or (ev/read (proc :err) 0x100000) "")))) - (def code (os/proc-wait proc)) - (def parts (string/split " " out)) - (def result (get parts 0)) - (def ms (scan-number (or (get parts 1) "999"))) - (ok "timed fib(30) correct" (and (= code 0) (= result "832040")) (string out " | " err)) - (printf " emitted fib(30): %s in %.2f ms (hand-Scheme spike ~5ms)" result ms)) - -(printf "\nemit-test: %d/%d passed" (- total fails) total) -(os/exit (if (> fails 0) 1 0)) diff --git a/test/chez/reader-parity.janet b/test/chez/reader-parity.janet deleted file mode 100644 index 4be363f..0000000 --- a/test/chez/reader-parity.janet +++ /dev/null @@ -1,154 +0,0 @@ -# Chez Phase 3 inc 5a (jolt-50xx) — value-parity gate for the PORTABLE Clojure -# reader (jolt.reader) vs the Janet seed reader (src/jolt/reader.janet, oracle). -# -# jolt.reader holds the lexing/parsing LOGIC in portable Clojure and delegates -# form construction + number parsing to the jolt.host contract. Here it runs -# interpreted ON THE JANET HOST (loaded via bootstrap-load-source); each input is -# read by BOTH readers and the resulting FORMS compared with jolt's own = (so the -# representation, host-built either way, matches structurally). Positions differ -# (char vs byte indices) and are not compared. -# -# janet test/chez/reader-parity.janet (from repo root) -(import ../../src/jolt/api :as api) -(import ../../src/jolt/backend :as backend) -(import ../../src/jolt/reader :as r) -(import ../../src/jolt/types_ctx :as tctx) -(import ../../src/jolt/types_ns :as tns) -(import ../../src/jolt/types_var :as tvar) -(import ../../src/jolt/core :as core) - -(var total 0) (var fails 0) -(defn ok [name pred &opt extra] - (++ total) - (if pred (printf "ok: %s" name) - (do (++ fails) (printf "FAIL: %s %s" name (or extra ""))))) - -(def ctx (api/init {:compile? true})) -(def src (get (get (ctx :env) :embedded-sources) "jolt.reader")) -(assert src "jolt.reader not embedded (check stdlib_embed collect)") -(backend/bootstrap-load-source ctx "jolt.reader" src) -(def read-one (tvar/var-get (tns/ns-find (tctx/ctx-find-ns ctx "jolt.reader") "read-one"))) -(assert read-one "jolt.reader/read-one not found") - -# jolt's own value equality (the host =), the same comparator the corpus gate uses. -(defn jeq [a b] (core/jolt-equal? a b)) - -(defn check [input] - (def w (protect (in (r/parse-next input) 0))) # Janet seed reader (oracle) - (def g (protect (read-one input))) # portable Clojure reader - (cond - # both readers throw on the same input = faithful parity (safety net for - # genuinely-invalid input). We FIX latent bugs rather than reproduce them - # (fix-bugs-dont-reproduce), so this should be rare. - (and (not (w 0)) (not (g 0))) (ok input true) - (not (w 0)) (ok input false (string "janet threw, clj didn't: clj=" (string/format "%p" (g 1)))) - (not (g 0)) (ok input false (string "clj threw, janet ok: " (string (g 1)))) - (ok input (jeq (w 1) (g 1)) - (string "clj=" (string/format "%p" (g 1)) " janet=" (string/format "%p" (w 1)))))) - -# For inputs where the Janet seed reader is a BUGGY oracle (a latent bug we FIX in -# the port rather than reproduce, fix-bugs-dont-reproduce), assert the portable -# reader against the hand-verified correct value. The Janet seed isn't fixed — -# it's deleted in Phase 5 — so we don't compare against it here. -(defn check-correct [input expected] - (def g (protect (read-one input))) - (if (not (g 0)) - (ok input false (string "clj threw: " (string (g 1)))) - (ok input (jeq expected (g 1)) - (string "clj=" (string/format "%p" (g 1)) " want=" (string/format "%p" expected))))) - -# --- inc 5a: atoms ------------------------------------------------------------- -# nil / bool -(each i ["nil" "true" "false"] (check i)) -# symbols (plain, ns'd, punctuation, special chars) -(each i ["foo" "foo-bar" "my.ns/bar" "+" "-" "*" "->" "<=" "some?" "a1" "x'" "ns/+"] (check i)) -# keywords -(each i [":a" ":foo-bar" ":my.ns/key" "::auto" ":a1" ":+"] (check i)) -# strings (escapes) -(each i [`"hello"` `"with space"` `"tab\there"` `"nl\nhere"` `"q\"q"` `"back\\slash"` `""`] (check i)) -# integers / signs / hex / radix -(each i ["0" "42" "-7" "123456" "0xFF" "0x10" "-0xff" "2r1010" "16rFF" "36rZ" "8r17"] (check i)) -# floats / exponent / ratio / N|M suffix -(each i ["3.14" "-2.5" "0.0" "1e10" "1.5e-3" "2E5" "10N" "3.14M" "1/2" "-3/4" "22/7"] (check i)) -# leading + reads as the positive number (jolt-if19 fixed in the port; the Janet -# seed reader still errors on these, so assert against the correct value). -(check-correct "+5" 5) -(check-correct "+42" 42) -(check-correct "+0xff" 255) -(check-correct "+3.5" 3.5) -# characters -(each i [`\a` `\Z` `\0` `\newline` `\tab` `\space` `\return` `\\` `\(` `\{` `\%` `A` `\o101`] (check i)) - -# For #() forms the two readers gensym DIFFERENT param names, so compare modulo -# gensyms: canonicalize each "#"-suffixed symbol to G__. -(defn- gsym? [nm] (and (> (length nm) 0) (= (in nm (- (length nm) 1)) (chr "#")))) -(defn normalize [form mp] - (cond - (and (struct? form) (= :symbol (form :jolt/type)) (gsym? (form :name))) - (do (when (nil? (get mp (form :name))) (put mp (form :name) (string "G__" (length mp)))) - {:jolt/type :symbol :ns nil :name (get mp (form :name))}) - (and (struct? form) (= :symbol (form :jolt/type))) form - (array? form) (map |(normalize $ mp) form) - (tuple? form) (tuple/slice (tuple ;(map |(normalize $ mp) form))) - (and (struct? form) (= :jolt/set (form :jolt/type))) - {:jolt/type :jolt/set :value (tuple/slice (tuple ;(map |(normalize $ mp) (form :value))))} - (struct? form) (let [order (r/form-kv-order form)] - (if order (r/reader-map (array ;(map |(normalize $ mp) order))) form)) - form)) -(defn check-anon [input] - (def w (in (r/parse-next input) 0)) - (def g (protect (read-one input))) - (if (not (g 0)) - (ok input false (string "clj threw: " (string (g 1)))) - (ok input (core/jolt-equal? (normalize w @{}) (normalize (g 1) @{})) - (string "clj=" (string/format "%p" (normalize (g 1) @{})) " janet=" (string/format "%p" (normalize w @{})))))) - -# --- inc 5b: collections + quote/deref/meta ----------------------------------- -# lists -(each i ["(1 2 3)" "(a b c)" "()" "(foo (bar baz) qux)" "(+ 1 (* 2 3))"] (check i)) -(check "(1 ; c\n 2 3)") # comment inside a list -# vectors -(each i ["[1 2 3]" "[]" "[a [b c]]" "[1 [2 [3]]]" "[:a :b :c]"] (check i)) -# maps -(each i ["{:a 1 :b 2}" "{}" "{:a {:b 1}}" "{:x [1 2] :y {:z 3}}" "{1 2 3 4}"] (check i)) -(check "{:a 1 ; c\n :b 2}") # comment inside a map (key/value slots) -# mixed / nested forms (real code shapes) -(each i ["(defn f [x] (+ x 1))" "{:list (1 2) :vec [3 4]}" "(let [a 1 b 2] (+ a b))"] (check i)) -# quote / syntax-quote / unquote / deref -(each i ["'foo" "'(1 2 3)" "''x" "'[a b]" "'{:a 1}"] (check i)) -(each i ["`foo" "`(a b c)" "`[x y]"] (check i)) -(check "`\"meow\"") # syntax-quote of a literal collapses -(each i ["~x" "~@xs" "@x" "@(atom 1)"] (check i)) -(check "`(a ~b ~@c)") -# metadata -(each i ["^:dynamic x" "^String s" "^:private foo" "^{:a 1} v" "^t/Ray r"] (check i)) -(check "(defn ^:private g [x] x)") - -# --- inc 5c: dispatch (#) ------------------------------------------------------ -# sets -(each i ["#{1 2 3}" "#{}" "#{:a :b}" "#{[1 2] {:k 1}}"] (check i)) -# var-quote -(each i ["#'foo" "#'my.ns/bar"] (check i)) -# regex (tagged :regex form — compared by source string) -(each i [`#"[0-9]+"` `#"\d+"` `#"a.c"` `#"(?i)foo"`] (check i)) -# tagged literals (#inst / #uuid / arbitrary #tag) -(each i [`#inst "2020-01-01"` `#uuid "00000000-0000-0000-0000-000000000000"` - `#foo bar` `#foo [1 2]` `#my.ns/Tag {:a 1}`] (check i)) -# #_ discard (in collections + top-level + map slots) -(each i ["[1 #_2 3]" "(a #_b c)" "#_ x y" "{:a #_1 2 :b 3}" "[#_#_1 2 3]"] (check i)) -# #? reader-conditional (jolt + default active; cljs inactive) -(each i ["#?(:jolt 1 :clj 2)" "#?(:clj 1 :default 2)" "[#?(:cljs 1) 2]" - "#?(:jolt :yes :default :no)"] (check i)) -# #?@ splice -(each i ["[#?@(:jolt [1 2]) 3]" "[#?@(:cljs [9]) 4]" "(0 #?@(:default [1 2 3]) 4)"] (check i)) -# ## symbolic (Inf/-Inf comparable; NaN checked by property) -(each i ["##Inf" "##-Inf"] (check i)) -(let [g (read-one "##NaN")] (ok "##NaN" (not= g g) (string "got " (string/format "%p" g)))) -# #^ deprecated metadata reader macro (= ^) -(each i ["#^String x" "#^:dynamic y"] (check i)) -# #() anonymous fns (gensym-normalized) -(each i ["#(+ %1 %2)" "#(* % %)" "#(do %2 %&)" "#(foo)" "#(vector %1 %2 %3)" - "#(%)" "#(apply + %&)" "#(get {:a %} :a)" "#(conj #{%1} %2)" "#(inc %)"] (check-anon i)) - -(printf "\n%d/%d ok" (- total fails) total) -(when (> fails 0) (os/exit 1))