simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Move the Chez test oracle off Janet

Browse source 
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
This commit is contained in:
Yogthos 2026-06-21 09:48:49 -04:00
parent 8d4f83e0f7
commit 9a273e71cd
21 changed files with 205 additions and 1510 deletions
Download patch file Download diff file Expand all files Collapse all files

68
test/chez/_dotform.janet
View file

@ -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)))