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

Delete the Janet host — Chez is the sole substrate

Browse source 
Remove the Janet seed (src/jolt/*.janet: reader, value layer, vars/ns, the
tree-walking interpreter, the Janet backend, the optimizing compiler), the
Janet->Scheme cross-compiler (host/chez/{driver,emit,jolt-chez}.janet),
bin/jolt-chez, the jpm build (project.janet) and the Janet test runner
(run-tests.janet), plus the entire Janet test suite. jolt now builds and runs
on Chez alone: bin/joltc off the checked-in seed, bootstrap.ss to rebuild it.

The portable Clojure stays: jolt-core/**, host/chez/**.ss, and the stdlib +
tooling under src/jolt/clojure + src/jolt/jolt (read by the seed build, no
Janet). The gate is 'make test' (self-host, corpus, unit, cli smoke, certify).
Drop the sci and clojure-test-suite submodules (used only by deleted Janet
integration tests); irregex stays.

Filesystem corpus/unit cases that probed project.janet now probe README.md.

jolt-cf1q.6
This commit is contained in:
Yogthos 2026-06-21 11:29:03 -04:00
parent 5c1fdfc336
commit 58d03d67be
221 changed files with 16 additions and 29925 deletions
Download patch file Download diff file Expand all files Collapse all files

50
test/bench/core-bench.janet
View file

@ -1,50 +0,0 @@
# Performance baseline for the clojure.core migration (jolt-1j0).
#
# Times representative core operations end-to-end (compile path) so a phase that
# moves fns from native Janet to the self-hosted Clojure overlay can be checked
# for regressions. Same programs before/after a phase -> relative delta is the
# migration's perf impact. Run: JOLT_BENCH=1 janet test/bench/core-bench.janet
# (skipped under `jpm test` — it asserts nothing; see main).
#
# Each program carries its own internal iteration so the measured work dominates
# parse/compile overhead. Reports the min of N runs (least noisy).
(import ../../src/jolt/api :as api)
(def runs 5)
(def benches
[[:fib "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 28)"]
[:seq-pipe "(loop [i 0 a 0] (if (< i 300) (recur (inc i) (+ a (reduce + 0 (map inc (filter even? (range 200)))))) a))"]
[:reduce "(loop [i 0 a 0] (if (< i 2000) (recur (inc i) (+ a (reduce + 0 (range 500)))) a))"]
[:into-vec "(loop [i 0 a 0] (if (< i 1000) (recur (inc i) (+ a (count (into [] (map inc (range 100)))))) a))"]
[:map-build "(loop [i 0 a 0] (if (< i 2000) (recur (inc i) (+ a (count (reduce (fn [m k] (assoc m k k)) {} (range 50))))) a))"]
[:map-read "(let [m (zipmap (range 100) (range 100))] (loop [i 0 a 0] (if (< i 5000) (recur (inc i) (+ a (get m (mod i 100) 0))) a)))"]
[:str-join "(loop [i 0 a 0] (if (< i 1000) (recur (inc i) (+ a (count (apply str (map str (range 100)))))) a))"]
[:hof "(loop [i 0 a 0] (if (< i 2000) (recur (inc i) (+ a (reduce + 0 (map (comp inc inc) (range 200))))) a))"]])
(defn time-bench [ctx src]
(var best math/inf)
(for _ 0 runs
(def t0 (os/clock))
(api/load-string ctx src)
(def dt (* 1000 (- (os/clock) t0)))
(when (< dt best) (set best dt)))
best)
(defn main [&]
# `jpm test` recurses test/ and would run this every gate, but it's a manual
# perf tool that asserts nothing (just reports timings) — so skip it unless
# opted in with JOLT_BENCH=1. Keeps ~35s of unasserted benchmark work out of
# the correctness gate (same pattern as suite-worker's no-arg no-op).
(unless (os/getenv "JOLT_BENCH")
(print "core-bench: SKIP (set JOLT_BENCH=1 to run)")
(os/exit 0))
(def ctx (api/init {:compile? true}))
(print "bench (compile mode), min of " runs " runs, ms:")
(var total 0)
(each [name src] benches
(def ms (time-bench ctx src))
(+= total ms)
(printf " %-10s %8.2f ms" name ms))
(printf " %-10s %8.2f ms" "TOTAL" total))

49
test/chez/_atomwatch.janet
View file

@ -1,49 +0,0 @@
# 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).
#
# janet test/chez/_atomwatch.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
# [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)" "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}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(= 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 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)
(printf "%d FAIL(s):" (length fails))
(each [e m] fails (printf " FAIL %s\n %s" e m)))
(flush)
(os/exit (if (empty? fails) 0 1))

59
test/chez/_class.janet
View file

@ -1,59 +0,0 @@
# jolt-13zk — bare class-name tokens + (class x) on Chez. A class name (String,
# 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
# 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/joltc"))
(def cases
[# --- bare class tokens evaluate to canonical strings ---
["String" "java.lang.String"]
["Number" "java.lang.Number"]
["Keyword" "clojure.lang.Keyword"]
["File" "java.io.File"]
["Exception" "java.lang.Exception"]
["MapEntry" "clojure.lang.MapEntry"]
# --- (class x) on scalars matches core-class ---
["(class 1)" "java.lang.Number"]
["(class 1.5)" "java.lang.Number"]
["(class \"s\")" "java.lang.String"]
["(class :k)" "clojure.lang.Keyword"]
["(class true)" "java.lang.Boolean"]
["(class false)" "java.lang.Boolean"]
["(class nil)" ""]
# --- token <-> class equality ---
["(= String (class \"abc\"))" "true"]
["(= Number (class 7))" "true"]
["(= String (class 7))" "false"]
# --- defmulti dispatch on class ---
["(do (defmulti cm (fn [x] (class x))) (defmethod cm String [x] :str) (cm \"a\"))" ":str"]
["(do (defmulti cn (fn [x] (class x))) (defmethod cn nil [x] :nil) (defmethod cn String [x] :str) (cn nil))" ":nil"]
["(do (defmulti cn (fn [x] (class x))) (defmethod cn nil [x] :nil) (defmethod cn String [x] :str) (cn \"z\"))" ":str"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_class 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)))
(flush)
(os/exit (if (empty? fails) 0 1))

68
test/chez/_dotform.janet
View file

@ -1,68 +0,0 @@
# jolt-kuic — the `.` special form + `.-field` field-access desugar on Chez. The
# 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.
# Each case carries its expected printed value.
#
# janet test/chez/_dotform.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# strings: method calls via the String surface
["(. \"HI\" toLowerCase)" "hi"]
["(. \"abc\" length)" "3"]
["(. \"abc\" toUpperCase)" "ABC"]
# vectors / maps: collection interop (count/nth/get/containsKey)
["(. [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)" "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})" "41"]
["(.-x {:x 7 :y 9})" "7"]
# field access via (. obj -field)
["(. {:value 41} -value)" "41"]
# records: .-field reads a field, .method dispatches the protocol method
["(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)))" "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}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(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)))
(flush)
(os/exit (if (empty? fails) 0 1))

75
test/chez/_dynbind.janet
View file

@ -1,75 +0,0 @@
# 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 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/joltc"))
(def cases
[# --- binding: install / restore / seen across a fn call ---
["binding rebinds" "(do (def ^:dynamic *bx* 10) (binding [*bx* 99] *bx*))" "99"]
["binding restores" "(do (def ^:dynamic *by* 10) (binding [*by* 99] *by*) *by*)" "10"]
["binding seen by fn" "(do (def ^:dynamic *bz* 0) (defn rdz [] *bz*) (binding [*bz* 7] (rdz)))" "7"]
["binding both: vec" "(do (def ^:dynamic *bv* 1) [(binding [*bv* 2] *bv*) *bv*])" "[2 1]"]
["nested binding" "(do (def ^:dynamic *bn* 1) (binding [*bn* 2] (binding [*bn* 3] *bn*)))" "3"]
["nested binding outer" "(do (def ^:dynamic *bo* 1) (binding [*bo* 2] (binding [*bo* 3] nil) *bo*))" "2"]
# (a macro reading a dynamic var — corpus 606/607 — needs top-level defmacro
# in the -e path, which the Chez driver can't compile yet; out of scope here.)
# --- var-set inside a binding targets the frame; restored on exit ---
["var-set in binding" "(do (def ^:dynamic *z* 1) (binding [*z* 0] (var-set (var *z*) 5) *z*))" "5"]
["var-set frame restores" "(do (def ^:dynamic *zr* 1) (binding [*zr* 0] (var-set (var *zr*) 5)) *zr*)" "1"]
# --- thread-bound? ---
["thread-bound? unbound" "(do (def ^:dynamic *tb* 1) (thread-bound? (var *tb*)))" "false"]
["thread-bound? in scope" "(do (def ^:dynamic *tc* 1) (binding [*tc* 2] (thread-bound? (var *tc*))))" "true"]
# --- with-bindings* / bound-fn* / get-thread-bindings ---
# 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"]
# --- with-local-vars ---
["local-var get" "(with-local-vars [x 1] (var-get x))" "1"]
["local-var set" "(with-local-vars [x 1] (var-set x 2) (var-get x))" "2"]
["local-var two" "(with-local-vars [a 1 b 2] [(var-get a) (var-get b)])" "[1 2]"]
["local-var as value" "(with-local-vars [x 0] (let [bump (fn [v] (var-set v (+ 5 (var-get v))))] (bump x) (var-get x)))" "5"]
["local-var init outer" "(let [y 3] (with-local-vars [x y] (var-get x)))" "3"]
["local-var body result" "(with-local-vars [x 1] :done)" ":done"]
# --- with-redefs ---
["with-redefs rebinds" "(do (defn wrf [] 1) (with-redefs [wrf (fn [] 42)] (wrf)))" "42"]
["with-redefs restores" "(do (defn wrg [] 1) (with-redefs [wrg (fn [] 42)]) (wrg))" "1"]
["with-redefs on throw" "(do (defn wrh [] 1) (try (with-redefs [wrh (fn [] 42)] (throw (ex-info \"x\" {}))) (catch :default e nil)) (wrh))" "1"]
["with-redefs-fn" "(do (defn wri [] 1) (with-redefs-fn {(var wri) (fn [] 42)} (fn [] (wri))))" "42"]
# --- alter-var-root ---
["alter-var-root" "(do (def av 1) (alter-var-root (var av) inc) av)" "2"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_dynbind parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

74
test/chez/_insttime.janet
View file

@ -1,74 +0,0 @@
# 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.
# 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/joltc"))
(def cases
[# --- #inst reading + identity ---
["(inst? #inst \"2020-01-01T00:00:00Z\")" "true"]
["(inst-ms #inst \"1970-01-01T00:00:01Z\")" "1000"]
["(inst-ms #inst \"1970-01-01T00:00:00.123Z\")" "123"]
["(inst-ms #inst \"2020-01-01T00:00:00Z\")" "1577836800000"]
["(inst-ms* #inst \"1970-01-01T00:00:00Z\")" "0"]
["(some? #inst \"2020-01-01T00:00:00Z\")" "true"]
["(str (type #inst \"2020-01-01T00:00:00Z\"))" ":jolt/inst"]
# --- partial timestamps + offsets (value equality by instant) ---
["(= #inst \"2020\" #inst \"2020-01-01T00:00:00.000Z\")" "true"]
["(= #inst \"2020-03\" #inst \"2020-03-01T00:00:00Z\")" "true"]
["(= #inst \"2020-03-15\" #inst \"2020-03-15T00:00:00Z\")" "true"]
["(= #inst \"2020-01-01T01:00:00+01:00\" #inst \"2020-01-01T00:00:00Z\")" "true"]
["(= #inst \"2019-12-31T23:00:00-01:00\" #inst \"2020-01-01T00:00:00Z\")" "true"]
["(= #inst \"2020-01-01T00:00:00Z\" #inst \"2020-01-01T00:00:01Z\")" "false"]
# --- map key + pr-str round trip ---
["(get {#inst \"2020-01-01T00:00:00Z\" :v} #inst \"2020-01-01T00:00:00.000Z\")" ":v"]
["(pr-str #inst \"2020-01-01T00:00:00Z\")" "#inst \"2020-01-01T00:00:00.000-00:00\""]
["(str #inst \"2020-01-01T00:00:00Z\")" "2020-01-01T00:00:00.000-00:00"]
# --- #uuid ---
["(uuid? #uuid \"550e8400-e29b-41d4-a716-446655440000\")" "true"]
["(= #uuid \"550E8400-E29B-41D4-A716-446655440000\" #uuid \"550e8400-e29b-41d4-a716-446655440000\")" "true"]
["(pr-str #uuid \"550e8400-e29b-41d4-a716-446655440000\")" "#uuid \"550e8400-e29b-41d4-a716-446655440000\""]
# --- java.util.Date / java.time.Instant interop ---
["(.getTime #inst \"1970-01-01T00:00:00Z\")" "0"]
["(instance? java.util.Date #inst \"2020-01-01T00:00:00Z\")" "true"]
["(instance? java.sql.Timestamp #inst \"2020-01-01T00:00:00Z\")" "false"]
["(.toEpochMilli (Instant/ofEpochMilli 1234))" "1234"]
["(instance? java.time.Instant (Instant/ofEpochMilli 0))" "true"]
["(> (.toEpochMilli (Instant/now)) 1500000000000)" "true"]
["(instance? LocalDateTime (-> #inst \"2020-03-05T13:45:30Z\" (.toInstant) (.atZone (ZoneId/systemDefault)) (.toLocalDateTime)))" "true"]
# --- DateTimeFormatter pattern engine ---
["(.format (DateTimeFormatter/ofPattern \"yyyy-MM-dd\") #inst \"2020-03-05T13:45:30Z\")" "2020-03-05"]
["(boolean (re-matches #\"[A-Z][a-z]{2} \\d{1,2}, 2020 \\d{1,2}:\\d{2} [AP]M\" (.format (DateTimeFormatter/ofPattern \"MMM d, yyyy h:mm a\") #inst \"2020-03-05T13:45:30Z\")))" "true"]
["(boolean (re-matches #\"\\d{4}-\\d{2}-\\d{2}T\\d{2}:\\d{2}:\\d{2}\" (.format DateTimeFormatter/ISO_LOCAL_DATE_TIME #inst \"2020-03-05T13:45:30Z\")))" "true"]
["(string? (.format (DateTimeFormatter/ofLocalizedDate FormatStyle/MEDIUM) #inst \"2020-03-05T13:45:30Z\"))" "true"]
["(string? (.format (.withLocale (DateTimeFormatter/ofPattern \"yyyy\") (java.util.Locale. \"en\")) #inst \"2020-01-01T00:00:00Z\"))" "true"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_insttime 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)))
(flush)
(os/exit (if (empty? fails) 0 1))

61
test/chez/_io.janet
View file

@ -1,61 +0,0 @@
# 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). 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/joltc"))
(defn io [body] (string "(do (require (quote [clojure.java.io :as io])) " body ")"))
(def cases
[# --- File construction + method surface ---
[(io "(str (io/file \"/a/b\"))") "/a/b"]
[(io "(str (io/file \"/a\" \"b\"))") "/a/b"]
[(io "(.getName (io/file \"/a/b/c.txt\"))") "c.txt"]
[(io "(.getPath (io/file \"/a\" \"b\"))") "/a/b"]
[(io "(.isDirectory (io/file \"docs\"))") "true"]
[(io "(.isFile (io/file \"project.janet\"))") "true"]
[(io "(.isFile (io/file \"docs\"))") "false"]
[(io "(.exists (io/file \"/no/such/path/xyz\"))") "false"]
[(io "(.exists (io/file \"project.janet\"))") "true"]
# --- instance? + type ---
[(io "(instance? java.io.File (io/file \"/a/b\"))") "true"]
[(io "(instance? java.io.File \"/a/b\")") "false"]
[(io "(str (type (io/file \"/a\")))") ":jolt/file"]
# --- file-seq ---
[(io "(every? (fn [f] (instance? java.io.File f)) (file-seq (io/file \"docs\")))") "true"]
[(io "(pos? (count (filter (fn [f] (.isFile f)) (file-seq (io/file \"docs\")))))") "true"]
["(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"project.janet\")) (file-seq \".\"))))" "true"]
# --- slurp / spit / flush ---
["(string? (slurp \"project.janet\"))" "true"]
["(do (spit \"/tmp/jolt-io-test.txt\" \"hello\") (slurp \"/tmp/jolt-io-test.txt\"))" "hello"]
["(do (spit \"/tmp/jolt-io-test.txt\" \"a\") (spit \"/tmp/jolt-io-test.txt\" \"b\" :append true) (slurp \"/tmp/jolt-io-test.txt\"))" "ab"]
["(flush)" ""]
[(io "(string? (slurp (io/file \"project.janet\")))") "true"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_io 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)))
(flush)
(os/exit (if (empty? fails) 0 1))

61
test/chez/_ioreader.janet
View file

@ -1,61 +0,0 @@
# jolt-at0a (inc W) — reader-coupled io deferred from inc V (jolt-yyud):
# clojure.java.io/reader (a StringReader over slurp/string/char[]/File/path),
# char-array, File.toURL/.toURI (-> a java.net.URL jhost), slurp draining a
# 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.
#
#
# janet test/chez/_ioreader.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(defn io [body] (string "(do (require (quote [clojure.java.io :as io])) " body ")"))
(def cases
[# --- char-array ---
["(str (char-array \"abc\"))" "(\\a \\b \\c)"]
["(.read (StringReader. (apply str (char-array \"Qz\"))))" "81"]
# --- io/reader: char[] / string-reader passthrough / path ---
[(io "(.read (io/reader (char-array \"abc\")))") "97"]
[(io "(.read (io/reader (StringReader. \"k\")))") "107"]
[(io "(slurp (io/reader (char-array \"xyz\")))") "xyz"]
[(io "(string? (slurp (io/reader \"project.janet\")))") "true"]
# --- File.toURL / .toURI ---
[(io "(.toString (.toURL (io/file \"/tmp/x\")))") "file:/tmp/x"]
[(io "(.toURI (io/file \"/tmp/x\"))") "file:/tmp/x"]
[(io "(.getPath (.toURL (io/file \"/tmp/x\")))") "/tmp/x"]
[(io "(.getAbsolutePath (io/file \"/a/b\"))") "/a/b"]
# --- slurp drains a StringReader (+ ignores :encoding opts) ---
["(slurp (StringReader. \"a=1\"))" "a=1"]
["(slurp (StringReader. \"b\") :encoding \"UTF-8\")" "b"]
# --- with-open: jhost reader + plain :close map ---
["(with-open [r (StringReader. \"a\")] (.read r))" "97"]
["(let [log (atom [])] (with-open [c {:close (fn [] (swap! log conj :closed))}] :r) (deref log))" "[:closed]"]
["(let [log (atom [])] (try (with-open [c {:close (fn [] (swap! log conj :closed))}] (throw (ex-info \"boom\" {}))) (catch Exception e nil)) (deref log))" "[:closed]"]
["(let [log (atom [])] (with-open [a {:close (fn [] (swap! log conj :outer))} b {:close (fn [] (swap! log conj :inner))}] :r) (deref log))" "[:inner :outer]"]
["(with-open [c {:close (fn [] nil) :v 5}] (:v c))" "5"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_ioreader 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)))
(flush)
(os/exit (if (empty? fails) 0 1))

89
test/chez/_javastatic.janet
View file

@ -1,89 +0,0 @@
# 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).
# 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/joltc"))
(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\"))" "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\")" "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\"))" "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}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(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)))
(flush)
(os/exit (if (empty? fails) 0 1))

54
test/chez/_ns.janet
View file

@ -1,54 +0,0 @@
# jolt-yxqm — namespace value model (find-ns/ns-name/all-ns/resolve/ns-publics/
# 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, baked per case.
#
# janet test/chez/_ns.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
# [label expr expected-last-line]
(def cases
[["find-ns existing" "(some? (find-ns 'clojure.core))" "true"]
["find-ns missing" "(nil? (find-ns 'does.not.exist))" "true"]
["resolve native-op +" "(var? (resolve '+))" "true"]
["resolve undefined" "(nil? (resolve 'totally-undefined-xyz))" "true"]
["ns-publics has def" "(do (def npv 1) (some? (get (ns-publics 'user) 'npv)))" "true"]
["ns-map has def" "(do (def nmv 1) (some? (get (ns-map 'user) 'nmv)))" "true"]
["ns-aliases is a map" "(map? (ns-aliases 'clojure.core))" "true"]
["ns-interns is a map" "(map? (ns-interns 'user))" "true"]
["ns-interns count pos" "(do (def q 1) (pos? (count (ns-interns 'user))))" "true"]
["all-ns count pos" "(pos? (count (all-ns)))" "true"]
["ns-name *ns* = user" "(= (ns-name *ns*) (ns-name (find-ns 'user)))" "true"]
["in-ns returns ns str" "(str (in-ns 'jolt.test-ns-b))" "jolt.test-ns-b"]
["in-ns updates *ns*" "(do (in-ns 'jolt.test-ns-a) (str *ns*))" "jolt.test-ns-a"]
["ns-unmap clears var" "(do (def nuv 1) (ns-unmap 'user 'nuv) (nil? (resolve 'nuv)))" "true"]
["in-ns no error" "(do (in-ns 'my.ns) (symbol? 'x))" "true"]
["str ns-name *ns*" "(str (ns-name *ns*))" "user"]
["find-var qualified" "(var? (find-var 'clojure.core/map))" "true"]
["the-ns ns-name" "(= 'user (ns-name (the-ns 'user)))" "true"]
["create-ns ns-name" "(= 'foo.bar (ns-name (create-ns 'foo.bar)))" "true"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_ns parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

95
test/chez/_reader.janet
View file

@ -1,95 +0,0 @@
# 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 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 is host-dependent — doesn't masquerade as a
# divergence.
#
# janet test/chez/_reader.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- scalars + collections (value equality, order-independent) ---
["(= 42 (read-string \"42\"))" "true"]
["(= 42 (read-string \"0x2A\"))" "true"]
# numeric tower (jolt-n6al): "1/2" reads as an exact Ratio (= JVM), so a
# category-aware = against the double 0.5 is false; assert numeric value (==),
# which holds in both the all-flonum and tower models.
["(== 0.5 (read-string \"1/2\"))" "true"]
["(= -3.5 (read-string \"-3.5\"))" "true"]
["(== 1000.0 (read-string \"1e3\"))" "true"]
["(= 1 (read-string \"1N\"))" "true"]
["(integer? (read-string \"7\"))" "true"]
["(= :foo (read-string \":foo\"))" "true"]
["(= :a/b (read-string \":a/b\"))" "true"]
["(= :foo (read-string \"::foo\"))" "true"]
["(= (quote sym) (read-string \"sym\"))" "true"]
["(= (quote ns/sym) (read-string \"ns/sym\"))" "true"]
["(nil? (read-string \"nil\"))" "true"]
["(true? (read-string \"true\"))" "true"]
["(false? (read-string \"false\"))" "true"]
["(= \\a (read-string \"\\\\a\"))" "true"]
["(= \\newline (read-string \"\\\\newline\"))" "true"]
["(= \\space (read-string \"\\\\space\"))" "true"]
["(= \"a\\nb\" (read-string \"\\\"a\\\\nb\\\"\"))" "true"]
["(= [1 2 3] (read-string \"[1 2 3]\"))" "true"]
["(= (quote (+ 1 2)) (read-string \"(+ 1 2)\"))" "true"]
["(= {:a 1 :b 2} (read-string \"{:a 1 :b 2}\"))" "true"]
# core read-string returns the raw set FORM (edn->value builds the real set)
["(:value (read-string \"#{1 2 3}\"))" "[1 2 3]"]
["(= :jolt/set (:jolt/type (read-string \"#{1 2 3}\")))" "true"]
["(= [1 [2 3] {:k :v}] (read-string \"[1 [2 3] {:k :v}]\"))" "true"]
# --- reader macros ---
["(= (quote (quote x)) (read-string \"'x\"))" "true"]
["(= (quote (clojure.core/deref a)) (read-string \"@a\"))" "true"]
["(= (quote (syntax-quote (a (unquote b)))) (read-string \"`(a ~b)\"))" "true"]
["(= (quote (unquote-splicing xs)) (read-string \"~@xs\"))" "true"]
# --- whitespace / comments / discard ---
["(= 42 (read-string \"; comment\\n42\"))" "true"]
["(= [1 2] (read-string \"[1 #_ 9 2]\"))" "true"]
["(nil? (read-string \"\"))" "true"]
["(nil? (read-string \" , ,\"))" "true"]
# --- metadata ^ on a symbol ---
["(:tag (meta (read-string \"^String x\")))" "String"]
["(:foo (meta (read-string \"^:foo x\")))" "true"]
# --- *in* reader family: read / read+string / with-in-str ---
["(= 42 (with-in-str \"42\" (read)))" "true"]
["(= (quote (+ 1 2)) (with-in-str \"(+ 1 2)\" (read)))" "true"]
["(with-in-str \"1 2\" [(read) (read)])" "[1 2]"]
["(= :done (with-in-str \"\" (read *in* false :done)))" "true"]
["(let [[v s] (with-in-str \"42 rest\" (read+string))] (and (= v 42) (string? s)))" "true"]
["(= [1 2] (with-in-str \"1 2\" [(first (read+string)) (first (read+string))]))" "true"]
# --- clojure.edn (set/tagged forms built into real values) ---
["(do (require (quote [clojure.edn :as e0])) (= #{1 2} (e0/read-string \"#{1 2}\")))" "true"]
["(do (require (quote [clojure.edn :as e0])) (uuid? (e0/read-string \"#uuid \\\"550e8400-e29b-41d4-a716-446655440000\\\"\")))" "true"]
["(do (require (quote [clojure.edn :as e0])) (inst? (e0/read-string \"#inst \\\"2020-01-01T00:00:00Z\\\"\")))" "true"]
["(do (require (quote [clojure.edn :as e0])) (= :end (e0/read-string {:eof :end} \"\")))" "true"]
["(do (require (quote [clojure.edn :as e0])) (= [:custom 5] (e0/read-string {:readers {(quote custom) (fn [v] [:custom v])}} \"#custom 5\")))" "true"]
["(do (require (quote clojure.edn)) (= {:a 1 :b 2} (clojure.edn/read-string \"{:a 1\\n :b 2}\")))" "true"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_reader 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)))
(flush)
(os/exit (if (empty? fails) 0 1))

65
test/chez/_seqpred.janet
View file

@ -1,65 +0,0 @@
# sequential? / seq? on lazy seqs (jolt-2o7x follow-up). The inc M fix made the
# native seq? var recognize a lazy-seq (re-def-var!, not just set!). sequential?
# 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 JVM-canonical values.
#
# janet test/chez/_seqpred.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- seq? over lazy seqs ---
# (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"]
["seq? lazy-seq" "(seq? (lazy-seq (cons 1 nil)))" "true"]
["seq? take iterate" "(seq? (take 3 (iterate inc 0)))" "true"]
["seq? cons onto lazy" "(seq? (cons 0 (range 3)))" "true"]
["seq? vector false" "(seq? [1 2 3])" "false"]
["seq? map-coll false" "(seq? {:a 1})" "false"]
["seq? nil false" "(seq? nil)" "false"]
# --- sequential? over lazy seqs (overlay, delegates to seq?) ---
["sequential? range" "(sequential? (range 3))" "true"]
["sequential? map" "(sequential? (map inc [1 2 3]))" "true"]
["sequential? filter" "(sequential? (filter odd? [1 2 3]))" "true"]
["sequential? lazy-seq" "(sequential? (lazy-seq (cons 1 nil)))" "true"]
["sequential? infinite" "(sequential? (take 2 (repeat 9)))" "true"]
["sequential? vector" "(sequential? [1 2 3])" "true"]
["sequential? list" "(sequential? '(1 2 3))" "true"]
["sequential? map false" "(sequential? {:a 1})" "false"]
["sequential? set false" "(sequential? #{1 2})" "false"]
["sequential? nil false" "(sequential? nil)" "false"]
# --- native =/hash path (jolt-sequential? via set!) over a raw lazy seq ---
["= vec lazyseq" "(= [0 1 2] (range 3))" "true"]
["= lazyseq vec" "(= (range 3) [0 1 2])" "true"]
["= lazyseq list" "(= (map inc [0 1]) '(1 2))" "true"]
["set contains lazyseq" "(contains? #{[0 1 2]} (vec (range 3)))" "true"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_seqpred parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

77
test/chez/_stdlib.janet
View file

@ -1,77 +0,0 @@
# jolt-j5vg / jolt-22vo / clojure.pprint — Phase-2 stdlib parity closeout.
#
# clojure.set — pure Clojure (src/jolt/clojure/set.clj) added to the Chez
# prelude tier (driver.janet stdlib-ns-files).
# clojure.math — native flonum-math shims (host/chez/math.ss) def-var!'d into
# the clojure.math ns; the analyzer already knows the ns exists
# (api.janet install-clojure-math!), so refs lower to var-deref.
# clojure.pprint — minimal shim on the prelude; pprint's 2-arity no longer uses
# (binding [*out* writer] ...) (uncompilable on the no-fallback
# Chez back end; *out* isn't a bindable var — output always goes
# through the host seam).
#
# Outputs are order-stable (value-equality / scalars) so set/map iteration order
# — which is host-dependent — never masquerades as a divergence.
#
#
# janet test/chez/_stdlib.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(def cases
[# --- clojure.math (jolt-22vo / jolt-h79) ---
["(< 1.4142 (clojure.math/sqrt 2) 1.4143)" "true"]
["(long (clojure.math/pow 2 10))" "1024"]
["(long (clojure.math/tan 0))" "0"]
["(clojure.math/round 2.6)" "3"]
["(clojure.math/floor 2.9)" "2"]
["(clojure.math/signum -7.2)" "-1"]
["(< 3.14 (clojure.math/to-radians 180) 3.15)" "true"]
["(< 3.14 clojure.math/PI 3.15)" "true"]
["(< 2.71 clojure.math/E 2.72)" "true"]
["(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
# 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]"]
["(long (clojure.math/atan2 0 1))" "0"]
# --- clojure.set (jolt-j5vg) ---
["(do (require (quote [clojure.set :as s])) (= #{1 2 3 4} (s/union #{1 2} #{3 4})))" "true"]
["(do (require (quote [clojure.set :as s])) (= #{2} (s/intersection #{1 2} #{2 3})))" "true"]
["(do (require (quote [clojure.set :as s])) (= #{1} (s/difference #{1 2} #{2 3})))" "true"]
["(do (require (quote [clojure.set :as s])) (s/subset? #{1} #{1 2}))" "true"]
["(do (require (quote [clojure.set :as s])) (s/superset? #{1 2} #{1}))" "true"]
["(do (require (quote [clojure.set :as s])) (= {1 :a 2 :b} (s/map-invert {:a 1 :b 2})))" "true"]
["(do (require (quote [clojure.set :as s])) (= #{:a} (s/select keyword? #{:a})))" "true"]
["(do (require (quote [clojure.set :as s])) (= #{{:a 1 :b 2}} (s/join #{{:a 1}} #{{:b 2}})))" "true"]
["(do (require (quote [clojure.set :as s])) (= {:b 1} (s/rename-keys {:a 1} {:a :b})))" "true"]
["(do (require (quote [clojure.set :as s])) (= 2 (count (s/index #{{:k 1} {:k 2}} [:k]))))" "true"]
# --- clojure.pprint (minimal shim) ---
["(do (require (quote [clojure.pprint :as pp])) (= \"[1 2 3]\\n\" (with-out-str (pp/pprint [1 2 3]))))" "true"]
["(do (require (quote [clojure.pprint :as pp])) (pp/with-pprint-dispatch pp/code-dispatch 42))" "42"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_stdlib 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)))
(flush)
(os/exit (if (empty? fails) 0 1))

65
test/chez/_str.janet
View file

@ -1,65 +0,0 @@
# 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. 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/joltc"))
(def cases
[["toLowerCase" "(.toLowerCase \"HI\")" "hi"]
["toUpperCase" "(.toUpperCase \"hi\")" "HI"]
["trim" "(.trim \" x \")" "x"]
["length" "(.length \"abc\")" "3"]
["isEmpty" "[(.isEmpty \"\") (.isEmpty \"a\")]" "[true false]"]
["indexOf hit" "(.indexOf \"abc\" \"b\")" "1"]
["indexOf miss" "(.indexOf \"abc\" \"z\")" "-1"]
["indexOf from" "(.indexOf \"abab\" \"a\" 1)" "2"]
["indexOf int code" "(.indexOf \"a=b\" 61)" "1"]
["lastIndexOf" "(.lastIndexOf \"abab\" \"b\")" "3"]
["substring 1" "(.substring \"abc\" 1)" "bc"]
["substring 1 2" "(.substring \"abc\" 1 2)" "b"]
["startsWith" "(.startsWith \"abc\" \"ab\")" "true"]
["endsWith" "(.endsWith \"abc\" \"bc\")" "true"]
["contains" "(.contains \"abc\" \"b\")" "true"]
["replace literal" "(.replace \"abc\" \"b\" \"x\")" "axc"]
["replace all occ" "(.replace \"aaa\" \"a\" \"b\")" "bbb"]
["charAt" "(.charAt \"abc\" 1)" "\\b"]
["equalsIgnoreCase" "(.equalsIgnoreCase \"AbC\" \"aBc\")" "true"]
["toString" "(.toString \"hi\")" "hi"]
["concat" "(.concat \"ab\" \"cd\")" "abcd"]
["matches whole" "(.matches \"abc\" \"a.c\")" "true"]
["matches partial" "(.matches \"abcd\" \"a.c\")" "false"]
["replaceAll" "(.replaceAll \"a_b_c\" \"_\" \"-\")" "a-b-c"]
["replaceFirst" "(.replaceFirst \"a_b_c\" \"_\" \"-\")" "a-b_c"]
["split regex" "(vec (.split \"a,b,c\" \",\"))" "[a b c]"]
["unsupported" "(.frobnicate \"abc\")" :throws]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(= expected :throws)
(if (not= code 0) (++ pass)
(array/push fails [label (string "want throw, got `" got "` (exit 0)")]))
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_str parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

66
test/chez/_strns.janet
View file

@ -1,66 +0,0 @@
# jolt-nfca (clojure.string half) — the clojure.string namespace on Chez via the
# 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. Each case carries its expected value.
#
# janet test/chez/_strns.janet
(def jolt-bin (or (os/getenv "JOLT_BIN") "bin/joltc"))
(defn- with-req [body] (string "(do (require (quote [clojure.string :as s])) " body ")"))
# [label body-after-require expected]
(def cases
[["upper-case" "(s/upper-case \"abc\")" "ABC"]
["lower-case" "(s/lower-case \"ABC\")" "abc"]
["capitalize" "(s/capitalize \"hello\")" "Hello"]
["trim" "(s/trim \" x \")" "x"]
["triml" "(= \"x \" (s/triml \" x \"))" "true"]
["trimr" "(= \" x\" (s/trimr \" x \"))" "true"]
["blank? empty" "(s/blank? \"\")" "true"]
["blank? ws" "(s/blank? \" \")" "true"]
["blank? no" "(s/blank? \"x\")" "false"]
["blank? nil" "(s/blank? nil)" "true"]
["includes? y" "(s/includes? \"abcd\" \"bc\")" "true"]
["includes? n" "(s/includes? \"abcd\" \"zz\")" "false"]
["starts-with? y" "(s/starts-with? \"abc\" \"ab\")" "true"]
["starts-with? n" "(s/starts-with? \"abc\" \"bc\")" "false"]
["ends-with? y" "(s/ends-with? \"abc\" \"bc\")" "true"]
["join no sep" "(s/join [\"a\" \"b\" \"c\"])" "abc"]
["join sep" "(s/join \",\" [\"a\" \"b\" \"c\"])" "a,b,c"]
["join nums" "(s/join \"-\" [1 2 3])" "1-2-3"]
["split literal" "(s/split \"a,b,c\" \",\")" "[a b c]"]
["split regex" "(s/split \"a1b2c\" #\"[0-9]\")" "[a b c]"]
["split-lines" "(s/split-lines \"a\\nb\\nc\")" "[a b c]"]
["replace lit" "(s/replace \"a_b_c\" \"_\" \"-\")" "a-b-c"]
["replace regex" "(s/replace \"a1b2\" #\"[0-9]\" \"\")" "ab"]
["replace-first" "(s/replace-first \"a_b_c\" \"_\" \"-\")" "a-b_c"]
["reverse" "(s/reverse \"abc\")" "cba"]
["index-of hit" "(s/index-of \"abc\" \"b\")" "1"]
["index-of miss" "(nil? (s/index-of \"abc\" \"z\"))" "true"]
["trim-newline" "(s/trim-newline \"abc\\n\\n\")" "abc"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label body expected] cases
(def [code got err] (run-capture (with-req body)))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_strns parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

81
test/chez/_type.janet
View file

@ -1,81 +0,0 @@
# 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). 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/joltc"))
(def cases
[# --- scalars ---
["int" "(type 5)" ":number"]
["float" "(type 5.0)" ":number"]
["ratio-ish" "(type (/ 10 2))" ":number"]
["string" "(type \"s\")" ":string"]
["keyword" "(type :k)" ":keyword"]
["symbol" "(type 'x)" ":symbol"]
["true" "(type true)" ":boolean"]
["false" "(type false)" ":boolean"]
["nil" "(type nil)" ""]
["char" "(type \\a)" ":char"]
# --- collections ---
["vector" "(type [1 2])" ":vector"]
["empty vector" "(type [])" ":vector"]
["map" "(type {:a 1})" ":map"]
["set" "(type #{1})" ":set"]
["list" "(type '(1 2))" ":seq"]
["empty list" "(type '())" ":seq"]
["map entry" "(type (first {:a 1}))" ":vector"]
["lazy map" "(type (map inc [1 2]))" ":seq"]
["lazy filter" "(type (filter odd? [1 2 3]))" ":seq"]
["lazy-seq" "(type (lazy-seq (cons 1 nil)))" ":seq"]
["take iterate" "(type (take 2 (iterate inc 0)))" ":seq"]
["fn" "(type inc)" ":fn"]
["sorted-map" "(type (sorted-map :a 1))" ":map"]
["sorted-set" "(type (sorted-set 1))" ":jolt/sorted-set"]
# --- :type meta override (the headline jolt-fmm4 case) ---
["meta override" "(type (with-meta [1] {:type :custom}))" ":custom"]
["meta override map" "(type (with-meta {:a 1} {:type :rec}))" ":rec"]
["meta no :type" "(type (with-meta [1] {:other 9}))" ":vector"]
# --- record -> ns-qualified class-name symbol ---
["record symbol" "(do (defrecord TyR [a]) (type (->TyR 1)))" "user.TyR"]
["record roundtrip" "(do (defrecord TyR [a]) (= (symbol (str (type (->TyR 1)))) (type (->TyR 1))))" "true"]
["record is symbol" "(do (defrecord TyR [a]) (symbol? (type (->TyR 1))))" "true"]
# --- exotic host wrappers (seed :jolt/* tags; total, never crash) ---
["atom" "(type (atom 1))" ":jolt/atom"]
["volatile" "(type (volatile! 1))" ":jolt/volatile"]
["regex" "(type #\"re\")" ":jolt/regex"]
["var" "(do (def vx 1) (type (var vx)))" ":jolt/var"]
["transient" "(type (transient []))" ":jolt/transient"]
["uuid" "(type (random-uuid))" ":jolt/uuid"]
["ex-info" "(type (ex-info \"x\" {}))" ":jolt/ex-info"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_type parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

45
test/chez/_var_meta.janet
View file

@ -1,45 +0,0 @@
# 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 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/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) — 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"]
["(def name doc val)" "(do (def dv2 \"hi\" 1) (:doc (meta (var dv2))))" "hi"]
["meta carries :name" "(do (def mv 1) (:name (meta (var mv))))" "mv"]
["meta carries :ns" "(do (def nv 1) (:ns (meta (var nv))))" "user"]
["plain def: no user meta" "(do (def pl 1) (nil? (:private (meta (var pl)))))" "true"]])
(defn run-capture [expr]
(def proc (os/spawn [jolt-bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (if err (string err) "")])
(var pass 0)
(def fails @[])
(each [label expr expected] cases
(def [code got err] (run-capture expr))
(cond
(not= code 0) (array/push fails [label (string "exit " code "; err: " (string/trim err))])
(= got expected) (++ pass)
(array/push fails [label (string "want `" expected "`, got `" got "`")])))
(printf "\n_var_meta parity [%s]: %d/%d passed" jolt-bin pass (length cases))
(when (> (length fails) 0)
(printf "%d FAIL(s):" (length fails))
(each [l m] fails (printf " FAIL [%s] %s" l m)))
(flush)
(os/exit (if (empty? fails) 0 1))

77
test/chez/_walk.janet
View file

@ -1,77 +0,0 @@
# jolt-75sv — list? (a list marker on cseq, since cseq backs both lists and
# realized/lazy seqs) + map-entry-as-vector + clojure.walk.
#
# janet test/chez/_walk.janet
(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 ")"))
(def cases
[# --- list? : true for lists, cons/reverse/conj-on-list; false for seqs ---
["(list? (list 1 2))" "true"]
["(list? (list 1))" "true"]
["(list? '(1 2))" "true"]
["(list? '())" "true"]
["(list? (list))" "true"]
["(list? (cons 1 nil))" "true"]
["(list? (cons 1 [2]))" "true"]
["(list? (cons 1 '(2)))" "true"]
["(list? (conj (list 1) 0))" "true"]
["(list? (conj '() 1))" "true"]
["(list? (reverse [1 2]))" "true"]
["(list? (reverse '(1 2)))" "true"]
["(list? [1 2])" "false"]
["(list? {:a 1})" "false"]
["(list? (map inc [1 2]))" "false"]
["(list? (filter odd? [1 2 3]))" "false"]
["(list? (seq [1 2]))" "false"]
["(list? (rest (list 1 2)))" "false"]
["(list? (next (list 1 2)))" "false"]
["(list? (take 2 (list 1 2 3)))" "false"]
["(list? (concat '(1) '(2)))" "false"]
["(list? (rest [1 2]))" "false"]
["(list? 5)" "false"]
["(list? nil)" "false"]
# --- map-entry IS a vector (Clojure MapEntry; seed agrees) ---
["(vector? (first {:a 1}))" "true"]
["(vector? (first (seq {:a 1})))" "true"]
["(map-entry? (first {:a 1}))" "true"]
["(= (first {:a 1}) [:a 1])" "true"]
["(vector? [1 2])" "true"]
["(vector? (rest [1 2 3]))" "false"]
# --- clojure.walk ---
[(w "(w/postwalk (fn [x] (if (number? x) (inc x) x)) {:a 1})") "{:a 2}"]
[(w "(w/keywordize-keys {\"a\" 1})") "{:a 1}"]
[(w "(= {\"a\" 1} (w/stringify-keys {:a 1}))") "true"]
[(w "(w/postwalk-replace {'x 2} '(+ x x))") "(+ 2 2)"]
[(w "(w/postwalk (fn [n] (if (symbol? n) :a n)) '(x y))") "(:a :a)"]
[(w "(w/prewalk-replace {'* '* 'y 3} '(* y y))") "(* 3 3)"]
[(w "(w/postwalk-replace {:a 1 :b 2} '(:a [:b :a]))") "(1 [2 1])"]
[(w "(w/postwalk-replace {1 :one} [1 2 1])") "[:one 2 :one]"]
["(do (require (quote [clojure.template :as t])) (t/apply-template '[x y] '(+ x y) '(1 2)))" "(+ 1 2)"]])
(defn run-capture [bin expr]
(def proc (os/spawn [bin "-e" expr] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def lines (filter (fn [l] (not (empty? l)))
(string/split "\n" (string/trim (if out (string out) "")))))
[code (if (empty? lines) "" (last lines)) (string/trim (if err (string err) ""))])
(var pass 0)
(def fails @[])
(each [expr expected] cases
(def [code got err] (run-capture jolt-bin expr))
(cond
(not= code 0) (array/push fails [expr (string "exit " code "; err: " err)])
(= got expected) (++ pass)
(array/push fails [expr (string "want `" expected "`, got `" got "`")])))
(printf "\n_walk 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)))
(flush)
(os/exit (if (empty? fails) 0 1))

102
test/chez/bench-pipeline.janet
View file

@ -1,102 +0,0 @@
# Phase 1 (jolt-cf1q.2) close-out bench — the compute benches run END TO END
# through the REAL pipeline (Clojure source -> Janet-hosted analyzer -> IR ->
# Scheme emitter -> Chez compile -> run), timed in-process (Chez startup
# excluded), and reported against the spike ceiling (spike/chez/RESULTS.md).
#
# This is the Phase 1 gate evidence: (1) compile-only is TOTAL for the compute
# subset — every form emits, no interpreter fallback (Chez has none); (2) the
# emitted code runs at ~the substrate ceiling, with the residual gap being
# exactly the typed fl*/fx* emission that Phase 4 owns.
#
# JOLT_CHEZ_BENCH=1 janet test/chez/bench-pipeline.janet
# Opt-in (like core-bench); skipped in the normal gate.
(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 (os/getenv "JOLT_CHEZ_BENCH")
(print "skip: set JOLT_CHEZ_BENCH=1 to run the Chez pipeline bench")
(os/exit 0))
(unless (d/chez-available?)
(print "skip: chez not on PATH")
(os/exit 0))
(def ctx (d/make-ctx))
# Emit a top-level program (one or more defns) through the real pipeline. Returns
# the concatenated Scheme for every form — each form must emit (compile-only is
# total) or this throws, which is itself the totality check.
(defn emit-program [src]
(def forms (map first (r/parse-all-positioned src)))
(string/join (map (fn [f] (emit/emit (backend/analyze-form ctx f))) forms) "\n"))
(def fib-src "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))")
# mandelbrot kernel: loop/recur + let + or-expansion + cross-var call, all flonum.
(def mandel-src ``
(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) acc
(let [ci (- (* 2.0 (/ (* 1.0 y) nd)) 1.0)
row (loop [x 0 a 0]
(if (>= x n) a
(let [cr (- (* 3.5 (/ (* 1.0 x) nd)) 2.5)]
(recur (inc x) (+ a (count-point cr ci cap))))))]
(recur (inc y) (+ acc row)))))))
``)
(def fib-scm (emit-program fib-src))
(def mandel-scm (emit-program mandel-src))
(print "compile-only total: fib + mandelbrot emitted with no fallback")
# One Chez program: load the RT, the emitted defns, a hand-written FLONUM fib
# reference (jolt's realistic ceiling given the all-double model), then time each
# end-to-end value (warm up first; exclude Chez startup via a monotonic clock).
(def prog
(string
"(import (chezscheme))\n(load \"host/chez/rt.ss\")\n"
fib-scm "\n" mandel-scm "\n"
"(define fib (var-deref \"user\" \"fib\"))\n"
"(define mrun (var-deref \"user\" \"run\"))\n"
# hand flonum fib — the substrate ceiling for jolt's number model
"(define (ffib n) (if (fl< n 2.0) n (fl+ (ffib (fl- n 1.0)) (ffib (fl- n 2.0)))))\n"
"(define (now-ns) (let ((t (current-time 'time-monotonic))) (+ (* (time-second t) 1000000000) (time-nanosecond t))))\n"
"(define (timed thunk) (let* ((t0 (now-ns)) (r (thunk)) (ms (/ (- (now-ns) t0) 1000000.0))) (cons r ms)))\n"
"(fib 24)(ffib 24.0)(mrun 30)\n" # warm up
"(let ((a (timed (lambda () (fib 30))))\n"
" (b (timed (lambda () (ffib 30.0))))\n"
" (c (timed (lambda () (mrun 200)))))\n"
" (printf \"~a ~a ~a ~a ~a ~a\\n\"\n"
" (jolt-pr-str (car a)) (exact->inexact (cdr a))\n"
" (jolt-pr-str (car b)) (exact->inexact (cdr b))\n"
" (jolt-pr-str (car c)) (exact->inexact (cdr c))))"))
(def path (string "/tmp/chez-bench-pipeline-" (os/getpid) ".ss"))
(spit path prog)
(def proc (os/spawn ["chez" "--script" path] :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))
(unless (= code 0) (printf "BENCH FAILED (code %d): %s" code err) (os/exit 1))
(def p (string/split " " out))
(defn num [i] (scan-number (get p i "0")))
(printf "\nReal-pipeline compute benches (Chez startup excluded):\n")
(printf " fib 30 (jolt, flonum) = %s in %6.2f ms" (get p 0) (num 1))
(printf " fib 30 (hand flonum ceiling) = %6.2f ms <- jolt's number-model ceiling" (num 3))
(printf " fib 30 (spike fixnum ceiling)= 5.20 ms <- Phase 4 fl/fx typed-emit target")
(printf " mandelbrot 200 (jolt) = %s in %6.2f ms" (get p 4) (num 5))
(printf " mandelbrot 200 (spike generic)= 98.10 ms <- generic-flonum ceiling")
(printf " mandelbrot 200 (spike typed) = 13.40 ms <- Phase 4 fl/fx typed-emit target")
(def fib-overhead (if (> (num 3) 0) (/ (num 1) (num 3)) 0))
(printf "\n jolt fib is %.2fx the hand-flonum ceiling (residual = truthy/dispatch; typed-emit closes the fixnum gap)." fib-overhead)
(os/exit 0)

72
test/chez/bootstrap-test.janet
View file

@ -1,72 +0,0 @@
# Chez Phase 3 inc9a (jolt-9phg) — the pure-Chez self-build (no Janet in the loop).
#
# inc8 proved the on-Chez compiler reproduces itself. inc9a makes that the actual
# build: host/chez/bootstrap.ss loads the CHECKED-IN seed (host/chez/seed/{prelude,
# image}.ss — the bootstrap compiler, minted once via the fixpoint) and rebuilds the
# clojure.core prelude + compiler image FROM SOURCE on Chez. No Janet is invoked in
# the compile path — this test only spawns `chez`; the read->analyze->emit is 100%
# Chez. So a fresh checkout + Chez (no Janet) yields a working jolt.
#
# The seed is a JOINT byte-fixpoint, so rebuilding from an up-to-date seed
# reproduces it exactly. If the seed SOURCES change (core tiers, the compiler, the
# host contract, the reader, emit-image.ss) the rebuilt artifacts will differ and
# this test fails — re-mint the seed with driver/mint-chez-seed* (see the failure
# message) and commit the refreshed seed.
#
# janet test/chez/bootstrap-test.janet
(import ../../host/chez/driver :as d)
(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 "")))))
(unless (d/chez-available?)
(print "chez not on PATH — skipping bootstrap-test")
(os/exit 0))
(def seed-prelude "host/chez/seed/prelude.ss")
(def seed-image "host/chez/seed/image.ss")
(ok "checked-in seed prelude exists" (os/stat seed-prelude))
(ok "checked-in seed image exists" (os/stat seed-image))
(when (and (os/stat seed-prelude) (os/stat seed-image))
(def tmp (or (os/getenv "TMPDIR") "/tmp"))
(def out-prelude (string tmp "/jolt-bootstrap-pre-" (os/getpid) ".ss"))
(def out-image (string tmp "/jolt-bootstrap-img-" (os/getpid) ".ss"))
(def t0 (os/clock))
# PURE CHEZ: spawn `chez --script bootstrap.ss` — no Janet in the compile path.
(def [code out err] (d/run-bootstrap seed-prelude seed-image out-prelude out-image))
(printf "pure-Chez bootstrap pass: %.1fs" (- (os/clock) t0))
(ok "bootstrap.ss runs cleanly on Chez (no Janet)" (= code 0)
(string "exit " code " " (string/slice err 0 (min 300 (length err)))))
(defn- bytes= [a b] (and (os/stat a) (os/stat b)
(= (string (slurp a)) (string (slurp b)))))
(def remint "re-mint with driver/mint-chez-seed* and commit host/chez/seed/")
(when (= code 0)
(ok "rebuilt prelude == checked-in seed (joint fixpoint)" (bytes= out-prelude seed-prelude)
(string "seed is stale — " remint))
(ok "rebuilt image == checked-in seed (joint fixpoint)" (bytes= out-image seed-image)
(string "seed is stale — " remint))
# The rebuilt artifacts must be a WORKING compiler.
(def cases
[["(let [x 1 y 2] (+ x y))" "3"]
["(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 10)" "55"]
["(->> (range 10) (filter even?) (map #(* % %)) (reduce +))" "120"]
["(let [{:keys [a b] :or {b 9}} {:a 1}] [a b])" "[1 9]"]
["(require '[clojure.string :as s]) (s/join \",\" [1 2 3])" "1,2,3"]
["(loop [i 0 acc 0] (if (< i 5) (recur (inc i) (+ acc i)) acc))" "10"]])
(var pass 0)
(each [src want] cases
(def [c o _] (d/eval-zero-janet out-prelude out-image (string "(do " src ")")))
(when (and (= c 0) (= o want)) (++ pass)))
(ok "Chez-built artifacts compile+run real cases" (= pass (length cases))
(string pass "/" (length cases) " cases passed")))
(each p [out-prelude out-image] (when (os/stat p) (os/rm p))))
(printf "\nbootstrap-test: %d/%d checks passed" (- total fails) total)
(os/exit (if (zero? fails) 0 1))

96
test/chez/cli-test.janet
View file

@ -1,96 +0,0 @@
# Chez Phase 3 inc9b (jolt-9phg) — the pure-Chez runtime CLI (no Janet).
#
# bin/joltc execs `chez --script host/chez/cli.ss`, which loads the checked-in
# bootstrap seed (host/chez/seed/) + the zero-Janet spine and compiles+evals a
# Clojure -e expression entirely on Chez. This test drives bin/joltc and checks
# results: with only Chez installed, jolt runs end to end — no Janet at build or
# run time. (This harness is Janet only to spawn the process; the compile+eval is
# 100% Chez.)
#
# janet test/chez/cli-test.janet
(import ../../host/chez/driver :as d)
(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 "")))))
(unless (d/chez-available?)
(print "chez not on PATH — skipping cli-test")
(os/exit 0))
(defn- joltc [expr]
(def proc (os/spawn ["bin/joltc" "-e" expr] :p {:out :pipe :err :pipe}))
(def out (string/trim (string (:read (proc :out) :all))))
(def err (string/trim (string (or (:read (proc :err) :all) ""))))
(def code (os/proc-wait proc))
[code out err])
(def cases
[["(+ 1 2)" "3"]
["(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 15)" "610"]
["(->> (range 10) (filter even?) (map #(* % %)) (reduce +))" "120"]
["(let [{:keys [a b] :or {b 99}} {:a 1}] [a b])" "[1 99]"]
["(require '[clojure.string :as s]) (s/upper-case \"hello\")" "HELLO"]
["(case 3 1 :a 2 :b :other)" ":other"]
["(reduce + (vals (reduce (fn [m k] (assoc m k (* k k))) {} [1 2 3])))" "14"]
["(map inc [1 2 3])" "(2 3 4)"]
["nil" ""]
# jolt-r8ku: runtime eval / load-string / defmacro on the Chez spine.
["(eval (quote (+ 1 2)))" "3"]
["(eval (list (quote +) 1 2 3))" "6"]
["(eval (quote (let [a 2 b 3] (* a b))))" "6"]
["(load-string \"(+ 1 2)\")" "3"]
["(load-string \"(def y 5) (* y y)\")" "25"]
["(load-string \"\")" ""]
["(map eval [(quote (+ 1 1)) (quote (* 3 3))])" "(2 9)"]
["(defmacro add1 [x] (list (quote +) x 1)) (add1 10)" "11"]
["(defmacro twice [x] `(do ~x ~x)) (twice (+ 2 3))" "5"]
["(defmacro m [x] `(+ ~x 1)) (m (m (m 0)))" "3"]
# jolt-byjr: concurrency — futures/pmap/promise on real OS threads (shared heap).
["(deref (future (+ 1 2)))" "3"]
["@(future (* 6 7))" "42"]
["(deref (future (mapv inc [1 2 3])))" "[2 3 4]"]
["(let [f (future (+ 1 1))] [(deref f) (deref f)])" "[2 2]"]
["(future? (future 1))" "true"]
["(future? 42)" "false"]
["(let [f (future 1)] (deref f) (future-done? f))" "true"]
["(let [f (future 1)] (deref f) (realized? f))" "true"]
["(let [f (future 42)] (deref f) (deref f 1000 :nope))" "42"]
["(vec (pmap inc [1 2 3]))" "[2 3 4]"]
["(vec (pmap + [1 2 3] [4 5 6]))" "[5 7 9]"]
["(vec (pcalls (fn [] 1) (fn [] 2)))" "[1 2]"]
["(vec (pvalues (+ 1 2) (+ 3 4)))" "[3 7]"]
# shared heap = JVM semantics (NOT Janet's isolated-heap snapshot): a captured
# atom is shared, so the future's swap! is visible to the parent.
["(let [a (atom 0)] (deref (future (swap! a inc))) @a)" "1"]
["(let [a (atom 0)] (dorun (pmap (fn [_] (swap! a inc)) [1 2 3 4])) @a)" "4"]
# promise blocks until delivered (JVM), unlike the Janet atom-shim.
["(let [p (promise)] (deliver p 7) @p)" "7"]
["(let [p (promise)] (future (deliver p :hi)) @p)" ":hi"]
# jolt-byjr: clojure.core.async on real-thread blocking channels.
["(require (quote [clojure.core.async :refer [chan go <! >! <!!]])) (def c (chan)) (go (>! c (+ 40 2))) (<!! c)" "42"]
["(require (quote [clojure.core.async :refer [chan go go-loop <! >! <!! close!]])) (def c (chan 5)) (go (>! c 1) (>! c 2) (>! c 3) (close! c)) (<!! (go-loop [o []] (let [v (<! c)] (if (nil? v) o (recur (conj o v))))))" "[1 2 3]"]
["(require (quote [clojure.core.async :refer [chan go <! >! <!!]])) (def x (chan)) (def y (chan)) (go (>! x 10)) (go (>! y 32)) (<!! (go (+ (<! x) (<! y))))" "42"]
["(require (quote [clojure.core.async :refer [chan go <! >! <!! alts!]])) (def x (chan)) (def y (chan)) (go (>! y :v)) (<!! (go (let [[v ch] (alts! [x y])] (and (= v :v) (= ch y)))))" "true"]
["(require (quote [clojure.core.async :refer [chan go go-loop <! >! <!! close!]])) (def c (chan 10 (map inc))) (go (>! c 1) (>! c 2) (>! c 3) (close! c)) (<!! (go-loop [o []] (let [v (<! c)] (if (nil? v) o (recur (conj o v))))))" "[2 3 4]"]
["(require (quote [clojure.core.async :refer [timeout <!!]])) (<!! (timeout 10)) :done" ":done"]
["(require (quote [clojure.core.async :refer [chan go <! >! <!!]])) (def ^:dynamic *x* 0) (<!! (binding [*x* 7] (go (<! (clojure.core.async/timeout 5)) *x*)))" "7"]
# jolt-byjr: async agents (serialized per-agent dispatch); await for determinism.
["(deref (agent 0))" "0"]
["(let [a (agent 0)] (send-off a + 5) (await a) (deref a))" "5"]
["(let [a (agent 1)] (send a + 6) (await a) (deref a))" "7"]
["(let [a (agent 0)] (dotimes [_ 100] (send a inc)) (await a) (deref a))" "100"]
["(agent-error (agent 0))" ""]
["(let [a (agent 0)] (send a (fn [_] (throw (ex-info \"boom\" {})))) (await a) (boolean (agent-error a)))" "true"]])
(each [src want] cases
(def [code out err] (joltc src))
(ok (string "joltc: " (if (> (length src) 48) (string (string/slice src 0 48) "...") src))
(and (= code 0) (= out want))
(string "[" code "] got " (string/format "%j" out) " want " (string/format "%j" want)
(if (= "" err) "" (string " err: " (string/slice err 0 (min 120 (length err))))))))
(printf "\ncli-test: %d/%d checks passed" (- total fails) total)
(os/exit (if (zero? fails) 0 1))

104
test/chez/core-prelude-probe.janet
View file

@ -1,104 +0,0 @@
# Phase 1 (jolt-cf1q.2, inc 3d) — clojure.core prelude emission probe.
#
# The path to an `-e`-capable jolt-chez: emit the clojure.core tiers
# (jolt-core/clojure/core/NN-*.clj) through the SAME live Janet analyzer ->
# host/chez/emit pipeline, as a Scheme PRELUDE of `def-var!` forms. User code's
# `(var-deref "clojure.core" "<fn>")` then resolves the fn at runtime.
#
# Most core fns are NOT native-ops, so they must be emitted; the ones that
# reference host interop / native Janet ops / unimplemented primitives can't be
# emitted yet (each a clean "out of subset" emit error). This probe reports how
# far the emit gets per tier and aggregates the gap list — the punch-list the
# next increments chase down. Measurement tool, gated out of the default suite.
# JOLT_CHEZ_PRELUDE=1 janet test/chez/core-prelude-probe.janet
(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 ../../host/chez/emit :as emit)
(unless (os/getenv "JOLT_CHEZ_PRELUDE")
(print "skip: set JOLT_CHEZ_PRELUDE=1 to run the core-prelude emission probe")
(os/exit 0))
# load order — same as api/core-tiers (the kernel tier is bootstrap-compiled in
# the live system; here we just measure emit reach, so treat it like the rest).
(def tier-files
["00-syntax" "00-kernel" "10-seq" "20-coll" "25-sorted" "30-macros" "40-lazy" "50-io"])
(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)
# jolt reader forms are arrays of jolt VALUES; a symbol is a struct
# {:jolt/type :symbol :name "..."} (jolt symbols aren't Janet symbols).
(defn- sym-name [x]
(when (and (struct? x) (= :symbol (get x :jolt/type))) (get x :name)))
# A short label for a top-level form: the defn/def name, or the form head.
(defn- form-label [f]
(if (and (indexed? f) (> (length f) 1))
(let [head (or (sym-name (in f 0)) "?") nm (sym-name (in f 1))]
(if nm (string head " " nm) head))
(string/slice (string/format "%p" f) 0 40)))
# Pull the unsupported fn/op name out of an emit error message for aggregation.
(defn- gap-key [msg]
(def m (string msg))
(cond
(string/find "stdlib fn" m) (let [i (string/find "`" m)] (string "stdlib: " (string/slice m (inc i) (string/find "`" m (inc i)))))
(string/find "stdlib ref" m) (let [i (string/find "`" m)] (string "stdlib: " (string/slice m (inc i) (string/find "`" m (inc i)))))
(string/find "host call" m) "host-call"
(string/find "host ref" m) "host-ref"
(string/find "unhandled op" m) (string/slice m (max 0 (- (length m) 30)))
(string/find "unsupported literal" m) "unsupported-literal"
(string/slice m 0 (min 50 (length m)))))
# Macros are analyze-time only (the Janet analyzer expands them away before emit),
# so they don't belong in a RUNTIME prelude — skip them, don't count as gaps.
(defn- macro-form? [f]
(and (indexed? f) (> (length f) 0)
(let [h (sym-name (in f 0))] (and h (or (= h "defmacro") (= h "definline"))))))
(emit/set-prelude-mode! true)
(def ctx (api/init {:compile? true}))
(tctx/ctx-set-current-ns ctx "clojure.core")
(var total 0) (var compiled 0)
(def gaps @{}) # gap-key -> count
(def gap-examples @{}) # gap-key -> first form label that hit it
(each tf tier-files
(def src (slurp (string "jolt-core/clojure/core/" tf ".clj")))
(def forms (parse-all src))
(var t-total 0) (var t-ok 0)
(each f forms
(unless (macro-form? f)
(++ total) (++ t-total)
(def res (protect (emit/emit (backend/analyze-form ctx f))))
(if (res 0)
(do (++ compiled) (++ t-ok))
(let [k (gap-key (res 1))]
(put gaps k (+ 1 (or (get gaps k) 0)))
(unless (get gap-examples k) (put gap-examples k (form-label f)))))))
(printf " %-10s %3d/%-3d forms emit" tf t-ok t-total))
(printf "\nCore prelude emit reach: %d/%d top-level forms compile to Scheme" compiled total)
(printf "%d distinct gaps (fn/op the emit back end can't lower yet):" (length gaps))
(def sorted-gaps (sort-by (fn [k] (- (get gaps k))) (keys gaps)))
(each k sorted-gaps
(printf " %4d x %-34s e.g. %s" (get gaps k) k (get gap-examples k)))
(flush)
# Regression floor (raise it as new IR ops / RT shims land, like the suite
# baseline). Fails if prelude emit reach drops below the recorded baseline.
(def reach-floor 355)
(when (< compiled reach-floor)
(printf "REGRESSION: prelude emit reach %d < floor %d" compiled reach-floor)
(os/exit 1))

8
test/chez/corpus.edn
View file

@ -596,7 +596,7 @@
{:suite "host-interop / java.io.File" :label "getName" :expected "\"c.txt\"" :actual "(do (require '[clojure.java.io :as io]) (.getName (io/file \"/a/b/c.txt\")))"}
{:suite "host-interop / java.io.File" :label "getPath joins" :expected "\"/a/b\"" :actual "(do (require '[clojure.java.io :as io]) (.getPath (io/file \"/a\" \"b\")))"}
{:suite "host-interop / java.io.File" :label "isDirectory of repo dir" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (.isDirectory (io/file \"docs\")))"}
{:suite "host-interop / java.io.File" :label "isFile of repo file" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (.isFile (io/file \"project.janet\")))"}
{:suite "host-interop / java.io.File" :label "isFile of repo file" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (.isFile (io/file \"README.md\")))"}
{:suite "host-interop / java.io.File" :label "exists is false off-disk" :expected "false" :actual "(do (require '[clojure.java.io :as io]) (.exists (io/file \"/no/such/path/xyz\")))"}
{:suite "host-interop / java.io.File" :label "file-seq yields File values" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (every? (fn [f] (instance? java.io.File f)) (file-seq (io/file \"docs\"))))"}
{:suite "host-interop / java.io.File" :label "file-seq finds files" :expected "true" :actual "(do (require '[clojure.java.io :as io]) (pos? (count (filter (fn [f] (.isFile f)) (file-seq (io/file \"docs\"))))))"}
@ -2137,14 +2137,14 @@
{:suite "sorted / seq fn interop" :label "vec of sorted-set" :expected "[1 2 3]" :actual "(vec (sorted-set 3 1 2))"}
{:suite "sorted / seq fn interop" :label "into vec" :expected "[[1 :a] [2 :b]]" :actual "(into [] (sorted-map 2 :b 1 :a))"}
{:suite "sorted / seq fn interop" :label "sorted-map-by 3way cmp" :expected "[3 2 1]" :actual "(vec (keys (sorted-map-by (fn [a b] (- b a)) 1 :a 2 :b 3 :c)))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "slurp returns string" :expected "true" :actual "(string? (slurp \"project.janet\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "slurp content" :expected "true" :actual "(do (require (quote [clojure.string :as s])) (s/includes? (slurp \"project.janet\") \"jolt\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "slurp returns string" :expected "true" :actual "(string? (slurp \"README.md\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "slurp content" :expected "true" :actual "(do (require (quote [clojure.string :as s])) (s/includes? (slurp \"README.md\") \"jolt\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "spit + slurp round" :expected "\"hello\"" :actual "(do (spit \"/tmp/jolt-spit-test.txt\" \"hello\") (slurp \"/tmp/jolt-spit-test.txt\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "spit append" :expected "\"ab\"" :actual "(do (spit \"/tmp/jolt-spit-test.txt\" \"a\") (spit \"/tmp/jolt-spit-test.txt\" \"b\" :append true) (slurp \"/tmp/jolt-spit-test.txt\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "printf formats" :expected "\"x=1 y=a\"" :actual "(with-out-str (printf \"x=%d y=%s\" 1 \"a\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "printf no newline" :expected "false" :actual "(do (require (quote [clojure.string :as s])) (s/includes? (with-out-str (printf \"%d\" 1)) \"\\n\"))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "flush returns nil" :expected "nil" :actual "(flush)"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "file-seq finds files" :expected "true" :actual "(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"project.janet\")) (file-seq \".\"))))"}
{:suite "io / slurp, spit, printf, flush (host-classified)" :label "file-seq finds files" :expected "true" :actual "(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"README.md\")) (file-seq \".\"))))"}
{:suite "ns / ns-map, ns-unmap, ns-refers" :label "ns-map has var" :expected "true" :actual "(do (def nmv 1) (some? (get (ns-map (quote user)) (quote nmv))))"}
{:suite "ns / ns-map, ns-unmap, ns-refers" :label "ns-unmap removes" :expected "nil" :actual "(do (def nuv 1) (ns-unmap (quote user) (quote nuv)) (resolve (quote nuv)))"}
{:suite "ns / ns-map, ns-unmap, ns-refers" :label "ns-refers sees refer" :expected "true" :actual "(do (require (quote clojure.string)) (refer (quote clojure.string)) (some? (get (ns-refers (quote user)) (quote join))))"}

130
test/chez/extract-corpus.janet
View file

@ -1,130 +0,0 @@
# Extract the case LIST (suite, label, actual) from the spec sources into corpus.edn.
#
# corpus.edn :expected is sourced from reference JVM Clojure by
# test/conformance/regen-corpus.clj — this extractor's :expected column is a
# placeholder. Use it to (re)derive the case list when adding spec rows, then run
# regen-corpus.clj to fill :expected from the JVM. Do not commit its raw output.
#
# Parses every test/spec/*.janet as DATA (no eval), pulls each
# (defspec "suite" [label expected actual] ...) triple. Run from repo root:
# janet test/chez/extract-corpus.janet
(use ../../src/jolt/reader) # not needed for parse, but keeps paths obvious
(defn parse-all [src]
(def p (parser/new))
(parser/consume p src)
(parser/eof p)
(def out @[])
(while (parser/has-more p) (array/push out (parser/produce p)))
out)
(defn edn-str [s]
# escape a Clojure-source string into an EDN/Janet string literal
(def b @`"`)
(each c s
(cond
(= c (chr `"`)) (buffer/push b `\"`)
(= c (chr "\\")) (buffer/push b "\\\\")
(= c (chr "\n")) (buffer/push b "\\n")
(= c (chr "\t")) (buffer/push b "\\t")
(buffer/push-byte b c)))
(buffer/push b `"`)
(string b))
(defn triples-from [form]
# form is (defspec "suite" [l e a] ...) as a parsed tuple
(when (and (indexed? form) (> (length form) 0) (= (first form) 'defspec))
(def suite (in form 1))
(def rows @[])
(each case (slice form 2)
(when (and (indexed? case) (>= (length case) 3))
(def label (in case 0))
(def expected (in case 1))
(def actual (in case 2))
# expected is either a Clojure-source string or the :throws keyword;
# actual is always a Clojure-source string. Skip non-literal rows.
(when (and (string? label) (string? actual)
(or (string? expected) (keyword? expected)))
(array/push rows {:suite suite :label label
:expected expected :actual actual})))
)
rows))
(def spec-dir "test/spec")
(def all @[])
(each f (sort (os/dir spec-dir))
(when (string/has-suffix? "-spec.janet" f)
(def path (string spec-dir "/" f))
(each form (parse-all (slurp path))
(when-let [rows (triples-from form)]
(array/concat all rows)))))
# --- fold in the inline conformance cases (jolt-ohtd) -------------------------
# test/integration/conformance-test.janet carries ~355 hand-written cases as a
# (def cases [["label" "expected" "actual"] ...]) vector — historically invisible to
# the corpus because extract only reads test/spec/. Pull them in too, deduped by
# :actual against the spec rows, so the host-neutral corpus is the union of both.
# Suites come from the file's `### ---- section ----` headers via a line scan (the
# parser drops comments, so section structure is recovered from raw text).
(def conf-path "test/integration/conformance-test.janet")
(defn- section-map [src]
# label-string -> section-name, by scanning raw lines: track the most recent
# `### ---- NAME ----` / `### ==== NAME ====` header above each `["label" ...]`.
(def out @{})
(var section "misc")
(each line (string/split "\n" src)
(def tl (string/trim line))
(cond
(string/has-prefix? "###" tl)
(let [body (string/trim (string/trim (string/trim tl "#") " ") "-= ")]
(when (> (length body) 0) (set section body)))
(string/has-prefix? "[\"" tl)
(let [close (string/find "\"" tl 2)]
(when close (put out (string/slice tl 2 close) section)))))
out)
(def conf-src (slurp conf-path))
(def sections (section-map conf-src))
(def seen-actual (tabseq [r :in all] (r :actual) true))
(var conf-added 0)
(each form (parse-all conf-src)
(when (and (indexed? form) (>= (length form) 3)
(= (first form) 'def) (= (in form 1) 'cases))
(each c (in form 2)
(when (and (indexed? c) (= 3 (length c))
(string? (in c 0)) (string? (in c 1)) (string? (in c 2)))
(def [label expected actual] [(in c 0) (in c 1) (in c 2)])
(unless (seen-actual actual)
(put seen-actual actual true)
(++ conf-added)
(array/push all {:suite (string "conformance / " (get sections label "misc"))
:label label :expected expected :actual actual}))))))
(printf "folded %d unique conformance cases (deduped by :actual)" conf-added)
# emit EDN-and-Janet-valid corpus. [suite label] is the canonical case id, so make
# it unique: a duplicate label within a suite gets " (N)" appended (jolt-3447 — the
# conformance fold can repeat a label, e.g. two "str/replace regex" rows). Rows are
# immutable structs, so disambiguate the label here at emit time.
(def label-seen @{})
(def out @"[\n")
(each row all
(def k (string (row :suite) "\x00" (row :label)))
(def n (get label-seen k))
(put label-seen k (if n (+ n 1) 1))
(def label (if n (string (row :label) " (" (+ n 1) ")") (row :label)))
(buffer/push out
(string " {:suite " (edn-str (row :suite))
" :label " (edn-str label)
" :expected " (if (keyword? (row :expected)) ":throws" (edn-str (row :expected)))
" :actual " (edn-str (row :actual)) "}\n")))
(buffer/push out "]\n")
# corpus.edn is JVM-sourced (regen-corpus.clj); writing the Janet-extracted answers
# here would clobber it. Only write the case list to a separate path when explicitly
# asked (then re-source :expected with regen-corpus.clj). The test runner imports
# this file but never sets the flag, so it has no side effect.
(def out-path (os/getenv "JOLT_EXTRACT_CORPUS_OUT"))
(if out-path
(do (spit out-path out)
(printf "extracted %d cases from %s into %s" (length all) spec-dir out-path))
(print "extract-corpus: set JOLT_EXTRACT_CORPUS_OUT=<path> to write the case list (corpus.edn is JVM-sourced via regen-corpus.clj)"))

126
test/chez/fixpoint-test.janet
View file

@ -1,126 +0,0 @@
# Chez Phase 3 inc8 (jolt-bzni) — the self-hosting bootstrap fixpoint.
#
# The zero-Janet spine (spine-test / run-corpus-zero-janet) proves the ON-CHEZ
# analyzer+emitter compile arbitrary Clojure faithfully. This proves the stronger
# property from self-hosting-bootstrap-research §4: the emitted system reproduces
# ITSELF. Two artifacts are re-emitted ON CHEZ by the loaded compiler:
#
# COMPILER IMAGE (jolt.ir + jolt.analyzer + jolt.backend-scheme)
# stage1 = Janet analyzer/emitter cross-compiles the sources (the bootstrap input)
# stage2 = the on-Chez compiler (from stage1) re-emits them
# stage3 = the on-Chez compiler (from stage2) re-emits them
# FIXPOINT: stage2 == stage3 (stage1 differs only in gensym numbering — the
# Janet build allocates more gensyms before reaching the compiler emit).
#
# CORE PRELUDE (clojure.core tiers + clojure.string/walk/template/edn/set/pprint)
# pstage2 = on-Chez compiler re-emits the prelude with the JANET prelude loaded
# pstage3 = ... with pstage2 loaded
# pstage4 = ... with pstage3 loaded
# FIXPOINT: pstage3 == pstage4. The prelude converges one stage later than the
# compiler because its MACRO expanders bake an auto-gensym id (foo#) at emit
# time, so a macro emitted by Janet (pstage2's loaded prelude) carries a
# different baked id than one emitted by Chez — only once BOTH stages load a
# Chez-emitted prelude (pstage3 onward) does it stabilize.
#
# Finally we load the FULLY Chez-emitted system (Chez prelude + Chez compiler
# image, NO Janet-emitted artifact in the loop) and run real cases, proving the
# fixpoint is a working compiler, not a degenerate stable one.
#
# janet test/chez/fixpoint-test.janet
(import ../../host/chez/driver :as d)
(import ../../host/chez/jolt-chez :as jc)
(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 "")))))
(unless (d/chez-available?)
(print "chez not on PATH — skipping fixpoint-test")
(os/exit 0))
(def ctx (d/make-ctx))
(def jprelude (jc/ensure-prelude ctx))
# stage1: the Janet cross-compiled compiler image, cached by source fingerprint
# (same scheme as spine-test / run-corpus-zero-janet).
(defn- image-fingerprint []
(string/slice (string (hash (string/join
(map slurp ["jolt-core/jolt/ir.clj" "jolt-core/jolt/analyzer.clj"
"jolt-core/jolt/backend_scheme.clj" "host/chez/host-contract.ss"
"host/chez/compile-eval.ss"])))) 0))
(def tmp (or (os/getenv "TMPDIR") "/tmp"))
(def stage1 (string tmp "/jolt-compiler-image-" (image-fingerprint) ".ss"))
(d/ensure-compiler-image ctx stage1)
(printf "stage1 compiler image (Janet cross-compile): %d bytes" (length (slurp stage1)))
(flush)
(defn- bytes= [a b] (= (string (slurp a)) (string (slurp b))))
(defn- first-diff [a b]
(def s (string (slurp a))) (def t (string (slurp b)))
(def n (min (length s) (length t)))
(var i 0) (while (and (< i n) (= (s i) (t i))) (++ i))
(string "sizes " (length s) " vs " (length t) ", first diff at " i))
# ---- compiler-image fixpoint: stage2 == stage3 -------------------------------
(def s2 (string tmp "/jolt-fixpoint-img2-" (os/getpid) ".ss"))
(def s3 (string tmp "/jolt-fixpoint-img3-" (os/getpid) ".ss"))
(def [c2 e2] (d/emit-image-on-chez jprelude stage1 s2))
(ok "compiler image stage2 emits cleanly on Chez" (and (= c2 0) (os/stat s2))
(string "exit " c2 " " (string/slice e2 0 (min 300 (length e2)))))
(def [c3 e3] (d/emit-image-on-chez jprelude s2 s3))
(ok "compiler image stage3 emits cleanly on Chez" (and (= c3 0) (os/stat s3))
(string "exit " c3 " " (string/slice e3 0 (min 300 (length e3)))))
(when (and (os/stat s2) (os/stat s3))
(ok "compiler image: stage2 == stage3 (byte-for-byte fixpoint)" (bytes= s2 s3)
(first-diff s2 s3))
(ok "compiler image is substantial (> 80KB)" (> (length (slurp s2)) 80000)))
# ---- prelude fixpoint: pstage3 == pstage4 ------------------------------------
(def p2 (string tmp "/jolt-fixpoint-prelude2-" (os/getpid) ".ss"))
(def p3 (string tmp "/jolt-fixpoint-prelude3-" (os/getpid) ".ss"))
(def p4 (string tmp "/jolt-fixpoint-prelude4-" (os/getpid) ".ss"))
(def [pc2 pe2] (d/emit-image-on-chez jprelude stage1 p2 "jolt-emit-prelude"))
(ok "prelude pstage2 emits cleanly on Chez (from Janet prelude)" (and (= pc2 0) (os/stat p2))
(string "exit " pc2 " " (string/slice pe2 0 (min 300 (length pe2)))))
(when (os/stat p2)
(def [pc3 pe3] (d/emit-image-on-chez p2 stage1 p3 "jolt-emit-prelude"))
(ok "prelude pstage3 emits cleanly on Chez (from pstage2)" (and (= pc3 0) (os/stat p3))
(string "exit " pc3 " " (string/slice pe3 0 (min 300 (length pe3)))))
(when (os/stat p3)
(def [pc4 pe4] (d/emit-image-on-chez p3 stage1 p4 "jolt-emit-prelude"))
(ok "prelude pstage4 emits cleanly on Chez (from pstage3)" (and (= pc4 0) (os/stat p4))
(string "exit " pc4 " " (string/slice pe4 0 (min 300 (length pe4)))))
(when (os/stat p4)
(ok "prelude: pstage3 == pstage4 (byte-for-byte fixpoint)" (bytes= p3 p4)
(first-diff p3 p4))
(ok "prelude is substantial (> 250KB)" (> (length (slurp p3)) 250000)))))
# ---- the fully Chez-emitted system is a working compiler ----------------------
# Chez-emitted prelude (pstage3) + Chez-emitted compiler image (s2): no Janet
# artifact in the loop. Drive real compile+eval through it.
(def verify-cases
[["(let [x 1 y 2] (+ x y))" "3"]
["(when (> 5 3) (-> 10 (- 1) (* 2)))" "18"]
["(defn f [a b] (* a b)) (f 6 7)" "42"]
["(map inc [1 2 3])" "(2 3 4)"]
["(reduce + 0 (range 5))" "10"]
["(let [{:keys [a b]} {:a 7 :b 8}] (+ a b))" "15"]
["(filter even? (range 10))" "(0 2 4 6 8)"]
["(require '[clojure.string :as s]) (s/upper-case \"hi\")" "HI"]
["(cond (= 1 2) :a (= 1 1) :b :else :c)" ":b"]])
(when (and (os/stat p3) (os/stat s2))
(var vpass 0)
(each [src want] verify-cases
(def [code out _] (d/eval-zero-janet p3 s2 (string "(do " src ")")))
(when (and (= code 0) (= out want)) (++ vpass)))
(ok "fully Chez-emitted system (Chez prelude + Chez image) compiles+runs real cases"
(= vpass (length verify-cases))
(string vpass "/" (length verify-cases) " cases passed")))
# cleanup temp stages
(each p [s2 s3 p2 p3 p4] (when (os/stat p) (os/rm p)))
(printf "\nfixpoint-test: %d/%d checks passed" (- total fails) total)
(os/exit (if (zero? fails) 0 1))

63
test/chez/nil-names-probe.janet
View file

@ -1,63 +0,0 @@
# Phase 2 (jolt-cf1q.3) — which clojure.core names resolve to jolt-nil on Chez?
#
# The parity gate buckets a missing native generically as "apply non-procedure
# jolt-nil" — it doesn't NAME the fn. This probe does: it assembles the prelude,
# enumerates every clojure.core var name, then runs ONE Chez program that
# var-derefs each name (after loading prelude + post-prelude) and prints the ones
# that are still nil. That list is the shim punch-list for the next increment.
# JOLT_CHEZ_NIL_PROBE=1 janet test/chez/nil-names-probe.janet
(import ../../host/chez/driver :as d)
(import ../../src/jolt/types_ctx :as tctx)
(unless (os/getenv "JOLT_CHEZ_NIL_PROBE")
(print "skip: set JOLT_CHEZ_NIL_PROBE=1 to run the nil-names probe")
(os/exit 0))
(unless (d/chez-available?)
(print "skip: chez not on PATH")
(os/exit 0))
(def ctx (d/make-ctx))
# Collect every clojure.core var name (mapping keys are symbol structs).
(def names @{})
(each ns (tctx/all-ns ctx)
(when (= (get ns :name) "clojure.core")
(eachk sym (get ns :mappings)
(def n (cond (struct? sym) (get sym :name)
(string? sym) sym
(symbol? sym) (string sym)
nil))
(when n (put names n true)))))
(def name-list (sort (keys names)))
(printf "clojure.core has %d interned names" (length name-list))
# Assemble the prelude once.
(def [prelude-scm emitted total] (d/emit-core-prelude ctx))
(def prelude-path (string "/tmp/jolt-nil-probe-prelude-" (os/getpid) ".ss"))
(spit prelude-path prelude-scm)
(printf "prelude: %d/%d non-macro core forms emitted" emitted total)
# Build a Chez program that derefs each name and prints the nil ones.
(def buf @"")
(buffer/push buf "(import (chezscheme))\n(load \"host/chez/rt.ss\")\n")
(buffer/push buf "(set-chez-ns! \"clojure.core\")\n")
(buffer/push buf (string "(load " (string/format "%j" prelude-path) ")\n"))
(buffer/push buf "(load \"host/chez/post-prelude.ss\")\n")
(buffer/push buf "(set-chez-ns! \"user\")\n")
(each n name-list
(buffer/push buf
(string "(when (jolt-nil? (var-deref \"clojure.core\" " (string/format "%j" n)
")) (display " (string/format "%j" n) ") (newline))\n")))
(def prog-path (string "/tmp/jolt-nil-probe-" (os/getpid) ".ss"))
(spit prog-path buf)
(def proc (os/spawn ["chez" "--script" prog-path] :p {:out :pipe :err :pipe}))
(def out (ev/read (proc :out) 0x100000))
(def err (ev/read (proc :err) 0x100000))
(def code (os/proc-wait proc))
(def nils (filter (fn [s] (> (length s) 0)) (string/split "\n" (string/trim (if out (string out) "")))))
(printf "\n%d clojure.core names resolve to jolt-nil on Chez:" (length nils))
(each n (sort nils) (print " " n))
(when (and err (> (length (string/trim (string err))) 0))
(printf "\nstderr:\n%s" (string err)))
(printf "\n(probe exit %d)" code)

212
test/chez/run-corpus-zero-janet.janet
View file

@ -1,212 +0,0 @@
# Phase 3 inc7 (jolt-qjr0) — FULL corpus on the ZERO-JANET spine.
#
# run-corpus-prelude.janet measures RUNTIME parity: it analyzes each case with the
# JANET-hosted analyzer (the oracle) and runs the emitted Scheme on Chez. This
# runner closes the last gap: it analyzes each case with the CHEZ-HOSTED analyzer
# (jolt.analyzer cross-compiled to Scheme, run on Chez over host-contract.ss) —
# read -> analyze -> IR -> emit -> eval, NO Janet in the loop (eval-zero-janet).
#
# So this is the real test of self-hosting: where run-corpus-prelude proves the
# RUNTIME is faithful, this proves the COMPILER-on-Chez is faithful. A case that
# the Janet analyzer compiles but the Chez analyzer can't surfaces here as a crash
# (analyzer/emitter raised) or a divergence (ran, wrong value). The buckets form
# the inc7 punch-list; genuinely host-coupled cases (Java interop, runtime eval)
# are deferred to Phase 4 / jolt-r8ku and allowlisted, like the prelude gate.
#
# JOLT_CHEZ_ZEROJANET_CORPUS=1 janet test/chez/run-corpus-zero-janet.janet
# JOLT_CORPUS_LIMIT=200 … (every-Nth stride, fast iteration)
(import ../../host/chez/driver :as d)
(import ../../host/chez/jolt-chez :as jc)
(unless (os/getenv "JOLT_CHEZ_ZEROJANET_CORPUS")
(print "skip: set JOLT_CHEZ_ZEROJANET_CORPUS=1 to run the zero-Janet corpus gate")
(os/exit 0))
(unless (d/chez-available?)
(print "skip: chez not on PATH")
(os/exit 0))
(def ctx (d/make-ctx))
(def prelude-path (jc/ensure-prelude ctx))
# Compiler image (jolt.ir + jolt.analyzer + jolt.backend-scheme cross-compiled to
# Scheme), cached by the same source fingerprint the spine-test uses.
(defn- image-fingerprint []
(string/slice (string (hash (string/join
(map slurp ["jolt-core/jolt/ir.clj" "jolt-core/jolt/analyzer.clj"
"jolt-core/jolt/backend_scheme.clj" "host/chez/host-contract.ss"
"host/chez/compile-eval.ss"])))) 0))
(def image-path
(string (or (os/getenv "TMPDIR") "/tmp") "/jolt-compiler-image-" (image-fingerprint) ".ss"))
(def t0 (os/clock))
(d/ensure-compiler-image ctx image-path)
(printf "prelude + compiler image ready (%.1fs)" (- (os/clock) t0))
(flush)
(def corpus (parse (slurp "test/chez/corpus.edn")))
(def cases
(if-let [n (os/getenv "JOLT_CORPUS_LIMIT")]
(let [stride (max 1 (math/floor (/ (length corpus) (scan-number n))))]
(seq [i :range [0 (length corpus) stride]] (in corpus i)))
corpus))
# Known divergences/crashes: cases the Chez-hosted compiler can't yet handle that
# are tracked elsewhere (NOT analyzer-faithfulness bugs). Tolerated so the gate
# fails only on a NEW regression. Keyed by label.
# - host interop (Java classes / constructors / .method on host types): Phase 4
# jolt-cf1q.7. Same family the prelude gate buckets as crashes.
# - eval / load-string / read->eval: the jolt-r8ku tail (runtime compiler entry).
(def known-fail
# Conformance gaps vs the JVM spec: cases jolt does not match because it has no
# JVM host (no Class objects / Java arrays / BigDecimal), supports the :jolt
# reader-conditional feature, or prints its own forms for transients/atoms.
@{# --- host classes: a class token resolves to a name string, not a Class ------
"class name evaluates to canonical string" true
"class number" true "class string" true "class keyword" true
"definterface defines" true
"getMessage on a thrown string" true
"type of record" true "chunked-seq? always false" true
"^Type tag on var" true "symbol hint -> :tag" true
"lists extended type" true "seq of tags" true
"close on throw" true # duck-typed with-open close, no .close interop
"macroexpand-1" true # returns a value, not the JVM Cons form
"ns-imports empty user" true
"bean is the map" true "proxy resolves nil" true
"unchecked-char" true
# --- *in* is a map on Chez, not a JVM Reader --------------------------------
"*in* is bound" true "*in* bound" true
# --- no BigDecimal type -----------------------------------------------------
"bigdec" true "bigdec int M" true "bigdec suffix M" true
# --- printer: jolt renders its own forms (transient/atom/Infinity, no
# print-method multimethod integration) where the JVM prints #object ------
"transient vector" true "transient map" true
"atom override fires nested" true "inf inside coll" true "pr-str Infinity" true
"defmethod overrides a record, top level" true
"defmethod fires nested in a map" true "defmethod fires through prn" true
"direct builtin override" true "methods table inspectable" true
# --- reader: :jolt reader-conditional feature + syntax-quote literal collapse -
"reader conditional" true "reader cond :jolt" true "reader cond no match" true
"reader cond splice" true "reader cond splice no match" true
"nil nested" true "bool nested" true
"source order through syntax-quote" true # syntax-quote map: hash, not source, order
# --- Java arrays are distinct host objects, not seqs --------------------------
"make-array" true "into-array" true "to-array" true "aclone vec" true
"boolean-array" true "int-array" true "long-array" true "double-array" true
"float-array" true "short-array" true "doubles" true "floats" true
"reader over char[]" true
# --- atom class identity not mapped on Chez ---------------------------------
"atom?" true "instance? Atom" true
# --- future-cancel races completion (timing-dependent) -----------------------
"cancel an in-flight future returns true" true
"future-cancelled? after cancel" true
# --- (fn* foo) with no param vector throws; the JVM builds a fn object --------
"no param vector" true})
# Cases that BLOCK forever on a shared-heap / JVM host (profile.edn :bucket
# :timeout) — skip them, like :throws: a single hung case would stall the whole
# batched process. (deref of an undelivered promise blocks on the JVM and now on
# Chez; Janet's non-blocking atom-shim returned nil.)
(def skip-blocking @{"promise undelivered" true})
(var pass 0)
(def crashes @[]) # nonzero chez exit (analyzer/emitter raised, or runtime gap)
(def diverged @[]) # ran, wrong value (a real Chez-compiler divergence)
(def known-hit @[])
(def crash-keys @{})
(defn- bucket [tbl k] (put tbl k (+ 1 (or (get tbl k) 0))))
# Group a chez stderr message into a coarse reason for the punch-list.
(defn- crash-reason [m]
(def m (string/trim m))
(cond
(string/find "unsupported stdlib" m) "emit: unsupported stdlib fn"
(string/find "unsupported host" m) "emit: unsupported host call"
(string/find "host-static" m) "emit: host-static"
(string/find "syntax-quote" m) "form-syntax-quote-lower"
(string/find "uncompil" m) "analyzer: uncompilable"
(string/find "Unknown class" m) "runtime: unknown class"
(string/find "No constructor" m) "runtime: no constructor"
(string/find "No method" m) "runtime: no method"
(string/find "not a fn" m) "runtime: not a fn"
(string/find "not seqable" m) "runtime: not seqable"
(string/find "not a transient" m) "runtime: not a transient"
(string/find "integer->char" m) "runtime: integer->char"
(string/find "non-condition value" m)
(let [i (string/find "non-condition value" m)]
(string "raised: " (string/slice m (+ i 20) (min (length m) (+ i 60)))))
(string/slice m 0 (min 56 (length m)))))
(def t1 (os/clock))
(var throws 0)
# Build the evaluable case list (skip :throws), keyed by index (labels aren't
# unique across suites). Each pair carries EXPECTED + ACTUAL as SEPARATE source
# strings; the runner evaluates ACTUAL as its own top-level program (so its
# top-level `do` unrolls and a macro defined in the program is usable later —
# matching certify.clj's eval-isolated) and compares to EXPECTED with =. Wrapping
# in (= E A) would nest ACTUAL's do and break runtime defmacro (jolt-cf1q.7).
(def rows-by-idx @{})
(def pairs @[])
(eachp [i row] cases
(def {:expected e :actual a :label l} row)
(if (or (= e :throws) (get skip-blocking l))
(++ throws)
(let [key (string i)]
(put rows-by-idx key row)
(array/push pairs [key e a]))))
(defn- handle [key verdict]
(def row (get rows-by-idx key))
(def l (get row :label))
(case (first verdict)
:pass (++ pass)
:crash (let [k (crash-reason (get verdict 1))] (bucket crash-keys k) (array/push crashes [l k]))
:diverge (if (known-fail l) (array/push known-hit l)
(array/push diverged [l (string "got " (get verdict 1))]))))
(if (os/getenv "JOLT_ZJ_PERCASE")
# slow per-case path (each case its own chez process) — for isolating a hang/crash.
# Eval ACTUAL and EXPECTED top-level (separate processes), compare printed forms.
(each [key e a] pairs
(def [acode aout aerr] (d/eval-zero-janet prelude-path image-path a))
(def [_ eout _] (d/eval-zero-janet prelude-path image-path e))
(handle key (cond (not= acode 0) [:crash aerr] (= aout eout) [:pass] [:diverge aout])))
# fast batched path: one chez process loads the runtime once, runs all cases
(let [{:results r :code c :stderr se :count n} (d/eval-corpus-zero-janet prelude-path image-path pairs)]
(when (< n (length pairs))
(printf "WARNING: batched runner returned %d/%d results (chez exit %d): %s"
n (length pairs) c (string/slice se 0 (min 200 (length se)))))
(each [key _] pairs
(handle key (or (get r key) [:crash (string "no result (batch aborted) " se)])))))
(def n-eval (+ pass (length crashes) (length diverged) (length known-hit)))
(printf "\nZero-Janet corpus parity: %d/%d evaluated cases pass (%.1fs)" pass n-eval (- (os/clock) t1))
(printf " crash: %d NEW divergence: %d known: %d (throws skipped: %d)"
(length crashes) (length diverged) (length known-hit) throws)
(defn- report [title tbl]
(when (> (length tbl) 0)
(printf "\n%s:" title)
(each k (sort-by (fn [k] (- (get tbl k))) (keys tbl))
(printf " %4d x %s" (get tbl k) k))))
(report "crash reasons" crash-keys)
(when (os/getenv "JOLT_DUMP_CRASH_LABELS")
(printf "\nCRASH LABELS:")
(each [l k] (sort-by (fn [pair] (get pair 1)) crashes)
(printf " [%s] :: %s" k l))
(printf "\nKNOWN-HIT LABELS:")
(each l (sort known-hit) (printf " %s" l)))
(when (> (length diverged) 0)
(printf "\nNEW divergences (ran, wrong value) — gate FAILS:")
(each [l m] (slice diverged 0 (min 40 (length diverged)))
(printf " [%s] %s" l m)))
(when (> (length known-hit) 0)
(printf "\n%d known (allowlisted) failures tolerated." (length known-hit)))
(flush)
# Regression floor: cases that pass against the JVM corpus. The gate fails on any
# NEW divergence or if pass drops below the floor. Raise as host gaps close.
(def base-floor (scan-number (or (os/getenv "JOLT_CHEZ_ZJ_FLOOR") "2678")))
(def floor (if (os/getenv "JOLT_CORPUS_LIMIT") 0 base-floor))
(when (or (> (length diverged) 0) (< pass floor))
(printf "REGRESSION: pass %d < floor %d or %d new divergence(s)" pass floor (length diverged)))
(os/exit (if (or (> (length diverged) 0) (< pass floor)) 1 0))

97
test/chez/spine-test.janet
View file

@ -1,97 +0,0 @@
# Chez Phase 3 inc6 (jolt-hs9n) — the zero-Janet spine.
#
# Validates that the analyzer + emitter, cross-compiled to Scheme and run ON CHEZ
# over the host contract (host-contract.ss), compile and run macro-free Clojure
# from source with NO Janet in the loop: read (reader.ss) -> analyze (jolt.analyzer
# on Chez) -> IR -> emit (jolt.backend-scheme on Chez) -> eval.
#
# Oracle = the Janet-hosted analyzer through the SAME Chez emitter/RT/printer
# (d/eval-e-with-prelude): the only difference under test is WHERE analysis runs
# (Janet vs Chez), so equal stdout means moving analysis onto Chez is behavior-
# preserving. Macros (let/when/->/defn) are inc6b (jolt-r8ku, runtime macros).
#
# janet test/chez/spine-test.janet
(import ../../src/jolt/api :as api)
(import ../../host/chez/driver :as d)
(import ../../host/chez/jolt-chez :as jc)
(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 "")))))
(unless (d/chez-available?)
(print "chez not on PATH — skipping spine-test")
(os/exit 0))
(def ctx (d/make-ctx))
(def prelude-path (jc/ensure-prelude ctx))
# compiler image cache, keyed by the cross-compiled sources + the host contract.
(defn- image-fingerprint []
(string/slice (string (hash (string/join
(map slurp ["jolt-core/jolt/ir.clj" "jolt-core/jolt/analyzer.clj"
"jolt-core/jolt/backend_scheme.clj" "host/chez/host-contract.ss"
"host/chez/compile-eval.ss"])))) 0))
(def image-path
(string (or (os/getenv "TMPDIR") "/tmp") "/jolt-compiler-image-" (image-fingerprint) ".ss"))
(d/ensure-compiler-image ctx image-path)
# Each case: the Chez-hosted spine value must equal the Janet-hosted oracle value
# (both printed via jolt-final-str on Chez).
(defn check [src]
(def [ocode oout oerr] (d/eval-e-with-prelude ctx src prelude-path))
(def [acode aout aerr] (d/eval-zero-janet prelude-path image-path src))
(cond
(= ocode :emit-err) (ok src false (string "oracle emit-err: " oout))
(not (zero? acode)) (ok src false (string "zero-janet exit " acode ": " aerr " | out=" aout))
(ok src (= oout aout) (string "chez=" aout " oracle=" oout))))
# macro-free forms: handled specials (if/do/fn*), native ops, consts, invoke.
(each src
["(if true 10 20)"
"(if false 10 20)"
"(do 1 2 3)"
"(+ 1 2)"
"(- 10 3 2)"
"((fn* [x] (* x x)) 7)"
"((fn* [x] (+ x 1)) 5)"
"((fn* [a b] (+ a b)) 3 4)"
"(if (< 3 5) :yes :no)"
"(if (> 3 5) :yes :no)"
"((fn* [x] (if x :t :f)) true)"
"(do (if true 1 2) (* 6 7))"
"((fn* [n] (* n n n)) 4)"
"(< 1 2)"
"(= 5 5)"]
(check src))
# inc6b (jolt-r9lm): runtime macros — the on-Chez analyzer expands core macros
# (emitted into the prelude as expander fns + a macro flag). Same oracle: the
# Janet analyzer expands them at analyze time, the value must match.
(each src
["(when true 1)"
"(when false 1)"
"(when true 1 2 3)"
"(when-not false 5)"
"(let [a 1] (+ a 2))"
"(let [a 1 b 2] (+ a b))"
"(let [a 1 b (+ a 1)] (* a b))"
"(-> 1 inc inc)"
"(-> 5 (- 2))"
"(->> 3 (- 10))"
"(and 1 2 3)"
"(and 1 false 3)"
"(or nil 5)"
"(or false nil 7)"
"(cond false 1 true 2)"
"(cond false 1 :else 3)"
"(if-not false :a :b)"
"(do (defn f [x] (* x x)) (f 6))"
"(do (defn g [x y] (+ x y 1)) (g 3 4))"
"(let [a 1] (when (< a 5) (-> a inc inc)))"]
(check src))
(printf "\n%d/%d ok" (- total fails) total)
(when (> fails 0) (os/exit 1))

12
test/chez/unit.edn
View file

@ -114,27 +114,27 @@
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.getName (io/file \"/a/b/c.txt\")))" :expected "c.txt"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.getPath (io/file \"/a\" \"b\")))" :expected "/a/b"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.isDirectory (io/file \"docs\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.isFile (io/file \"project.janet\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.isFile (io/file \"README.md\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.isFile (io/file \"docs\")))" :expected "false"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.exists (io/file \"/no/such/path/xyz\")))" :expected "false"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.exists (io/file \"project.janet\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (.exists (io/file \"README.md\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (instance? java.io.File (io/file \"/a/b\")))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (instance? java.io.File \"/a/b\"))" :expected "false"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (str (type (io/file \"/a\"))))" :expected ":jolt/file"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (every? (fn [f] (instance? java.io.File f)) (file-seq (io/file \"docs\"))))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (pos? (count (filter (fn [f] (.isFile f)) (file-seq (io/file \"docs\"))))))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"project.janet\")) (file-seq \".\"))))" :expected "true"}
{:suite "io" :expr "(string? (slurp \"project.janet\"))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.string :as s])) (boolean (some (fn [p] (s/ends-with? p \"README.md\")) (file-seq \".\"))))" :expected "true"}
{:suite "io" :expr "(string? (slurp \"README.md\"))" :expected "true"}
{:suite "io" :expr "(do (spit \"/tmp/jolt-io-test.txt\" \"hello\") (slurp \"/tmp/jolt-io-test.txt\"))" :expected "hello"}
{:suite "io" :expr "(do (spit \"/tmp/jolt-io-test.txt\" \"a\") (spit \"/tmp/jolt-io-test.txt\" \"b\" :append true) (slurp \"/tmp/jolt-io-test.txt\"))" :expected "ab"}
{:suite "io" :expr "(flush)" :expected ""}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (string? (slurp (io/file \"project.janet\"))))" :expected "true"}
{:suite "io" :expr "(do (require (quote [clojure.java.io :as io])) (string? (slurp (io/file \"README.md\"))))" :expected "true"}
{:suite "ioreader" :expr "(str (char-array \"abc\"))" :expected "(\\a \\b \\c)"}
{:suite "ioreader" :expr "(.read (StringReader. (apply str (char-array \"Qz\"))))" :expected "81"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.read (io/reader (char-array \"abc\"))))" :expected "97"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.read (io/reader (StringReader. \"k\"))))" :expected "107"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (slurp (io/reader (char-array \"xyz\"))))" :expected "xyz"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (string? (slurp (io/reader \"project.janet\"))))" :expected "true"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (string? (slurp (io/reader \"README.md\"))))" :expected "true"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.toString (.toURL (io/file \"/tmp/x\"))))" :expected "file:/tmp/x"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.toURI (io/file \"/tmp/x\")))" :expected "file:/tmp/x"}
{:suite "ioreader" :expr "(do (require (quote [clojure.java.io :as io])) (.getPath (.toURL (io/file \"/tmp/x\"))))" :expected "/tmp/x"}

149
test/clojure-stdlib/clojure/data_test/diff.cljc
View file

@ -1,149 +0,0 @@
(ns clojure.data-test.diff
(:require [clojure.test :refer [deftest is testing]]
;; NOTE (jolt): sequential-diff expectations corrected to match real Clojure —
;; clojure.data pads only to the max differing index (e.g. (diff [1 2 3] [1 9 3])
;; -> a=[nil 2], not [nil 2 nil]). The upstream clojurust fixtures had this wrong.
[clojure.data :refer [diff]]))
;; ── Atoms ────────────────────────────────────────────────────────────────────
(deftest test-diff-equal-atoms
(testing "equal atoms"
(is (= [nil nil :a] (diff :a :a)))
(is (= [nil nil 1] (diff 1 1)))
(is (= [nil nil "hello"] (diff "hello" "hello")))
(is (= [nil nil nil] (diff nil nil)))
(is (= [nil nil true] (diff true true)))))
(deftest test-diff-unequal-atoms
(testing "unequal atoms"
(is (= [:a :b nil] (diff :a :b)))
(is (= [1 2 nil] (diff 1 2)))
(is (= ["a" "b" nil] (diff "a" "b")))
(is (= [nil 1 nil] (diff nil 1)))
(is (= [true false nil] (diff true false)))))
;; ── Maps ─────────────────────────────────────────────────────────────────────
(deftest test-diff-equal-maps
(testing "equal maps"
(is (= [nil nil {:a 1 :b 2}] (diff {:a 1 :b 2} {:a 1 :b 2})))
(is (= [nil nil {}] (diff {} {})))))
(deftest test-diff-maps-only-in-a
(testing "keys only in a"
(let [[a b both] (diff {:a 1 :b 2} {:a 1})]
(is (= {:b 2} a))
(is (nil? b))
(is (= {:a 1} both)))))
(deftest test-diff-maps-only-in-b
(testing "keys only in b"
(let [[a b both] (diff {:a 1} {:a 1 :b 2})]
(is (nil? a))
(is (= {:b 2} b))
(is (= {:a 1} both)))))
(deftest test-diff-maps-different-values
(testing "same keys, different values"
(let [[a b both] (diff {:a 1 :b 2} {:a 1 :b 9})]
(is (= {:b 2} a))
(is (= {:b 9} b))
(is (= {:a 1} both)))))
(deftest test-diff-maps-nested
(testing "nested maps"
(let [[a b both] (diff {:a {:x 1 :y 2}} {:a {:x 1 :z 3}})]
(is (= {:a {:y 2}} a))
(is (= {:a {:z 3}} b))
(is (= {:a {:x 1}} both)))))
(deftest test-diff-maps-disjoint
(testing "completely disjoint maps"
(let [[a b both] (diff {:a 1} {:b 2})]
(is (= {:a 1} a))
(is (= {:b 2} b))
(is (nil? both)))))
;; ── Sets ─────────────────────────────────────────────────────────────────────
(deftest test-diff-equal-sets
(testing "equal sets"
(is (= [nil nil #{1 2 3}] (diff #{1 2 3} #{1 2 3})))
(is (= [nil nil #{}] (diff #{} #{})))))
(deftest test-diff-sets
(testing "overlapping sets"
(let [[a b both] (diff #{1 2 3} #{2 3 4})]
(is (= #{1} a))
(is (= #{4} b))
(is (= #{2 3} both)))))
(deftest test-diff-disjoint-sets
(testing "disjoint sets"
(let [[a b both] (diff #{1 2} #{3 4})]
(is (= #{1 2} a))
(is (= #{3 4} b))
(is (nil? both)))))
;; ── Vectors / Sequential ────────────────────────────────────────────────────
(deftest test-diff-equal-vectors
(testing "equal vectors"
(is (= [nil nil [1 2 3]] (diff [1 2 3] [1 2 3])))
(is (= [nil nil []] (diff [] [])))))
(deftest test-diff-vectors-same-length
(testing "same length, different elements"
(let [[a b both] (diff [1 2 3] [1 9 3])]
(is (= [nil 2] a))
(is (= [nil 9] b))
(is (= [1 nil 3] both)))))
(deftest test-diff-vectors-different-length
(testing "different lengths"
(let [[a b both] (diff [1 2 3] [1 2])]
(is (= [nil nil 3] a))
(is (nil? b))
(is (= [1 2] both)))
(let [[a b both] (diff [1] [1 2 3])]
(is (nil? a))
(is (= [nil 2 3] b))
(is (= [1] both)))))
(deftest test-diff-lists
(testing "lists treated as sequential"
(let [[a b both] (diff '(1 2 3) '(1 9 3))]
(is (= [nil 2] a))
(is (= [nil 9] b))
(is (= [1 nil 3] both)))))
;; ── Mixed types ─────────────────────────────────────────────────────────────
(deftest test-diff-mixed-types
(testing "different partition types treated as atoms"
(is (= [{:a 1} [1 2] nil] (diff {:a 1} [1 2])))
(is (= [#{1} [1] nil] (diff #{1} [1])))
(is (= [1 :a nil] (diff 1 :a)))))
;; ── Nil handling ────────────────────────────────────────────────────────────
(deftest test-diff-nil
(testing "nil vs non-nil"
(is (= [nil 1 nil] (diff nil 1)))
(is (= [1 nil nil] (diff 1 nil)))
(is (= [nil {:a 1} nil] (diff nil {:a 1})))))
;; ── Deeply nested ───────────────────────────────────────────────────────────
(deftest test-diff-deeply-nested
(testing "deeply nested structures"
(let [[a b both] (diff {:a {:b {:c 1}}} {:a {:b {:c 2}}})]
(is (= {:a {:b {:c 1}}} a))
(is (= {:a {:b {:c 2}}} b))
(is (nil? both))))
(testing "deeply nested with shared keys"
(let [[a b both] (diff {:a {:b 1 :c 2}} {:a {:b 1 :c 9}})]
(is (= {:a {:c 2}} a))
(is (= {:a {:c 9}} b))
(is (= {:a {:b 1}} both)))))

107
test/clojure-stdlib/clojure/edn_test/read_string.cljc
View file

@ -1,107 +0,0 @@
(ns clojure.edn-test.read-string
(:require [clojure.edn :as edn]
[clojure.test :refer [are deftest is testing]]))
(deftest test-read-string-scalars
(testing "nil, booleans"
(is (nil? (edn/read-string "nil")))
(is (true? (edn/read-string "true")))
(is (false? (edn/read-string "false"))))
(testing "integers"
(is (= 0 (edn/read-string "0")))
(is (= 42 (edn/read-string "42")))
(is (= -1 (edn/read-string "-1")))
(is (= 1000000000000 (edn/read-string "1000000000000"))))
(testing "floats"
(is (= 3.14 (edn/read-string "3.14")))
(is (= -0.5 (edn/read-string "-0.5")))
(is (= 1.0 (edn/read-string "1.0"))))
(testing "bigints"
(is (= 42N (edn/read-string "42N"))))
(testing "bigdecimals"
(is (= 3.14M (edn/read-string "3.14M"))))
(testing "strings"
(is (= "" (edn/read-string "\"\"")))
(is (= "hello" (edn/read-string "\"hello\"")))
(is (= "line1\nline2" (edn/read-string "\"line1\\nline2\"")))
(is (= "tab\there" (edn/read-string "\"tab\\there\""))))
(testing "characters"
(is (= \a (edn/read-string "\\a")))
(is (= \newline (edn/read-string "\\newline")))
(is (= \space (edn/read-string "\\space")))
(is (= \tab (edn/read-string "\\tab"))))
(testing "keywords"
(is (= :foo (edn/read-string ":foo")))
(is (= :bar/baz (edn/read-string ":bar/baz"))))
(testing "symbols"
(is (= 'foo (edn/read-string "foo")))
(is (= 'bar/baz (edn/read-string "bar/baz")))))
(deftest test-read-string-collections
(testing "vectors"
(is (= [] (edn/read-string "[]")))
(is (= [1 2 3] (edn/read-string "[1 2 3]")))
(is (= [1 [2 3] 4] (edn/read-string "[1 [2 3] 4]"))))
(testing "lists"
(is (= '() (edn/read-string "()")))
(is (= '(1 2 3) (edn/read-string "(1 2 3)")))
(is (= '(+ 1 2) (edn/read-string "(+ 1 2)"))))
(testing "maps"
(is (= {} (edn/read-string "{}")))
(is (= {:a 1} (edn/read-string "{:a 1}")))
(is (= {:a 1 :b 2} (edn/read-string "{:a 1 :b 2}")))
(is (= {:nested {:deep true}} (edn/read-string "{:nested {:deep true}}"))))
(testing "sets"
(is (= #{} (edn/read-string "#{}")))
(is (= #{1 2 3} (edn/read-string "#{1 2 3}"))))
(testing "mixed nested"
(is (= {:users [{:name "Alice" :age 30}
{:name "Bob" :age 25}]}
(edn/read-string "{:users [{:name \"Alice\" :age 30} {:name \"Bob\" :age 25}]}")))))
(deftest test-read-string-tagged-literals
(testing "#uuid"
(let [u (edn/read-string "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\"")]
(is (uuid? u))
(is (= u (edn/read-string "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\""))))))
(deftest test-read-string-eof
(testing "empty string with :eof option"
(is (= :eof (edn/read-string {:eof :eof} "")))
(is (= nil (edn/read-string {:eof nil} "")))
(is (= 42 (edn/read-string {:eof 42} ""))))
(testing "whitespace-only with :eof option"
(is (= :done (edn/read-string {:eof :done} " "))))
(testing "nil input returns nil"
(is (nil? (edn/read-string nil)))))
(deftest test-read-string-comments
(testing "comments are skipped"
(is (= 42 (edn/read-string "; this is a comment\n42"))))
(testing "discard reader macro"
(is (= 2 (edn/read-string "#_ 1 2")))))
(deftest test-read-string-only-first-form
(testing "reads only the first form"
(is (= 1 (edn/read-string "1 2 3")))
(is (= :a (edn/read-string ":a :b :c")))))
(deftest test-read-string-ratios
(testing "ratios"
(is (= 1/2 (edn/read-string "1/2")))
(is (= 3/4 (edn/read-string "3/4")))))

101
test/clojure-stdlib/clojure/walk_test/walk.cljc
View file

@ -1,101 +0,0 @@
(ns clojure.walk-test.walk
(:require [clojure.test :refer [deftest is testing]]
[clojure.walk :as w]))
(deftest test-walk
(testing "walk with identity"
(is (= [1 2 3] (w/walk identity identity [1 2 3])))
(is (= '(1 2 3) (w/walk identity identity '(1 2 3))))
(is (= #{1 2 3} (w/walk identity identity #{1 2 3}))))
(testing "walk with inner transform"
(is (= [2 3 4] (w/walk inc identity [1 2 3])))
(is (= [2 3 4] (w/walk inc vec [1 2 3]))))
(testing "walk with outer transform"
(is (= [1 2 3] (w/walk identity vec '(1 2 3))))))
(deftest test-postwalk
(testing "postwalk with numbers"
(is (= [2 3 4] (w/postwalk #(if (number? %) (inc %) %) [1 2 3]))))
(testing "postwalk with nested structures"
(is (= [2 [3 4] 5]
(w/postwalk #(if (number? %) (inc %) %) [1 [2 3] 4]))))
(testing "postwalk preserves types"
(is (vector? (w/postwalk identity [1 2 3])))
(is (list? (w/postwalk identity '(1 2 3))))
(is (set? (w/postwalk identity #{1 2 3})))
(is (map? (w/postwalk identity {:a 1 :b 2}))))
(testing "postwalk on maps"
(is (= {:a 2 :b 3}
(w/postwalk #(if (number? %) (inc %) %) {:a 1 :b 2}))))
(testing "postwalk on empty collections"
(is (= [] (w/postwalk identity [])))
(is (= {} (w/postwalk identity {})))
(is (= #{} (w/postwalk identity #{})))
(is (= '() (w/postwalk identity '())))))
(deftest test-prewalk
(testing "prewalk with numbers"
(is (= [2 3 4] (w/prewalk #(if (number? %) (inc %) %) [1 2 3]))))
(testing "prewalk with nested structures"
(is (= [2 [3 4] 5]
(w/prewalk #(if (number? %) (inc %) %) [1 [2 3] 4]))))
(testing "prewalk transforms before descending"
;; prewalk applies f to the outer form first, so we can replace
;; entire subtrees before they are walked
(is (= [:replaced]
(w/prewalk #(if (= % [1 2 3]) [:replaced] %) [1 2 3])))))
(deftest test-keywordize-keys
(testing "basic keywordize"
(is (= {:a 1 :b 2} (w/keywordize-keys {"a" 1 "b" 2}))))
(testing "nested keywordize"
(is (= {:a {:b 2}} (w/keywordize-keys {"a" {"b" 2}}))))
(testing "non-string keys unchanged"
(is (= {:a 1 42 2} (w/keywordize-keys {"a" 1 42 2}))))
(testing "already keyword keys unchanged"
(is (= {:a 1} (w/keywordize-keys {:a 1})))))
(deftest test-stringify-keys
(testing "basic stringify"
(is (= {"a" 1 "b" 2} (w/stringify-keys {:a 1 :b 2}))))
(testing "nested stringify"
(is (= {"a" {"b" 2}} (w/stringify-keys {:a {:b 2}}))))
(testing "non-keyword keys unchanged"
(is (= {"a" 1 42 2} (w/stringify-keys {:a 1 42 2})))))
(deftest test-postwalk-replace
(testing "basic replacement"
(is (= [:x :y :c] (w/postwalk-replace {:a :x :b :y} [:a :b :c]))))
(testing "nested replacement"
(is (= [:x [:y :c]] (w/postwalk-replace {:a :x :b :y} [:a [:b :c]]))))
(testing "no matches"
(is (= [1 2 3] (w/postwalk-replace {:a :x} [1 2 3]))))
(testing "empty smap"
(is (= [1 2 3] (w/postwalk-replace {} [1 2 3])))))
(deftest test-prewalk-replace
(testing "basic replacement"
(is (= [:x :y :c] (w/prewalk-replace {:a :x :b :y} [:a :b :c]))))
(testing "nested replacement"
(is (= [:x [:y :c]] (w/prewalk-replace {:a :x :b :y} [:a [:b :c]]))))
(testing "replaces before descending"
;; prewalk-replace replaces the whole form first, then walks children
(is (= :replaced (w/prewalk-replace {[:a :b] :replaced} [:a :b])))))

122
test/clojure-stdlib/clojure/zip_test/zip.cljc
View file

@ -1,122 +0,0 @@
(ns clojure.zip-test.zip
(:require [clojure.test :refer [deftest is testing run-tests]]
[clojure.zip :as zip]))
(deftest test-vector-zip-navigation
(let [data [[1 2] [3 [4 5]]]
z (zip/vector-zip data)]
(testing "root node"
(is (= (zip/node z) [[1 2] [3 [4 5]]]))
(is (zip/branch? z)))
(testing "down"
(is (= (zip/node (zip/down z)) [1 2])))
(testing "right"
(is (= (zip/node (zip/right (zip/down z))) [3 [4 5]])))
(testing "down into nested"
(is (= (zip/node (zip/down (zip/right (zip/down z)))) 3)))
(testing "up returns parent"
(is (= (zip/node (zip/up (zip/down z))) [[1 2] [3 [4 5]]])))
(testing "rights"
(is (= (zip/rights (zip/down z)) '([3 [4 5]]))))
(testing "lefts"
(is (= (zip/lefts (zip/right (zip/down z))) [[1 2]])))))
(deftest test-vector-zip-rightmost-leftmost
(let [z (zip/vector-zip [1 2 3])]
(testing "rightmost"
(is (= (zip/node (zip/rightmost (zip/down z))) 3)))
(testing "leftmost"
(is (= (zip/node (zip/leftmost (zip/rightmost (zip/down z)))) 1)))))
(deftest test-seq-zip-navigation
(let [z (zip/seq-zip '(1 (2 3) 4))]
(testing "root"
(is (= (zip/node z) '(1 (2 3) 4))))
(testing "down"
(is (= (zip/node (zip/down z)) 1)))
(testing "right"
(is (= (zip/node (zip/right (zip/down z))) '(2 3))))
(testing "down into nested list"
(is (= (zip/node (zip/down (zip/right (zip/down z)))) 2)))))
(deftest test-path
(let [z (zip/vector-zip [[1 2] [3 4]])]
(testing "path at root is nil"
(is (nil? (zip/path z))))
(testing "path one level down"
(is (= (zip/path (zip/down z)) [[[1 2] [3 4]]])))
(testing "path two levels down"
(is (= (zip/path (zip/down (zip/down z)))
[[[1 2] [3 4]] [1 2]])))))
(deftest test-edit
(let [z (zip/vector-zip [1 [2 3] [4 5]])]
(testing "edit a leaf"
(let [loc (-> z zip/down zip/right zip/down)
edited (zip/edit loc inc)]
(is (= (zip/root edited) [1 [3 3] [4 5]]))))
(testing "edit a branch"
(let [loc (-> z zip/down zip/right)
edited (zip/edit loc (fn [x] (vec (map inc x))))]
(is (= (zip/root edited) [1 [3 4] [4 5]]))))))
(deftest test-replace
(let [z (zip/vector-zip '[a b c])]
(is (= (zip/root (zip/replace (zip/down z) 'x))
'[x b c]))))
(deftest test-insert-left-right
(let [z (zip/vector-zip [1 2 3])
loc (-> z zip/down zip/right)]
(testing "insert-left"
(is (= (zip/root (zip/insert-left loc 'x)) [1 'x 2 3])))
(testing "insert-right"
(is (= (zip/root (zip/insert-right loc 'y)) [1 2 'y 3])))))
(deftest test-insert-child-append-child
(let [z (zip/vector-zip [1 2 3])]
(testing "insert-child"
(is (= (zip/root (zip/insert-child z 0)) [0 1 2 3])))
(testing "append-child"
(is (= (zip/root (zip/append-child z 4)) [1 2 3 4])))))
(deftest test-remove
(let [z (zip/vector-zip [1 2 3])
loc (-> z zip/down zip/right)]
(is (= (zip/root (zip/remove loc)) [1 3]))))
(deftest test-next-traversal
(let [z (zip/vector-zip [1 [2 3]])]
(testing "next enumerates depth-first"
(is (= (loop [loc z, acc []]
(if (zip/end? loc)
acc
(recur (zip/next loc) (conj acc (zip/node loc)))))
[[1 [2 3]] 1 [2 3] 2 3])))))
(deftest test-end?
(let [z (zip/vector-zip [1 2])]
(testing "not end at start"
(is (not (zip/end? z))))
(testing "end after full traversal"
(is (zip/end? (-> z zip/next zip/next zip/next))))))
(deftest test-prev
(let [z (zip/vector-zip [1 [2 3]])]
(testing "prev from second child"
(let [loc (-> z zip/next zip/next)]
(is (= (zip/node loc) [2 3]))
(is (= (zip/node (zip/prev loc)) 1))))
(testing "prev from leaf inside nested"
(let [loc (-> z zip/next zip/next zip/next)]
(is (= (zip/node loc) 2))
(is (= (zip/node (zip/prev loc)) [2 3]))))))
(deftest test-root-after-edits
(testing "root unwinds all the way after deep edits"
(let [z (zip/vector-zip [[1 2] [3 [4 5]]])
loc (-> z zip/down zip/right zip/down zip/right zip/down)
edited (zip/edit loc inc)]
(is (= (zip/root edited) [[1 2] [3 [5 5]]])))))
(run-tests)

42
test/conformance/certify-test.janet
View file

@ -1,42 +0,0 @@
# Conformance inc1 (jolt-xsfe) — gate wrapper for the JVM corpus certifier.
#
# test/conformance/certify.clj evaluates every test/chez/corpus.edn row through
# reference JVM Clojure and checks jolt's hand-written :expected against what real
# Clojure produces. Divergences are classified in test/conformance/known-divergences.edn
# (deliberate jolt-specific / host-model deltas + tracked bugs); the certifier exits
# nonzero only on a NEW (unclassified) divergence or a stale allowlist entry.
#
# This wrapper runs it in the Janet gate and skips cleanly when `clojure` (JVM) is
# not installed — same pattern as the chez tests skipping without `chez`.
#
# janet test/conformance/certify-test.janet
(defn- have-clojure? []
(def p (try (os/spawn ["clojure" "--version"] :p {:out :pipe :err :pipe}) ([_] nil)))
(if (nil? p) false
(do (def out (ev/read (p :out) :all)) (def err (ev/read (p :err) :all))
(zero? (os/proc-wait p)))))
(unless (have-clojure?)
(print "clojure (JVM) not on PATH — skipping corpus certification")
(os/exit 0))
(def proc (os/spawn ["clojure" "-M" "test/conformance/certify.clj"] :p {:out :pipe :err :pipe}))
(def out (string (ev/read (proc :out) :all)))
(def err (string (or (ev/read (proc :err) :all) "")))
(def code (os/proc-wait proc))
# Echo the summary lines so the gate log shows the certification status.
(each line (string/split "\n" out)
(when (or (string/find "certif" line) (string/find "allowlist" line)
(string/find "NEW" line) (string/find "STALE" line) (string/find "DIVERGENT" line))
(print line)))
(when (not= code 0)
(eprint "corpus certification FAILED (new/stale divergence vs reference Clojure):")
(eprint out)
(unless (= "" err) (eprint err))
(os/exit 1))
(print "corpus certification: OK (all divergences classified)")
(os/exit 0)

30
test/fixtures/cgen-build/cgapp.clj vendored
View file

@ -1,30 +0,0 @@
;; Fixture app for the cgen single-binary build test (jolt-a7ds).
;; count-point is a numeric leaf -> compiled to native C and statically linked;
;; run/-main stay bytecode and call into it. -main prints a deterministic total.
(ns cgapp)
(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))))
(defn -main [& args]
(let [n (if (seq args) (Integer/parseInt (first args)) 200)]
(println (run n))))

43
test/integration/aot-test.janet
View file

@ -1,43 +0,0 @@
# AOT image round-trip: compile a namespace, marshal it to bytecode, load it into
# a FRESH context, and run the loaded functions without recompiling.
(use ../../src/jolt/api)
(use ../../src/jolt/aot)
(use ../../src/jolt/types)
(print "AOT image round-trip...")
(def img-path (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-aot-test.jimg"))
# 1. Compile a namespace into ctx1: a constant, a fn over it, a fn using core
# fns, and a recursive fn.
(def ctx1 (init {:compile? true}))
(ctx-set-current-ns ctx1 "demo")
(eval-string ctx1 "(def base 100)")
(eval-string ctx1 "(defn add-base [x] (+ x base))")
(eval-string ctx1 "(defn sum-sq [xs] (reduce + (map (fn [x] (* x x)) xs)))")
(eval-string ctx1 "(defn fact [n] (if (zero? n) 1 (* n (fact (dec n)))))")
(assert (= 107 (eval-string ctx1 "(add-base 7)")) "ctx1 add-base")
(assert (= 14 (eval-string ctx1 "(sum-sq [1 2 3])")) "ctx1 sum-sq")
(assert (= 120 (eval-string ctx1 "(fact 5)")) "ctx1 fact")
# 2. Save an AOT image of the compiled namespace.
(save-ns ctx1 "demo" img-path)
(assert (os/stat img-path) "image written")
# 3. Load it into a brand-new context — no recompilation of demo.
(def ctx2 (init {:compile? true}))
(load-ns-image ctx2 "demo" img-path)
(ctx-set-current-ns ctx2 "demo")
(assert (= 107 (eval-string ctx2 "(add-base 7)")) "ctx2 add-base from image")
(assert (= 14 (eval-string ctx2 "(sum-sq [1 2 3])")) "ctx2 sum-sq from image")
(assert (= 3628800 (eval-string ctx2 "(fact 10)")) "ctx2 fact from image (new arg)")
# 4. The loaded vars are live: redefining one is visible to callers compiled in
# ctx2 that reference it.
(eval-string ctx2 "(def base 1000)")
(assert (= 1007 (eval-string ctx2 "(add-base 7)")) "loaded var still redefinable")
(os/rm img-path)
(print "AOT round-trip passed!")

38
test/integration/api-test.janet
View file

@ -1,38 +0,0 @@
(use ../../src/jolt/api)
(use ../../src/jolt/types)
(print "1: init creates context...")
(let [ctx (init-cached)]
(assert (ctx? ctx) "init returns context")
(let [ns (ctx-find-ns ctx "clojure.core")]
(assert (ns? ns) "clojure.core namespace exists")
(assert (ns-find ns "nil?") "nil? is interned")
(assert (ns-find ns "+") "+ is interned")))
(print " passed")
(print "2: eval-string basics...")
(let [ctx (init-cached)]
(assert (= 42 (eval-string ctx "42")) "eval integer")
(assert (= true (eval-string ctx "true")) "eval bool")
(assert (= 3 (eval-string ctx "(+ 1 2)")) "eval list"))
(print " passed")
(print "3: eval-string with core fns...")
(let [ctx (init-cached)]
(assert (= true (eval-string ctx "(nil? nil)")) "nil?")
(assert (deep= [2 3 4] (normalize-pvecs (eval-string ctx "(map inc [1 2 3])"))) "map+inc")
(assert (= 6 (eval-string ctx "(reduce + [1 2 3])")) "reduce"))
(print " passed")
(print "4: eval-string with def...")
(let [ctx (init-cached)]
(eval-string ctx "(def x 42)")
(assert (= 42 (eval-string ctx "x")) "def then resolve"))
(print " passed")
(print "5: eval-string* with bindings...")
(let [ctx (init-cached)]
(assert (= 99 (eval-string* ctx "y" @{"y" 99})) "bound variable"))
(print " passed")
(print "\nAll API tests passed!")

67
test/integration/app-scope-wholeprogram-test.janet
View file

@ -1,67 +0,0 @@
# Whole-program inference scoped to app namespaces (jolt-87e).
#
# Auto-whole-program (a -m program run under direct-link) used to defer EVERY
# loaded namespace — including every transitive dependency — into one closed-
# world fixpoint, which is prohibitive on dep-heavy apps (hundreds of dep nses;
# a ~2-minute cold start on malli). With app source roots declared (JOLT_APP_PATHS
# / jolt-deps, here :app-paths), only the app's OWN namespaces join the whole-
# program batch; dependency namespaces skip inference (they stay direct-linked
# but generically typed — the open-world default). With NO app roots declared,
# every namespace is treated as app (whole-program over everything, pre-87e).
(use ../../src/jolt/api)
(var failures 0)
(defn- check [label got want]
(unless (= got want)
(++ failures)
(printf "FAIL [%s] got %q want %q" label got want)))
# Lay down an app root and a dep root under a tmp dir.
(def tmp (string (os/getenv "TMPDIR") "jolt-87e-" (os/time)))
(def app-root (string tmp "/app"))
(def dep-root (string tmp "/dep"))
(os/mkdir tmp) (os/mkdir app-root) (os/mkdir dep-root)
(spit (string dep-root "/mydep.clj")
"(ns mydep)\n(defn helper [x] (+ x 1))\n")
(spit (string app-root "/myapp.clj")
"(ns myapp (:require [mydep]))\n(defn run [x] (mydep/helper x))\n")
(defn- with-wp [f]
(def saved (os/getenv "JOLT_WHOLE_PROGRAM"))
(os/setenv "JOLT_WHOLE_PROGRAM" "1")
(defer (os/setenv "JOLT_WHOLE_PROGRAM" saved) (f)))
# --- app roots declared: only the app ns defers into the batch ---------------
(with-wp
(fn []
(let [ctx (init {:compile? true :direct-linking? true
:paths [app-root dep-root] :app-paths [app-root]})]
(check "whole-program is on" (truthy? (get (ctx :env) :whole-program?)) true)
(eval-string ctx "(require '[myapp])")
(let [deferred (or (get (ctx :env) :inferred-nses) @[])]
(check "app ns deferred to batch" (truthy? (index-of "myapp" deferred)) true)
(check "dep ns NOT in batch (per-ns inferred)"
(truthy? (index-of "mydep" deferred)) false))
# still runs correctly after the (scoped) whole-program pass
(when-let [ip (get (ctx :env) :infer-program!)] (protect (ip ctx)))
(check "scoped whole-program program still correct"
(eval-string ctx "(myapp/run 41)") 42))))
# --- no app roots declared: every ns defers (pre-87e whole-program) ----------
(with-wp
(fn []
(let [ctx (init {:compile? true :direct-linking? true
:paths [app-root dep-root]})]
(eval-string ctx "(require '[myapp])")
(let [deferred (or (get (ctx :env) :inferred-nses) @[])]
(check "no app roots: app ns deferred" (truthy? (index-of "myapp" deferred)) true)
(check "no app roots: dep ns ALSO deferred"
(truthy? (index-of "mydep" deferred)) true))
(when-let [ip (get (ctx :env) :infer-program!)] (protect (ip ctx)))
(check "unscoped whole-program still correct"
(eval-string ctx "(myapp/run 9)") 10))))
(if (pos? failures)
(do (printf "app-scope-wholeprogram: %d failure(s)" failures) (os/exit 1))
(print "app-scope-wholeprogram: all cases passed"))

81
test/integration/bootstrap-fixpoint-test.janet
View file

@ -1,81 +0,0 @@
# Bootstrap fixpoint (jolt-d0r).
#
# Soundness gate for self-hosting: the self-hosted compiler, rebuilt by compiling
# its OWN source through itself (stage2), must behave identically to the compiler
# built by the Janet bootstrap (stage1). We test this BEHAVIORALLY — run a corpus
# of programs through each stage and compare results — rather than by comparing
# emitted code, because emitted forms embed live setter/getter closures and the IR
# carries representation-level gensyms; behavioral parity is the property that
# actually matters and is representation-independent.
#
# stage1 = analyzer as built by the bootstrap.
# stage2 = analyzer rebuilt by compiling jolt.ir + jolt.analyzer through stage1
# (self-host, the fractal turn) and installing the result over itself.
# stage3 = the same self-rebuild applied again, on top of stage2.
# All three must produce identical results on the corpus.
(use ../../src/jolt/types)
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(import ../../src/jolt/backend :as be)
(import ../../src/jolt/stdlib_embed :as se)
(defn- forms [src]
(var s src) (def fs @[])
(while (> (length (string/trim s)) 0)
(def p (parse-next s)) (set s (p 1))
(when (p 0) (array/push fs (p 0))))
fs)
# Programs exercising the compiled constructs (fn/multi-arity/recur/loop/if/let/
# map+vector literals/closures/higher-order/protocol dispatch). Each is a single
# expression evaluated through the compile pipeline; we compare printed results.
(def corpus
["(let [f (fn [x] (* x x))] (map f [1 2 3 4]))"
"(loop [i 0 acc 0] (if (< i 10) (recur (inc i) (+ acc i)) acc))"
"((fn fact [n] (if (zero? n) 1 (* n (fact (dec n))))) 6)"
"(reduce + 0 (filter even? (range 20)))"
"(let [[a b & r] [1 2 3 4 5]] [a b r])"
"(mapv (juxt identity inc dec) [10 20])"
"(frequencies (concat [:a :a] [:b]))"
"(group-by odd? (range 8))"
"(get-in {:a {:b {:c 42}}} [:a :b :c])"
"(first {:x 1})"
"(into {} (map (fn [k] [k (* k k)]) (range 5)))"
"((comp inc inc) 10)"
"(apply max [3 1 4 1 5 9 2 6])"
"(str (reverse \"hello\") (count [1 2 3]))"
"(let [m {:a 1}] (assoc m :b (+ (:a m) 1)))"])
(defn- run-corpus [ctx]
(map (fn [p] (def r (protect (eval-string ctx p)))
(if (r 0) (string/format "%j" (normalize-pvecs (r 1))) (string "ERR:" (r 1))))
corpus))
# Rebuild the analyzer through the self-hosted pipeline, in place.
(defn- self-rebuild! [ctx]
(def saved (ctx-current-ns ctx))
(each nsn ["jolt.ir" "jolt.analyzer"]
(ctx-set-current-ns ctx nsn)
(each f (forms (get se/sources nsn)) (protect (be/compile-and-eval ctx f))))
(ctx-set-current-ns ctx saved))
(def ctx (init {:compile? true}))
(def r1 (run-corpus ctx)) # stage1 (bootstrap-built)
(self-rebuild! ctx)
(def r2 (run-corpus ctx)) # stage2 (self-built)
(self-rebuild! ctx)
(def r3 (run-corpus ctx)) # stage3 (self-built from stage2)
(var failures 0)
(for i 0 (length corpus)
(unless (and (= (r1 i) (r2 i)) (= (r2 i) (r3 i)))
(++ failures)
(printf "FAIL [%s]\n stage1=%s\n stage2=%s\n stage3=%s" (corpus i) (r1 i) (r2 i) (r3 i)))
# also guard against everything silently erroring
(when (string/has-prefix? "ERR:" (r1 i))
(++ failures) (printf "FAIL [%s] stage1 errored: %s" (corpus i) (r1 i))))
(if (pos? failures)
(do (printf "bootstrap-fixpoint: %d failure(s)" failures) (os/exit 1))
(printf "bootstrap-fixpoint: stage1 == stage2 == stage3 on %d programs\n" (length corpus)))

60
test/integration/cap-record-type-test.janet
View file

@ -1,60 +0,0 @@
# A record type keeps its :type tag through depth-capping (jolt-3ko follow-up).
# cap (jolt.passes.types) truncates a deep type's field VALUES to :any so the
# inter-procedural fixpoint stays finite, but the record :type tag is identity,
# independent of field depth — so it must survive. Before this fix cap rebuilt
# the struct via mk-struct and dropped :type, degrading a record stored in a
# deep container to a plain struct: devirtualization (jolt-41m) and record?
# folding silently stopped firing on it. This drives whole-program inference
# over a vector-of-records and asserts (a) the element keeps REC identity and
# (b) a protocol call on an element devirtualizes (the inference annotates the
# call node with :devirt-type, which it can't do without the receiver's :type).
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/types :as types)
(print "Record :type survives capping (jolt-3ko)...")
(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-cap-rec"))
(os/mkdir dir)
(spit (string dir "/cr.clj")
(string
"(ns cr)\n"
"(defrecord V3 [r g b])\n" # nested record -> forces a deep type
"(defprotocol Shape (area [s]))\n"
"(defrecord Box [^V3 lo ^V3 hi]\n"
" Shape\n"
" (area [s] (+ (:r (:hi s)) (:r (:lo s)))))\n"
"(defn total [coll] (reduce (fn [acc x] (+ acc (area x))) 0.0 coll))\n"
"(defn drive [n]\n"
" (let [world [(->Box (->V3 1.0 2.0 3.0) (->V3 4.0 5.0 6.0))\n"
" (->Box (->V3 0.0 0.0 0.0) (->V3 2.0 2.0 2.0))]]\n"
" (loop [i 0 acc 0.0] (if (< i n) (recur (inc i) (+ acc (total world))) acc))))\n"))
(os/setenv "JOLT_DIRECT_LINK" "1")
(os/setenv "JOLT_WHOLE_PROGRAM" "1")
(os/setenv "JOLT_PATH" dir)
(def ctx (api/init {:compile? true}))
(api/eval-string ctx "(require '[cr])")
(def report (backend/infer-program! ctx))
# (a) total's collection param keeps its record element identity through cap
(def coll-t (get (get report "cr/total") 0))
(def elem-t (and coll-t (get coll-t :vec)))
(assert (and elem-t (= "cr.Box" (get elem-t :type)))
(string "vec element keeps record :type through cap (got " (string/format "%p" elem-t) ")"))
# (b) the protocol call on an element devirtualizes — the inference can only
# annotate :devirt-type when it knows the receiver's record :type.
(def pns (types/ctx-find-ns ctx "jolt.passes"))
(def reinfer (types/var-get (types/ns-find pns "reinfer-def")))
(def cell (get ((types/ctx-find-ns ctx "cr") :mappings) "total"))
(def reinferred (string/format "%p" (reinfer (get cell :infer-ir) @{"coll" coll-t})))
(assert (not (nil? (string/find ":devirt-type" reinferred)))
"protocol call on a collection-read record devirtualizes (:devirt-type present)")
# correctness: the program still computes the right answer
(assert (= 5.0
(api/eval-string ctx "(cr/total [(cr/->Box (cr/->V3 1.0 0 0) (cr/->V3 4.0 0 0)) (cr/->Box (cr/->V3 0 0 0) (cr/->V3 0 0 0))])"))
"devirtualized record-in-collection computes correctly")
(print "Record :type survives capping (jolt-3ko) passed!")

59
test/integration/cgen-aot-test.janet
View file

@ -1,59 +0,0 @@
# Native codegen AOT build/deploy (jolt-a7ds): compile an app's numeric-leaf fns
# into ONE native module at build time, then deploy with NO cc — load the
# prebuilt module and install the cfunctions as var roots. Proves the build-time
# path that removes the runtime-toolchain dependency. Skips where cc/janet.h are
# absent.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/cgen :as cgen)
(print "Native codegen AOT build/deploy (jolt-a7ds)...")
(var failures 0)
(defn check [label ok] (unless ok (++ failures) (eprintf " FAIL: %s" label)))
(def cp-src "(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)))))")
(def run-src "(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))))")
(if (cgen/toolchain-available?)
(do
# --- build phase: collect numeric-leaf fns, compile one module, write manifest
(def bctx (api/init-cached {:compile? true}))
(put (bctx :env) :direct-linking? true)
(put (bctx :env) :cgen-collect? true)
(api/eval-string bctx "(ns aot)")
(api/eval-string bctx cp-src)
(api/eval-string bctx run-src)
(def collected (get (bctx :env) :cgen-collected))
(check "collected exactly the numeric-leaf fn (count-point, not run)"
(and collected (= 1 (length collected))
(= "count-point" ((first collected) :name))))
(def manifest-path (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-aot-test.jdn"))
(def build (cgen/aot-build collected {:dir "build/cgen-aot-test"}))
(check "aot-build produced a module" (and build (build :sopath)))
(cgen/write-manifest manifest-path build)
# --- deploy phase: fresh ctx, load prebuilt (NO cc), install roots, run
(def dctx (api/init-cached {:compile? true}))
(put (dctx :env) :direct-linking? true)
(def prebuilt (cgen/load-aot manifest-path))
(check "load-aot maps the qname to a cfunction"
(cfunction? (get prebuilt "aot/count-point")))
(put (dctx :env) :cgen-prebuilt prebuilt)
(api/eval-string dctx "(ns aot)")
(api/eval-string dctx cp-src)
(api/eval-string dctx run-src)
(check "deployed count-point root is the prebuilt cfunction"
(cfunction? (api/eval-string dctx "count-point")))
(check "deployed run stays bytecode" (not (cfunction? (api/eval-string dctx "run"))))
(check "AOT-deployed mandelbrot computes the right total"
(= 3288753 (api/eval-string dctx "(run 200)")))
# a fn NOT in the manifest must stay bytecode in deploy
(api/eval-string dctx "(defn sq [x] (* x x))")
(check "unlisted numeric-leaf stays bytecode in deploy (no cc)"
(not (cfunction? (api/eval-string dctx "sq")))))
(print " (toolchain absent — skipping AOT legs)"))
(if (= 0 failures)
(print "All tests passed.")
(do (eprintf "%d cgen-aot check(s) failed" failures) (os/exit 1)))

51
test/integration/cgen-build-test.janet
View file

@ -1,51 +0,0 @@
# Single-binary native build (jolt-a7ds): `jolt cgen-build` fuses an app's hot
# numeric-leaf fns (compiled to C) + the app source into ONE static executable —
# no sidecar .so, no toolchain on the target. This test builds the fixture app to
# a binary, runs it from a CLEAN dir (no src/, no cg.so) to prove it's
# self-contained, and checks the result + native fn count. Skips with no cc.
(import ../../src/jolt/cgen :as cgen)
(import ../../src/jolt/cgen_build :as cb)
(print "Single-binary native build (jolt-a7ds)...")
(var failures 0)
(defn check [label ok] (if ok (print " ok: " label) (do (++ failures) (eprintf " FAIL: %s" label))))
(def home (os/cwd)) # the repo (gate runs here)
(def fixture-root (string home "/test/fixtures/cgen-build"))
(if (cgen/toolchain-available?)
(do
(def out (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-cgen-build-test/app"))
(def r (cb/build-app {:main "cgapp" :out out :jolt-home home
:source-roots [fixture-root]}))
(check "build reported the single native leaf (count-point)" (= 1 (r :native-count)))
(check "binary exists at :out" (os/stat out))
# Run from a CLEAN dir with NO src/ and NO cg.so beside it — proves the binary
# is self-contained (runtime needs neither the jolt tree nor a sidecar .so).
(def rundir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-cgen-build-run"))
(when (os/stat rundir) (each e (os/dir rundir) (os/rm (string rundir "/" e))) (os/rmdir rundir))
(os/mkdir rundir)
(def bin (string rundir "/app"))
(spit bin (slurp out))
(os/chmod bin 8r755)
(defn run-app [&opt n]
(def tmp (string rundir "/out.txt"))
(def f (file/open tmp :w))
(def code (os/execute (if n [bin (string n)] [bin]) :px {:out f} ))
(file/close f)
{:code code :out (string/trim (slurp tmp))})
(def res (run-app))
(check "exits 0" (= 0 (res :code)))
(check "self-contained binary computes the right mandelbrot total (n=200)"
(= "3288753" (res :out)))
(check "passes through command-line args (n=400)"
(= "13162060" ((run-app 400) :out))))
(print " (toolchain absent — skipping single-binary build)"))
(if (= 0 failures)
(print "All tests passed.")
(do (eprintf "%d cgen-build check(s) failed" failures) (os/exit 1)))

47
test/integration/cgen-pipeline-test.janet
View file

@ -1,47 +0,0 @@
# Native codegen pipeline integration (jolt-ihdp): under :cgen?, a defn of a
# numeric-leaf fn is compiled to C and the cfunction installed as the var root,
# so direct-linked callers run native code. Pins (1) the root becomes a
# cfunction, (2) non-leaf / redefable defns stay bytecode, (3) results match.
# Skips the native legs where the C toolchain (cc + janet.h) is absent.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/cgen :as cgen)
(print "Native codegen pipeline (jolt-ihdp)...")
(var failures 0)
(defn check [label ok] (unless ok (++ failures) (eprintf " FAIL: %s" label)))
(defn callable? [x] (or (function? x) (cfunction? x)))
(def ctx (api/init-cached {:compile? true}))
(put (ctx :env) :direct-linking? true)
(put (ctx :env) :inline? true)
(put (ctx :env) :cgen? true)
(api/eval-string ctx "(ns cgp)")
(if (cgen/toolchain-available?)
(do
# numeric-leaf fn -> native root
(api/eval-string ctx "(defn sq [x] (* x x))")
(check "numeric-leaf root is a cfunction" (cfunction? (api/eval-string ctx "sq")))
(check "native sq computes correctly" (= 49 (api/eval-string ctx "(sq 7)")))
# non-leaf fn -> stays bytecode (NOT a cfunction)
(api/eval-string ctx "(defn g [x] (str x))")
(check "non-leaf root stays bytecode" (not (cfunction? (api/eval-string ctx "g"))))
(check "g still works" (= "5" (api/eval-string ctx "(g 5)")))
# ^:redef stays bytecode even though numeric-leaf
(api/eval-string ctx "(defn ^:redef rsq [x] (* x x))")
(check "redefable numeric-leaf stays bytecode" (not (cfunction? (api/eval-string ctx "rsq"))))
# end-to-end: count-point native, run bytecode calling it; grid total matches
(api/eval-string ctx "(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)))))")
(check "count-point root is native" (cfunction? (api/eval-string ctx "count-point")))
(api/eval-string ctx "(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))))")
(check "run stays bytecode (calls a user fn)" (not (cfunction? (api/eval-string ctx "run"))))
(check "native count-point gives the right grid total" (= 3288753 (api/eval-string ctx "(run 200)"))))
(print " (toolchain absent — skipping native pipeline legs)"))
(if (= 0 failures)
(print "All tests passed.")
(do (eprintf "%d cgen-pipeline check(s) failed" failures) (os/exit 1)))

86
test/integration/cgen-test.janet
View file

@ -1,86 +0,0 @@
# Native codegen (jolt-ihdp): IR -> C for numeric-leaf fns. Pins that the C
# translator (1) classifies candidates correctly and (2) produces a native fn
# whose results match the bytecode/interpreted fn over the mandelbrot grid.
# Skips cleanly where the C toolchain (cc + janet.h) is absent — the rest of the
# gate still runs.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as reader)
(import ../../src/jolt/cgen :as cgen)
(print "Native codegen IR->C (jolt-ihdp)...")
(def ctx (api/init-cached {:compile? true}))
(put (ctx :env) :direct-linking? true)
(put (ctx :env) :inline? true)
(api/eval-string ctx "(ns cgentest)")
(defn ir-of [src] (backend/analyze-form ctx (reader/parse-string src)))
(def count-point-src
"(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)))))")
(var failures 0)
(defn check [label ok] (unless ok (++ failures) (eprintf " FAIL: %s" label)))
# --- classification ---
(check "count-point is a numeric leaf" (cgen/numeric-leaf? (ir-of count-point-src)))
(check "fn calling a non-native fn is NOT a leaf"
(not (cgen/numeric-leaf? (ir-of "(defn f [x] (str x))"))))
(check "fn building a collection is NOT a leaf"
(not (cgen/numeric-leaf? (ir-of "(defn f [x] [x x])"))))
(check "plain numeric expr fn IS a leaf"
(cgen/numeric-leaf? (ir-of "(defn sq [x] (* x x))")))
# --- C generation is well-formed (smoke: contains the wrapper + a loop) ---
(def c-src (cgen/gen-c-fn (ir-of count-point-src) "count_point"))
(check "emits a cfunction wrapper" (string/find "cfun_count_point" c-src))
(check "lowers the loop to a C while" (string/find "while (" c-src))
(check "unboxes params with janet_getnumber" (string/find "janet_getnumber" c-src))
# --- behavioral equivalence (only where the toolchain is present) ---
(if (cgen/toolchain-available?)
(do
# start from a clean cache dir so the content-addressed-file count is exact
(when (os/stat "build/cgen-test")
(each f (os/dir "build/cgen-test") (os/rm (string "build/cgen-test/" f))))
(api/eval-string ctx count-point-src)
(def bc-cp (api/eval-string ctx "count-point")) # the compiled/interpreted fn
(def c-cp (cgen/compile-fn (ir-of count-point-src)
{:dir "build/cgen-test" :name "count_point_test"}))
(defn callable? [x] (or (function? x) (cfunction? x)))
(check "compile-fn returns a callable" (callable? c-cp))
(when (callable? c-cp)
# spot points spanning escape-fast .. in-set
(var ptmatch true)
(each [cr ci] [[2.0 2.0] [0.5 0.5] [-0.5 0.6] [0.28 0.0] [-0.74 0.1] [-0.5 0.0] [0.0 0.0]]
(unless (= (c-cp cr ci 200) (bc-cp cr ci 200)) (set ptmatch false)))
(check "C count-point matches bytecode on sample points" ptmatch)
# full mandelbrot grid total
(defn grid-total [cp n]
(def cap 200) (def nd (* 1.0 n)) (var acc 0) (var y 0)
(while (< y n)
(def ci (- (/ (* 2.0 y) nd) 1.0)) (var x 0) (var a 0)
(while (< x n)
(def cr (- (/ (* 2.0 x) nd) 1.5)) (set a (+ a (cp cr ci cap))) (++ x))
(set acc (+ acc a)) (++ y))
acc)
(check "C and bytecode agree on the full n=80 grid total"
(= (grid-total c-cp 80) (grid-total bc-cp 80)))
# caching: the .so is content-addressed, so a second compile of the same
# fn reuses it. Drop the generated .c (keep the .so) then recompile: a
# cache hit loads the existing .so without needing cc/source again.
(def cache-files (filter |(string/has-suffix? ".so" $) (os/dir "build/cgen-test")))
(check "produced a content-addressed .so" (= 1 (length cache-files)))
(each f (os/dir "build/cgen-test")
(when (string/has-suffix? ".c" f) (os/rm (string "build/cgen-test/" f))))
(def c-cp2 (cgen/compile-fn (ir-of count-point-src)
{:dir "build/cgen-test" :name "count_point_test"}))
(check "cache hit recompiles without the source .c"
(and (callable? c-cp2) (= (c-cp2 -0.5 0.0 200) 200)))))
(print " (toolchain absent — skipping behavioral equivalence)"))
(if (= 0 failures)
(print "All tests passed.")
(do (eprintf "%d cgen check(s) failed" failures) (os/exit 1)))

173
test/integration/cli-test.janet
View file

@ -1,173 +0,0 @@
# Smoke-test the command-line flags. Prefer the built binary (baked ctx, ~20ms
# startup); from-source is ~8s cold per invocation, and with ~20 invocations this
# file dominated the (parallel) gate's wall clock. Falls back to running
# main.janet from source when there's no binary, so an unbuilt tree still works —
# the gate (`jpm build && janet run-tests.janet`) builds first, so it's fresh.
(def- jolt-cmd
(if (os/stat "build/jolt") ["build/jolt"] ["janet" "src/jolt/main.janet"]))
(defn- run [& args]
(def p (os/spawn [;jolt-cmd ;args] :p {:out :pipe :err :pipe}))
(def out (:read (p :out) :all))
(os/proc-wait p)
(string (or out "")))
(defn- run-err [& args]
(def p (os/spawn [;jolt-cmd ;args] :p {:out :pipe :err :pipe}))
(def err (:read (p :err) :all))
(os/proc-wait p)
(string (or err "")))
(var fails 0)
(defn check [label got pred]
(if (pred got) (print " ok " label)
(do (++ fails) (printf " FAIL %s: got %q" label got))))
(defn- has [sub] (fn [s] (string/find sub s)))
(check "--version" (run "--version") (has "jolt v"))
(check "version" (run "version") (has "jolt v"))
(check "--help" (run "--help") (has "Usage"))
(check "help lists nrepl-server" (run "help") (has "nrepl-server"))
(check "-e" (run "-e" "(+ 1 2)") (has "3"))
(check "--eval" (run "--eval" "(* 6 7)") (has "42"))
# -m requires a namespace and calls its -main with the remaining args
(def tmp (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-cli-" (os/time)))
(os/mkdir tmp) (os/mkdir (string tmp "/app"))
(spit (string tmp "/app/core.clj")
"(ns app.core)\n(defn -main [& args] (println \"MAIN\" (count args)))\n")
(os/setenv "JOLT_PATH" tmp)
(check "-m calls -main with args" (run "-m" "app.core" "a" "b") (has "MAIN 2"))
(os/setenv "JOLT_PATH" nil)
(os/rm (string tmp "/app/core.clj")) (os/rmdir (string tmp "/app")) (os/rmdir tmp)
# --- user-facing error output (jolt-2o7 rounds 1+2) --------------------------
# Messages are Clojure-shaped; traces show the USER'S fns (compiled fn names
# carry ns/fn-name, demangled by report-error) and never jolt internals.
(check "arith error message rewritten"
(run-err "-e" `(+ 1 "a")`)
(has `Cannot add 1 and "a"`))
# unary arithmetic (inc/dec) on a non-number: the host error has no "or :r"
# clause, which used to crash the rewriter itself — handle it (jolt audit)
(check "unary arith error does not crash the rewriter"
(run-err "-e" `(inc "x")`)
(fn [s] (and (string/find "expects numbers" s)
(nil? (string/find "could not find method" s)))))
(check "arity error names the fn"
(run-err "-e" "(defn afn [x] x) (afn 1 2)")
(has "Wrong number of args (2) passed to: user/afn"))
(check "nil-call (nil value) keeps the hint"
(run-err "-e" "(def x nil) (x 1)")
(has "Cannot call nil as a function"))
# round 3: typos die at resolve time with Clojure's message, not as nil-calls
(check "unresolved symbol named at resolve time"
(run-err "-e" "(undefined-fn 1)")
(has "Unable to resolve symbol: undefined-fn in this context"))
(check "typo inside fn body also resolves to the message"
(run-err "-e" "(defn f [] (no-such 1)) (f)")
(has "Unable to resolve symbol: no-such"))
(check "trace shows the user's call chain"
(run-err "-e" "(defn inner [x] (let [r (+ x :k)] r)) (defn outer [x] (let [v (inner x)] v)) (outer 1)")
(fn [s] (and (string/find "at user/inner" s) (string/find "at user/outer" s))))
(check "no jolt-internal frames in user errors"
(run-err "-e" `(+ 1 "a")`)
(fn [s] (nil? (string/find "src/jolt/" s))))
# --- round 4: load errors carry file:line + the require chain ---------------
(def r4 (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-cli-r4-" (os/time)))
(os/mkdir r4) (os/mkdir (string r4 "/app"))
(spit (string r4 "/app/broken.clj") "(ns app.broken)\n\n(def config\n (+ 1 \"boom\"))\n")
(spit (string r4 "/app/mid.clj") "(ns app.mid (:require [app.broken :as b]))\n")
(spit (string r4 "/app/top.clj") "(ns app.top (:require [app.mid :as m]))\n(defn -main [& a] nil)\n")
(os/setenv "JOLT_PATH" r4)
(def deep-err (run-err "-m" "app.top"))
(check "load error names the failing file:line" deep-err
(has "at " ))
(check "load error points into broken.clj line 3" deep-err
(has "/app/broken.clj:3"))
(check "require chain shows the loading path" deep-err
(fn [s] (and (string/find "while loading" s) (string/find "/app/mid.clj" s) (string/find "/app/top.clj" s))))
(check "script errors name the script file"
(do (spit (string r4 "/scr.clj") "(ns scr)\n\n(+ 1 \"x\")\n")
(run-err (string r4 "/scr.clj")))
(has "/scr.clj:3"))
(check "no synthetic <eval> position on one-liners"
(run-err "-e" `(+ 1 "a")`)
(fn [s] (nil? (string/find "<eval>" s))))
# --- round 5: reader errors carry file:line:col ------------------------------
(check "unterminated string positions in -e"
(run-err "-e" `(+ 1 "abc`)
(has "Syntax error reading source at (<eval>:1:10): Unterminated string"))
(check "unterminated list names script file:line:col"
(do (spit (string r4 "/syn.clj") "(ns syn)\n\n(defn f [x]\n (+ x 1\n")
(run-err (string r4 "/syn.clj")))
(has ":5:1): Unterminated list"))
(check "unmatched delimiter positioned"
(do (spit (string r4 "/app/synreq.clj") "(ns app.synreq)\n\n(def x ])\n")
(spit (string r4 "/app/top2.clj") "(ns app.top2 (:require [app.synreq :as q]))\n(defn -main [& a] nil)\n")
(os/setenv "JOLT_PATH" r4)
(run-err "-m" "app.top2"))
(fn [s] (and (string/find "/app/synreq.clj:3:8): Unmatched delimiter: ]" s)
(string/find "/app/top2.clj:1" s))))
(check "bad token positioned"
(run-err "-e" "(def x ##Huh)")
(has "Invalid symbolic value: ##Huh"))
(check "JOLT_DEBUG restores the raw trace"
(do (os/setenv "JOLT_DEBUG" "1")
(def r (run-err "-e" `(+ 1 "a")`))
(os/setenv "JOLT_DEBUG" nil)
r)
(has "could not find method"))
# --- success checker default-on in direct-link, off in plain builds ----------
# A provably-wrong defn (never called, so no runtime error): the checker is the
# only thing that can flag it. Plain build = silent (no dev regression);
# direct-link build = warns by default (free piggyback on inference).
(def tcw (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-tcwarn-" (os/time) ".clj"))
(spit tcw "(ns tcw)\n\n(defn unused [s]\n (inc \"definitely-not-a-number\"))\n")
(check "plain build does not run the checker (no regression)"
(run-err tcw)
(fn [s] (nil? (string/find "type error" s))))
(check "direct-link build warns by default (free checking)"
(do (os/setenv "JOLT_DIRECT_LINK" "1")
(def r (run-err tcw))
(os/setenv "JOLT_DIRECT_LINK" nil)
r)
(fn [s] (and (string/find "type error" s)
(string/find "requires a number" s))))
(check "JOLT_TYPE_CHECK=off disables it even in direct-link"
(do (os/setenv "JOLT_DIRECT_LINK" "1")
(os/setenv "JOLT_TYPE_CHECK" "off")
(def r (run-err tcw))
(os/setenv "JOLT_DIRECT_LINK" nil)
(os/setenv "JOLT_TYPE_CHECK" nil)
r)
(fn [s] (nil? (string/find "type error" s))))
# negative/never types (jolt-wwy): calling a non-function is reported by default
# in direct-link; wrong-arity to a user fn under the JOLT_TYPE_CHECK_USER opt-in
(def tcn (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-tcneg-" (os/time) ".clj"))
(spit tcn "(ns tcn)\n\n(defn nope []\n (let [n 5] (n 1)))\n")
(check "direct-link reports calling a number as a function"
(do (os/setenv "JOLT_DIRECT_LINK" "1")
(def r (run-err tcn))
(os/setenv "JOLT_DIRECT_LINK" nil)
r)
(has "cannot call a number as a function"))
(def tca (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-tcarity-" (os/time) ".clj"))
(spit tca "(ns tca)\n\n(defn f [x y] (+ x y))\n(defn g [] (f 1))\n")
(check "JOLT_TYPE_CHECK_USER reports wrong arity to a user fn"
(do (os/setenv "JOLT_DIRECT_LINK" "1")
(os/setenv "JOLT_TYPE_CHECK_USER" "1")
(def r (run-err tca))
(os/setenv "JOLT_DIRECT_LINK" nil)
(os/setenv "JOLT_TYPE_CHECK_USER" nil)
r)
(has "wrong number of args (1) passed to `f` (expected 2)"))
(if (> fails 0)
(error (string "cli-test: " fails " failing check(s)"))
(print "\nAll CLI tests passed!"))

61
test/integration/clojure-stdlib-suite-test.janet
View file

@ -1,61 +0,0 @@
# Vendored stdlib-namespace battery (jolt-0mb).
#
# clojure.test suites for stdlib namespaces beyond clojure.core, vendored from
# clojurust's clojure-test-suite fork (test/clojure-stdlib/, with corrected
# fixtures where the upstream expectations disagreed with real Clojure). Each
# file runs in the shared per-file worker; we guard a minimum pass count so a
# regression is caught and improvements (e.g. finishing clojure.edn) can raise
# the floor.
(def files
# [relative-path min-pass must-be-clean?]
[["clojure/walk_test/walk.cljc" 34 true]
["clojure/zip_test/zip.cljc" 33 true]
["clojure/data_test/diff.cljc" 61 true]
# clojure.edn reads via clojure.core/read-string (opts/:eof + nil/blank) and
# constructs set/nested values. Only #uuid remains (no real uuid type) —
# jolt-b7y. Guard the passing subset.
["clojure/edn_test/read_string.cljc" 50 false]])
(def root "test/clojure-stdlib")
(def per-file-timeout 6)
(defn- run-file [path]
(def proc (os/spawn ["janet" "test/integration/suite-worker.janet" path] :p {:out :pipe}))
(def out (proc :out))
(var data nil)
(def ok (try
(ev/with-deadline per-file-timeout
(set data (ev/read out 0x10000))
(os/proc-wait proc) true)
([err] false)))
(when (not ok)
(protect (os/proc-kill proc true))
(protect (ev/with-deadline 2 (os/proc-wait proc))))
(protect (:close out))
(if (and ok data) (string data) nil))
(defn- counts [s]
(var r nil)
(each line (string/split "\n" (or s ""))
(when (string/has-prefix? "@@COUNTS " line)
(let [p (string/split " " (string/trim line))]
(when (= 4 (length p)) (set r [(scan-number (p 1)) (scan-number (p 2)) (scan-number (p 3))])))))
r)
(var failures 0)
(each [rel min-pass clean?] files
(def path (string root "/" rel))
(def c (counts (run-file path)))
(if (nil? c)
(do (++ failures) (printf "FAIL %s: no result (crash/timeout)" rel))
(let [[p f e] c]
(printf " %-34s pass=%d fail=%d err=%d" rel p f e)
(when (< p min-pass)
(++ failures) (printf "FAIL %s: pass %d < baseline %d" rel p min-pass))
(when (and clean? (or (pos? f) (pos? e)))
(++ failures) (printf "FAIL %s: expected clean, got %d fail / %d err" rel f e)))))
(if (pos? failures)
(do (printf "clojure-stdlib-suite: %d failure(s)" failures) (os/exit 1))
(print "clojure-stdlib-suite: OK"))

163
test/integration/clojure-test-suite-test.janet
View file

@ -1,163 +0,0 @@
# clojure-test-suite conformance: runs the external, cross-dialect
# clojure-test-suite (jank-lang fork) against Jolt and asserts the number of
# passing per-function test files stays at/above a baseline. The suite is a git
# submodule at vendor/clojure-test-suite (CI checks it out via submodules:
# recursive). The test SKIPS cleanly only if the submodule isn't initialized
# (run `git submodule update --init`).
#
# Each suite file is a `clojure.test` namespace (one per clojure.core/string
# function). A minimal clojure.test + portability shim (test/support/clojure_test.clj)
# lets Jolt load them; `when-var-exists` auto-skips fns Jolt doesn't implement.
#
# Files are run in a one-shot worker subprocess (test/integration/suite-worker.janet)
# under a wall-clock deadline. A few suite tests build infinite sequences that an
# uncompilable/eager path can't truncate and so HANG rather than fail; the
# deadline contains them — a timed-out file contributes nothing, no skip-list.
(def suite-dir "vendor/clojure-test-suite/test/clojure")
# Baseline: assertions Jolt currently passes across the suite. Raise as Jolt
# improves so a regression (previously-passing assertion breaking) is caught.
# Lowered 3915 -> 3913 when futures landed: `realized?`/realized_qmark.cljc has a
# `(when-var-exists future ...)` block that was skipped while `future` was
# unresolved. With futures implemented the block now runs, but it depends on JVM
# `Thread/sleep` (jolt has no JVM interop) and on `future-cancel` interrupting a
# running thread (Janet OS threads can't be interrupted), so `(deref (future
# (sleep 1)))` re-raises the unresolved-`Thread/sleep` error — a documented
# platform gap, not a regression in any previously-working behavior.
# Raised 3913 -> 3916 with the staged-bootstrap kernel tier (ns-restore-on-throw
# + faithful subvec coercion), then 3916 -> 3919 moving juxt/every-pred/some-fn to
# Clojure (the canonical defs are more correct than the prior Janet ones). Raised
# 3919 -> 3926 preserving nil map values (jolt-c7h): a nil value is a present key,
# which several suite tests assert. Runs read 3927 consistently, occasionally 3926
# when a timeout-prone test (of the 9 that can time out) doesn't finish; floor at
# the consistent-minus-one 3926.
# Raised 3971 -> 3981 with Option A full laziness (jolt-fng): transformers return
# lazy seqs, lazy interleave stops timing out, and the lazy-seq nil-element +
# non-seqable-input fixes (case/seq/reverse/empty? over nil-first lazy seqs;
# lazy-from throws on non-seqable like Clojure) recovered + extended the suite.
# clean files 45 -> 66 (Option A makes seq?/vector? results match Clojure across
# many cross-dialect files). Stable across runs.
# Raised 3981 -> 4004 migrating 7 lazy seq fns to the Clojure overlay (40-lazy
# tier): the canonical CLJ versions add coverage (e.g. distinct value-equality).
# Raised 4004 -> 4034 / clean 66 -> 67 porting partition-all + repeatedly to the
# overlay, which required fixing two leniencies (a char is not callable; take
# validates its count) — correct beyond those fns, so the suite rose broadly.
# Raised 4660 -> 4695 (observed 4703) after the seed-shrink rounds: rest/next
# over sets/maps/sorted colls fixed (they walked the wrapper table's internal
# fields), canonical halt-when/==/memfn. Margin covers rand-based suite jitter.
(def baseline-pass 4695)
# A file is "clean" when it ran with zero failures AND zero errors.
(def baseline-clean-files 88)
# Per-file wall-clock budget (seconds). Normal files finish in well under 1s, so
# this normally only fires on genuinely-infinite-sequence hangs. It's an env var
# (JOLT_SUITE_TIMEOUT) so CI — whose runners are slower than a dev machine — can
# give slow-but-finite files generous headroom without timing them out (which
# would drop total-pass below the baseline and flake CI red). Default 6 locally.
(def per-file-timeout
(let [e (os/getenv "JOLT_SUITE_TIMEOUT")]
(or (and e (scan-number e)) 6)))
(defn- walk [dir acc]
(each e (os/dir dir)
(def p (string dir "/" e))
(case ((os/stat p) :mode)
:directory (walk p acc)
:file (when (and (string/has-suffix? ".cljc" p)
(not (string/has-suffix? "portability.cljc" p)))
(array/push acc p))))
acc)
# Run one file in a worker subprocess; return its "pass fail error" stdout, or
# nil if it exceeded the deadline (hang) or crashed.
(defn- run-file [path]
(def proc (os/spawn ["janet" "test/integration/suite-worker.janet" path] :p {:out :pipe}))
(def out (proc :out))
(var data nil)
(def ok
(try
(ev/with-deadline per-file-timeout
(set data (ev/read out 0x10000)) # workers print a single short line
(os/proc-wait proc)
true)
([err] false)))
(when (not ok)
(protect (os/proc-kill proc true))
(protect (ev/with-deadline 2 (os/proc-wait proc))))
(protect (:close out))
(if (and ok data) (string data) nil))
(defn- parse-counts [s]
# Find the "@@COUNTS p f e" sentinel line (a test body may have printed other
# lines to stdout, e.g. with-out-str tests).
(var result nil)
(each line (string/split "\n" s)
(when (string/has-prefix? "@@COUNTS " line)
(let [parts (string/split " " (string/trim line))]
(when (= 4 (length parts))
(set result [(scan-number (parts 1)) (scan-number (parts 2)) (scan-number (parts 3))])))))
result)
(if (not (os/stat suite-dir))
(print "clojure-test-suite: vendor/clojure-test-suite not initialized — skipped (run: git submodule update --init)")
(do
(def progress? (os/getenv "SUITE_PROGRESS"))
(def files (sort (walk suite-dir @[])))
(var total-pass 0)
(var total-fail 0)
(var total-error 0)
(var clean-files 0)
(var ran-files 0)
(var timeouts 0)
(def worst @[])
# Worker pool: each file is already its own subprocess (isolation + hang
# containment), so concurrency only changes wall-clock. A token-channel
# semaphore caps the live workers; os/spawn / ev/read / os/proc-wait are
# event-loop aware so the fibers genuinely interleave. Totals are
# order-independent. Default 4 keeps per-file wall-clock deadlines honest
# on small CI runners; override with JOLT_SUITE_WORKERS.
(def nworkers
(min 8 (max 1 (or (scan-number (or (os/getenv "JOLT_SUITE_WORKERS") ""))
(os/cpu-count) 4))))
(def sem (ev/chan nworkers))
(def done (ev/chan (length files)))
(each path files
(ev/spawn
(ev/give sem :tok) # acquire (blocks when pool is full)
(def out (run-file path))
(ev/take sem) # release
(ev/give done [path out])))
(for _ 0 (length files)
(def [path out] (ev/take done))
(def rel (string/slice path (+ 1 (length suite-dir))))
(def counts (and out (parse-counts out)))
(when progress?
(eprintf " %s%s" rel (cond (nil? out) " TIMEOUT" (nil? counts) " (no counts)" ""))
(eflush))
(cond
(nil? out) (++ timeouts)
(nil? counts) nil
(let [[pn fn* en] counts]
(++ ran-files)
(+= total-pass pn)
(+= total-fail fn*)
(+= total-error en)
(when (and (= 0 fn*) (= 0 en) (> pn 0)) (++ clean-files))
(when (> (+ fn* en) 0) (array/push worst [(+ fn* en) rel pn fn* en])))))
(def total (+ total-pass total-fail total-error))
(printf "\nclojure-test-suite: %d files ran (%d timed out), %d assertions — %d pass / %d fail / %d error"
ran-files timeouts total total-pass total-fail total-error)
(printf "\n clean files (0 fail/error, >0 pass): %d" clean-files)
(sort-by (fn [x] (- (x 0))) worst)
(when (> (length worst) 0)
(print " top files by fail+error:")
(each w (slice worst 0 (min 15 (length worst)))
(printf " %-40s pass=%d fail=%d err=%d" (w 1) (w 2) (w 3) (w 4))))
(assert (>= total-pass baseline-pass)
(string/format "regression: total-pass %d < baseline %d" total-pass baseline-pass))
(assert (>= clean-files baseline-clean-files)
(string/format "regression: clean-files %d < baseline %d" clean-files baseline-clean-files))
(printf "\nclojure-test-suite: OK (>= %d pass, >= %d clean files)\n" baseline-pass baseline-clean-files)))

171
test/integration/compile-mode-test.janet
View file

@ -1,171 +0,0 @@
(use ../../src/jolt/api)
(defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s)))
(print "Phase 6: comprehensive compile-mode tests...")
(let [ctx (init-cached {:compile? true})]
(print " collections...")
(assert (= :a (ct-eval ctx "(nth [:a :b :c :d] 0)")) "nth")
(assert (= true (ct-eval ctx "(vector? [1 2])")) "vector?")
(assert (= true (ct-eval ctx "(map? {:a 1})")) "map?")
(assert (= true (ct-eval ctx "(fn? inc)")) "fn?")
(assert (= [1 2 3 4] (ct-eval ctx "(conj [1 2 3] 4)")) "conj")
(assert (= 1 (ct-eval ctx "(first [1 2 3])")) "first")
(assert (= [2 3] (ct-eval ctx "(rest [1 2 3])")) "rest")
(assert (= 1 (ct-eval ctx "(get {:a 1 :b 2} :a)")) "get map")
(assert (= nil (ct-eval ctx "(get {:a 1} :z)")) "get missing")
(assert (= 3 (ct-eval ctx "(count {:a 1 :b 2 :c 3})")) "count map")
(assert (= [1 2 3] (ct-eval ctx "(into [1] [2 3])")) "into")
(print " core math...")
(assert (= 3 (ct-eval ctx "(+ 1 2)")) "+")
(assert (= 1 (ct-eval ctx "(- 3 2)")) "-")
(assert (= 6 (ct-eval ctx "(* 2 3)")) "*")
(assert (= 2 (ct-eval ctx "(/ 4 2)")) "/")
(assert (= 3 (ct-eval ctx "(inc 2)")) "inc")
(assert (= 1 (ct-eval ctx "(dec 2)")) "dec")
(assert (= 1 (ct-eval ctx "(quot 5 3)")) "quot")
(assert (= 2 (ct-eval ctx "(rem 5 3)")) "rem")
(assert (= 2 (ct-eval ctx "(mod 5 3)")) "mod")
(assert (= 3 (ct-eval ctx "(max 1 2 3)")) "max")
(assert (= 1 (ct-eval ctx "(min 1 2 3)")) "min")
(print " predicates...")
(assert (= true (ct-eval ctx "(nil? nil)")) "nil?")
(assert (= false (ct-eval ctx "(nil? 1)")) "nil? false")
(assert (= true (ct-eval ctx "(zero? 0)")) "zero?")
(assert (= true (ct-eval ctx "(pos? 5)")) "pos?")
(assert (= true (ct-eval ctx "(neg? -1)")) "neg?")
(assert (= true (ct-eval ctx "(even? 4)")) "even?")
(assert (= true (ct-eval ctx "(odd? 3)")) "odd?")
(assert (= false (ct-eval ctx "(not true)")) "not")
(assert (= true (ct-eval ctx "(some? 1)")) "some?")
(assert (= true (ct-eval ctx "(string? \"hello\")")) "string?")
(assert (= true (ct-eval ctx "(number? 42)")) "number?")
(assert (= true (ct-eval ctx "(keyword? :foo)")) "keyword?")
(assert (= true (ct-eval ctx "(= 1 1)")) "=")
(assert (= true (ct-eval ctx "(< 1 2)")) "<")
(assert (= true (ct-eval ctx "(> 2 1)")) ">")
(assert (= true (ct-eval ctx "(<= 1 1)")) "<=")
(assert (= true (ct-eval ctx "(>= 2 2)")) ">=")
(print " seq operations...")
(assert (= [2 3 4] (ct-eval ctx "(map inc [1 2 3])")) "map")
(assert (= [2 4] (ct-eval ctx "(filter even? [1 2 3 4])")) "filter")
(assert (= [1 3] (ct-eval ctx "(remove even? [1 2 3 4])")) "remove")
(assert (= 6 (ct-eval ctx "(reduce + [1 2 3])")) "reduce")
(assert (= [1 2 3] (ct-eval ctx "(take 3 [1 2 3 4 5])")) "take")
(assert (= [4 5] (ct-eval ctx "(drop 3 [1 2 3 4 5])")) "drop")
(print " special forms...")
(assert (= 30 (ct-eval ctx "(let [x 10 y 20] (+ x y))")) "let")
(assert (= :a (ct-eval ctx "(if true :a :b)")) "if true")
(assert (= :b (ct-eval ctx "(if false :a :b)")) "if false")
(assert (= 3 (ct-eval ctx "(loop [x 0] (if (< x 3) (recur (inc x)) x))")) "loop")
(assert (= "caught" (ct-eval ctx "(try (throw 42) (catch Exception e \"caught\"))")) "try")
(assert (= 42 (ct-eval ctx "'42")) "quote literal")
(print " macros...")
(ct-eval ctx "(defn add [a b] (+ a b))")
(assert (= 7 (ct-eval ctx "(add 3 4)")) "defn")
(assert (= 42 (ct-eval ctx "(when true 42)")) "when true")
(assert (= 3 (ct-eval ctx "(and 1 2 3)")) "and")
(assert (= 1 (ct-eval ctx "(or 1 2 3)")) "or")
(assert (= 49 (ct-eval ctx "((fn [x] (* x x)) 7)")) "fn macro")
(assert (= 2 (ct-eval ctx "(if-let [x 1] (inc x) 0)")) "if-let")
(print " complex...")
(assert (= 6 (ct-eval ctx "(let [f (fn [n] (loop [i 0 acc 0] (if (< i n) (recur (inc i) (+ acc i)) acc)))] (f 4))")) "nested")
(assert (= 15 (ct-eval ctx "(reduce + (map inc [0 1 2 3 4]))")) "reduce+map")
# Phase 1 wiring: compiled defns persist across forms (the per-context Janet
# env) and recurse correctly (named-fn self-reference).
(print " cross-form defns + recursion...")
(eval-string ctx "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))")
(assert (= 832040 (ct-eval ctx "(fib 30)")) "recursive fib across forms")
(eval-string ctx "(defn sq [x] (* x x))")
(eval-string ctx "(defn sum-sq [a b] (+ (sq a) (sq b)))")
(assert (= 25 (ct-eval ctx "(sum-sq 3 4)")) "defn calling earlier defn")
(eval-string ctx "(def base 100)")
(assert (= 142 (ct-eval ctx "(+ base 42)")) "compiled def referenced later")
# Phase 2: native ops are emitted directly (fast), but IFn values in call
# position (keyword/map/set) still dispatch via the runtime.
(print " native ops + IFn dispatch...")
(assert (= 10 (ct-eval ctx "(+ 1 2 3 4)")) "n-ary +")
(assert (= true (ct-eval ctx "(< 1 2 3)")) "n-ary <")
(assert (= 1 (ct-eval ctx "(:a {:a 1})")) "keyword as fn")
(assert (= 1 (ct-eval ctx "({:a 1} :a)")) "map as fn")
(assert (= 2 (ct-eval ctx "(#{1 2 3} 2)")) "set as fn")
(assert (= true (ct-eval ctx "(= [1 2] [1 2])")) "= is value equality, not core-= bypass")
# Phase 2: hybrid fallback. Forms the compiler can't compile (destructuring,
# multi-arity, named fns) interpret instead of erroring or miscompiling. The
# result is the same — compilation is a transparent speedup.
(print " hybrid fallback (destructuring / multi-arity)...")
(assert (= 3 (ct-eval ctx "(let [[a b] [1 2]] (+ a b))")) "vector destructuring let")
(assert (= 6 (ct-eval ctx "(let [{:keys [x y z]} {:x 1 :y 2 :z 3}] (+ x y z))")) "map destructuring let")
(assert (= 3 (ct-eval ctx "((fn [[a b]] (+ a b)) [1 2])")) "destructuring fn param")
(assert (= 5 (ct-eval ctx "(let [[a & more] [1 2 3 4 5]] (+ a (count more)))")) "rest destructuring")
(ct-eval ctx "(defn arity ([a] a) ([a b] (+ a b)) ([a b & more] (apply + a b more)))")
(assert (= 5 (ct-eval ctx "(arity 5)")) "multi-arity 1")
(assert (= 7 (ct-eval ctx "(arity 3 4)")) "multi-arity 2")
(assert (= 15 (ct-eval ctx "(arity 1 2 3 4 5)")) "multi-arity variadic clause")
(assert (= 10 (ct-eval ctx "((fn self [n] (if (zero? n) 0 (+ n (self (dec n))))) 4)")) "named fn recursion")
# recur directly inside a fn (not a loop) — re-enters the fn's arity. Compiles
# to a self-call; was previously broken under compilation.
(assert (= 15 (ct-eval ctx "((fn [n acc] (if (zero? n) acc (recur (dec n) (+ acc n)))) 5 0)")) "recur in fn")
(assert (= 3 (ct-eval ctx "((fn cnt [acc & xs] (if (seq xs) (recur (inc acc) (rest xs)) acc)) 0 :a :b :c)")) "recur into variadic arity")
(assert (= 6 (ct-eval ctx "(loop [[x & xs] [1 2 3] acc 0] (if x (recur xs (+ acc x)) acc))")) "destructuring loop binding")
# A runtime error in compiled code must propagate, not silently fall back to a
# second (interpreted) evaluation.
(assert (= :threw (try (do (ct-eval ctx "(inc nil)") :no-throw) ([_] :threw)))
"runtime error in compiled code propagates"))
# Context isolation: a def in one compiled context is invisible in another. With
# var-indirection each context has its own var cells, so in b `secret` does not
# resolve at all ('Unable to resolve symbol', jolt-2o7.3) rather than seeing a's 7.
(let [a (init-cached {:compile? true}) b (init-cached {:compile? true})]
(eval-string a "(def secret 7)")
(assert (= 7 (ct-eval a "secret")) "def visible in its own ctx")
(def r (protect (ct-eval b "secret")))
(assert (and (not (r 0))
(string/find "Unable to resolve symbol: secret" (string/format "%q" (r 1))))
"def isolated to its ctx (unresolved there)"))
# Redefinition is visible to already-compiled callers (var-indirection).
(let [c (init-cached {:compile? true})]
(eval-string c "(defn g [] 1)")
(eval-string c "(defn calls-g [] (g))")
(eval-string c "(defn g [] 2)")
(assert (= 2 (ct-eval c "(calls-g)")) "compiled caller sees redefined global"))
# Map-literal metadata on a def'd name reads as (def (with-meta name m) v); the
# analyzer must route it to the interpreter (uncompilable), not die extracting
# the name. Regression: yogthos/config's (defonce ^{:doc "…"} env …) broke
# every load-string/uberscript path while loading fine through require.
(let [c (init-cached {:compile? true})]
(assert (= 42 (do (eval-string c `(def ^{:doc "d"} md-def 42)`)
(ct-eval c "md-def")))
"compile-mode def with ^{:map} metadata")
(assert (= "d" (ct-eval c "(:doc (meta (var md-def)))"))
"map metadata lands on the var")
(assert (= 7 (do (eval-string c `(defonce ^{:doc "o"} md-once 7)`)
(ct-eval c "md-once")))
"compile-mode defonce with ^{:map} metadata"))
# (declare name) must intern a var so a compiled forward reference binds to it —
# not to a like-named Janet host builtin. Regression: selmer.parser's
# (declare parse) + a (parse …) call compiled to janet's 1-arg `parse`.
(let [c (init-cached {:compile? true})]
(eval-string c "(declare parse)")
(eval-string c "(defn callit [s] (parse s 1 2))")
(eval-string c "(defn parse [s a b] [s a b])")
(assert (deep= ["x" 1 2] (ct-eval c `(callit "x")`))
"compiled forward ref through declare beats host fallback")
(eval-string c "(def no-init-var)")
(assert (= true (ct-eval c "(do (def no-init-var 5) (= 5 no-init-var))"))
"(def name) with no init interns; later def binds"))
(print "\nAll Phase 6 tests passed!")

75
test/integration/config-lib-test.janet
View file

@ -1,75 +0,0 @@
# yogthos/config acceptance: load the real library from ~/src/config and run
# its whole surface — PushbackReader over io/reader, edn/read from a reader,
# Long/parseLong + BigInteger. + Boolean/parseBoolean, System/getenv +
# System/getProperties as iterable maps, str->value, keywordize, deep-merge,
# and the defonce env built at load. SKIPS cleanly when the checkout is
# absent (CI); the shim surface itself is covered by host-interop-spec.
(import ../../src/jolt/api :as api)
(use ../../src/jolt/reader)
(def config-src (string (os/getenv "HOME") "/src/config/src"))
(if (nil? (os/stat (string config-src "/config/core.clj")))
(print "config-lib-test: ~/src/config not present, skipping")
(do
(reader-features-set! ["jolt" "clj" "default"])
# run from a temp project dir so config.edn/.lein-env are controlled
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-config-lib-" (os/time)))
(defn rmrf [p]
(when (os/stat p)
(if (= :directory (os/stat p :mode))
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
(os/rm p))))
(rmrf base)
(os/mkdir base)
(spit (string base "/config.edn")
"{:db {:host \"localhost\"\n :port 5432}\n :app-name \"demo\"}\n")
(spit (string base "/.lein-env") "{:db {:port 9999}}")
(os/cd base)
(os/setenv "CONFIG_TEST_NUM" "42")
(os/setenv "CONFIG_TEST_FLAG" "true")
(os/setenv "CONFIG_TEST_EDN" "{:x 1}")
(def ctx (api/init {:paths [config-src]}))
(print "loading config.core (defonce env runs load-env at require)...")
(api/eval-string ctx "(require (quote [config.core :as cfg]))")
(print " ok")
(var fails 0)
(defn check [label expr expected]
(def r (protect (api/eval-string ctx expr)))
(def got (if (r 0) (r 1) (string "ERR " (r 1))))
(if (deep= got expected) (print " ok " label)
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got))))
(print "config.edn + .lein-env deep merge...")
(check "nested value from config.edn" "(get-in cfg/env [:db :host])" "localhost")
(check ".lein-env overrides nested" "(get-in cfg/env [:db :port])" 9999)
(check "top-level value" "(:app-name cfg/env)" "demo")
(print "env vars keywordized + converted...")
(check "numeric env var is a number" "(:config-test-num cfg/env)" 42)
(check "boolean env var" "(:config-test-flag cfg/env)" true)
(check "edn env var parses" "(= {:x 1} (:config-test-edn cfg/env))" true)
(print "library fns directly...")
(check "str->value number" "(cfg/str->value \"17\")" 17)
(check "str->value bool" "(cfg/str->value \"false\")" false)
(check "str->value word" "(cfg/str->value \"hello\")" "hello")
(check "str->value edn vec" "(= [1 2] (cfg/str->value \"[1 2]\"))" true)
(check "str->value symbol stays str" "(cfg/str->value \"foo/bar\")" "foo/bar")
(check "keywordize" "(cfg/keywordize \"FOO_BAR__BAZ_QMARK_\")" :foo-bar/baz?)
(check "read-config-file" "(get-in (cfg/read-config-file \"config.edn\") [:db :port])" 5432)
(check "deep-merge-with"
"(= {:a {:b 3}} (cfg/deep-merge-with + {:a {:b 1}} {:a {:b 2}}))" true)
(print "reload-env...")
(check "reload-env returns merged map"
"(do (cfg/reload-env) (get-in cfg/env [:db :host]))" "localhost")
(os/cd "/")
(rmrf base)
(if (> fails 0)
(error (string "config-lib-test: " fails " failing check(s)"))
(print "\nconfig-lib-test: all passed"))))

569
test/integration/conformance-test.janet
View file

@ -1,569 +0,0 @@
# Clojure conformance harness (phase 1: extracted assertion pairs).
#
# Each case is [name expected-clj actual-clj]. The harness evaluates the
# single Clojure program (= <expected> <actual>) inside a fresh jolt ctx
# and asserts it returns boolean true. Comparison therefore uses jolt's OWN
# `=`, which implements Clojure sequential/collection equality -- so results
# reflect real Clojure semantics rather than Janet-level identity.
#
# `actual` may be a multi-form body; wrap such cases in (do ...).
#
# Source of truth: ~/src/clojure/test/clojure/test_clojure/*.clj
# These pairs are hand-extracted from those files (and canonical idioms)
# until a minimal clojure.test lets us load the real files directly.
(use ../../src/jolt/api)
(import ../../src/jolt/backend :as selfhost)
(use ../../src/jolt/reader)
(def cases
[
### ---- CRITICAL: lazy sequences ----
["self-ref lazy-cat fib"
"(quote (0 1 1 2 3 5 8 13 21 34))"
"(do (def fib-seq (lazy-cat [0 1] (map + (rest fib-seq) fib-seq))) (take 10 fib-seq))"]
["self-ref lazy-seq ones"
"(quote (1 1 1 1 1))"
"(do (def ones (lazy-seq (cons 1 ones))) (take 5 ones))"]
["self-ref lazy-seq nats"
"(quote (0 1 2 3 4))"
"(do (def nats (lazy-cat [0] (map inc nats))) (take 5 nats))"]
### ---- CRITICAL: multi-collection map ----
["map two colls" "(quote (11 22 33))" "(map + [1 2 3] [10 20 30])"]
["map three colls" "(quote (12 24 36))" "(map + [1 2 3] [10 20 30] [1 2 3])"]
["map uneven (shortest)" "(quote ([1 :a] [2 :b]))" "(map vector [1 2 3] [:a :b])"]
["map over range+vec" "(quote (1 3 5))" "(map + (range 3) [1 2 3])"]
["map fn list arg" "(quote (2 3 4))" "(map inc (list 1 2 3))"]
### ---- CRITICAL: iterate / infinite seqs ----
["iterate" "(quote (0 1 2 3 4))" "(take 5 (iterate inc 0))"]
["iterate double" "(quote (1 2 4 8 16))" "(take 5 (iterate (fn [x] (* 2 x)) 1))"]
["range over inf map" "(quote (1 2 3))" "(take 3 (map inc (range)))"]
["count of take" "100" "(count (take 100 (range)))"]
["last of take" "5" "(last (take 5 (iterate inc 1)))"]
### ---- CRITICAL: collections as IFn ----
["vector as fn" ":b" "([:a :b :c] 1)"]
["map as fn" "1" "({:a 1} :a)"]
["map as fn miss" "nil" "({:a 1} :z)"]
["map as fn default" "99" "({:a 1} :z 99)"]
["set as fn" "2" "(#{1 2 3} 2)"]
["set as fn miss" "nil" "(#{1 2 3} 9)"]
# set literals compile (Stage 1 Task 1): computed elements are each evaluated
# then the persistent set is built, matching the interpreter.
["set literal computed" "true" "(= #{1 2} #{(inc 0) 2})"]
["empty set literal" "true" "(empty? #{})"]
["set literal count" "3" "(count #{1 2 3})"]
["set literal in let" "true" "(let [x 5] (= #{5 6} #{x (inc x)}))"]
# set?/disj compile as plain fns now (jolt-g3h), not special forms
["set? true" "true" "(set? #{1 2 3})"]
["set? false" "false" "(set? [1 2])"]
["disj one" "#{1 3}" "(disj #{1 2 3} 2)"]
["disj many" "#{1}" "(disj #{1 2 3} 2 3)"]
["disj absent" "#{1 2}" "(disj #{1 2} 5)"]
["keyword as fn" "1" "(:a {:a 1})"]
["map fn over coll" "(quote (1 3))" "(map {:a 1 :b 3} [:a :b])"]
### ---- CRITICAL: vec / into over lazy + maps ----
["vec of map-result" "[2 3 4]" "(vec (map inc [1 2 3]))"]
["vec of range" "[0 1 2 3 4]" "(vec (range 5))"]
["into vec" "[1 2 3 4 5 6]" "(into [1 2 3] [4 5 6])"]
["into vec from lazy" "[2 3 4]" "(into [] (map inc [1 2 3]))"]
["into map pairs" "{:a 1 :b 2}" "(into {} [[:a 1] [:b 2]])"]
["into map onto map" "{:a 1 :b 2 :c 3}" "(into {:a 1} [[:b 2] [:c 3]])"]
["into list" "(quote (3 2 1))" "(into (list) [1 2 3])"]
### ---- Option A: lazy transformers return seqs, not vectors ----
# map/filter/take/take-while over a concrete vector yield a lazy seq, matching
# Clojure: (seq? (map ...)) is true, (vector? (map ...)) is false.
["map vec is seq" "true" "(seq? (map inc [1 2 3]))"]
["map vec not vector" "false" "(vector? (map inc [1 2 3]))"]
["filter vec is seq" "true" "(seq? (filter odd? [1 2 3]))"]
["take vec is seq" "true" "(seq? (take 2 [1 2 3]))"]
["map over set" "true" "(= #{2 3 4} (set (map inc #{1 2 3})))"]
["filter over map ev" "(quote ([:b 2]))" "(filter (fn [[k v]] (> v 1)) {:a 1 :b 2})"]
# cons of cons over a lazy tail must not leak the rest-thunk
["cons cons lazy" "(quote (1 2 3))" "(cons 1 (cons 2 (lazy-seq (cons 3 nil))))"]
["juxt fns in vec" "[1 3]" "((juxt first last) [1 2 3])"]
["last of lazy take" "5" "(last (take 5 (iterate inc 1)))"]
["next empty lazy" "nil" "(next (take 1 [1]))"]
# drop/distinct/partition/map-indexed/take-nth/interpose/keep are lazy too
["drop vec is seq" "true" "(seq? (drop 1 [1 2 3]))"]
["distinct vec is seq" "true" "(seq? (distinct [1 1 2]))"]
["map-indexed is seq" "true" "(seq? (map-indexed vector [1 2]))"]
["partition vec lazy" "(quote ((1 2) (3 4)))" "(partition 2 [1 2 3 4 5])"]
# nth over a lazy seq must not treat a false/nil element as end-of-seq
["nth lazy false elem" "false" "(nth (map identity [false 1 2]) 0)"]
["nth lazy past false" "2" "(nth (drop 1 (list false 1 2)) 1)"]
["cond-> false clause" "2" "(cond-> 1 true inc false inc)"]
### ---- HIGH: destructuring ----
["destr nested seq" "[1 2 3]" "(let [[a [b c]] [1 [2 3]]] [a b c])"]
["destr rest+as" "[1 (quote (2 3)) [1 2 3]]" "(let [[a & r :as all] [1 2 3]] [a r all])"]
["destr map :keys" "[1 2]" "(let [{:keys [a b]} {:a 1 :b 2}] [a b])"]
["destr map :or" "[1 99]" "(let [{:keys [a b] :or {b 99}} {:a 1}] [a b])"]
["destr map :strs" "[1 2]" "(let [{:strs [a b]} {\"a\" 1 \"b\" 2}] [a b])"]
["destr map :as" "[1 {:a 1}]" "(let [{:keys [a] :as m} {:a 1}] [a m])"]
["destr nested map" "5" "(let [{{:keys [x]} :pos} {:pos {:x 5}}] x)"]
["destr fn-param seq" "7" "((fn [[a b]] (+ a b)) [3 4])"]
["destr fn-param map" "3" "((fn [{:keys [a b]}] (+ a b)) {:a 1 :b 2})"]
["destr let map key" "1" "(let [{a :a} {:a 1}] a)"]
### ---- HIGH: update / assoc-in on map literals ----
["update inc" "{:a 2}" "(update {:a 1} :a inc)"]
["update extra args" "{:a 111}" "(update {:a 1} :a + 10 100)"]
["update-in" "{:a {:b 2}}" "(update-in {:a {:b 1}} [:a :b] inc)"]
["assoc-in" "{:a {:b 1 :c 2}}" "(assoc-in {:a {:b 1}} [:a :c] 2)"]
["assoc-in create" "{:a {:b 1}}" "(assoc-in {} [:a :b] 1)"]
["update-in fnil" "{:a {:b 1}}" "(update-in {} [:a :b] (fnil inc 0))"]
["get-in" "1" "(get-in {:a {:b {:c 1}}} [:a :b :c])"]
### ---- native-op parity (compile emits janet ops at guarded arities) ----
["native mod floored" "2" "(mod -7 3)"]
["native rem truncated" "-1" "(rem -7 3)"]
["native unary div" "0.5" "(/ 2)"]
["native chained div" "1" "(/ 6 3 2)"]
["native bit-and" "8" "(bit-and 12 10)"]
["native bit-xor" "6" "(bit-xor 12 10)"]
["native bit-not" "-6" "(bit-not 5)"]
["native shifts" "[16 2]" "[(bit-shift-left 4 2) (bit-shift-right 8 2)]"]
### ---- multimethod preferences (jolt-heo) ----
["prefer-method breaks tie" ":rect"
"(do (derive :cm/sq :cm/rect) (derive :cm/sq :cm/shape) (defmulti cmf identity) (defmethod cmf :cm/rect [x] :rect) (defmethod cmf :cm/shape [x] :shape) (prefer-method cmf :cm/rect :cm/shape) (cmf :cm/sq))"]
### ---- HIGH: str semantics ----
["str nil empty" "\"\"" "(str nil)"]
["str concat nil" "\"a1\"" "(str \"a\" 1 nil)"]
["str keyword" "\":b\"" "(str :b)"]
["str symbol" "\"foo\"" "(str (quote foo))"]
["str mixed" "\"a:b1\"" "(str \"a\" :b 1)"]
["str seq" "\"[1 2 3]\"" "(str [1 2 3])"]
### ---- HIGH: dispatch ----
["multimethod" "9" "(do (defmulti area :shape) (defmethod area :sq [s] (* (:s s) (:s s))) (area {:shape :sq :s 3}))"]
["multimethod default" ":def" "(do (defmulti f identity) (defmethod f :default [x] :def) (f 99))"]
["protocol on record" "16" "(do (defprotocol Sh (ar [s])) (defrecord Sq [side] Sh (ar [_] (* side side))) (ar (->Sq 4)))"]
["reify dispatch" "42" "(do (defprotocol P (m [_])) (m (reify P (m [_] 42))))"]
# deftype with INLINE protocol methods (its expansion calls extend-type, which
# is defined AFTER deftype in 30-macros — regression for the sq-symbol
# current-ns-vs-compile-ns qualification bug, jolt-3vh)
["deftype inline methods" "7" "(do (defprotocol Pi (mi [x])) (deftype Ti [v] Pi (mi [x] v)) (mi (->Ti 7)))"]
["deftype two protocols" "[1 2]" "(do (defprotocol Pa (ma [x])) (defprotocol Pb (mb [x])) (deftype Tab [a b] Pa (ma [x] a) Pb (mb [x] b)) (let [t (->Tab 1 2)] [(ma t) (mb t)]))"]
### ---- var fns as ordinary invokes (Stage 2 tier 6) ----
["var-get + call" "2" "((var-get (var inc)) 1)"]
["var? true" "true" "(var? (var map))"]
["var? false" "false" "(var? 5)"]
["intern + find-var" "41" "(do (intern (quote user) (quote iv) 41) (var-get (find-var (quote user/iv))))"]
["alter-var-root rest args" "11" "(do (def avr 1) (alter-var-root (var avr) + 4 6) avr)"]
["alter-meta! + meta" "7" "(do (def amv 1) (alter-meta! (var amv) assoc :k 7) (:k (meta (var amv))))"]
### ---- ns introspection fns as ordinary invokes (Stage 2 tier 6b) ----
["find-ns + ns-name" "(quote clojure.core)" "(ns-name (find-ns (quote clojure.core)))"]
["find-ns absent" "nil" "(find-ns (quote no.such.ns))"]
["create-ns + find" "true" "(do (create-ns (quote made.ns)) (some? (find-ns (quote made.ns))))"]
["remove-ns" "nil" "(do (create-ns (quote gone.ns)) (remove-ns (quote gone.ns)) (find-ns (quote gone.ns)))"]
["the-ns of symbol" "(quote user)" "(ns-name (the-ns (quote user)))"]
["ns-resolve + call" "3" "((var-get (ns-resolve (quote clojure.core) (quote inc))) 2)"]
["resolve + call" "3" "((var-get (resolve (quote inc))) 2)"]
["resolve absent" "nil" "(resolve (quote no-such-sym-xyz))"]
### ---- dispatch-table ops + misc as macros/fns (Stage 2 tier 6c) ----
["get-method + call" "1" "(do (defmulti t6f :k) (defmethod t6f :a [x] 1) ((get-method t6f :a) {:k :a}))"]
["remove-method" "nil" "(do (defmulti t6g :k) (defmethod t6g :b [x] 2) (remove-method t6g :b) (get (methods t6g) :b))"]
["remove-all-methods" "nil" "(do (defmulti t6h :k) (defmethod t6h :c [x] 3) (remove-all-methods t6h) (get (methods t6h) :c))"]
# NOTE: dispatch does not yet CONSULT prefers in ambiguous isa dispatch
# prefer-method records {x -> set-of-dominated} (Clojure's {x #{y}} shape;
# jolt-heo upgraded the store from single-value and dispatch consults it).
["prefer-method records" "true" "(do (defmulti t6p identity) (prefer-method t6p :rect :shape) (contains? (get (prefers t6p) :rect) :shape))"]
["instance? deftype" "true" "(do (deftype T6i [a]) (instance? T6i (->T6i 1)))"]
["instance? String" "true" "(instance? String \"s\")"]
["locking evals body" "3" "(locking :anything (+ 1 2))"]
["locking evals monitor" "[3 1]" "(let [a (atom 0)] [(locking (swap! a inc) 3) @a])"]
["defonce keeps first" "5" "(do (defonce d6o 5) (defonce d6o 9) d6o)"]
["read-string + eval" "3" "(eval (read-string \"(+ 1 2)\"))"]
### ---- uuid (jolt-6s2) ----
["random-uuid is uuid" "true" "(uuid? (random-uuid))"]
["uuid str 36" "36" "(count (str (random-uuid)))"]
["parse-uuid round" "\"b6883c0a-0342-4007-9966-bc2dfa6b109e\"" "(str (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\"))"]
["parse-uuid case =" "true" "(= (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\") (parse-uuid \"B6883C0A-0342-4007-9966-BC2DFA6B109E\"))"]
["parse-uuid bad nil" "nil" "(parse-uuid \"df0993\")"]
["uuid as map key" ":v" "(get {(parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\") :v} (parse-uuid \"b6883c0a-0342-4007-9966-bc2dfa6b109e\"))"]
### ---- 1.11 additions + ns fns (spec 35-var batch A) ----
["parse-long" "42" "(parse-long \"42\")"]
["parse-long bad" "nil" "(parse-long \"4.2\")"]
["parse-double" "1500.0" "(parse-double \"1.5e3\")"]
["parse-boolean" "true" "(parse-boolean \"true\")"]
["update-keys" "{\"a\" 1}" "(update-keys {:a 1} name)"]
["update-vals" "{:a 2}" "(update-vals {:a 1} inc)"]
["partitionv pad" "[[1 2] [3 :p]]" "(partitionv 2 2 [:p] [1 2 3])"]
["partition pad" "[[0 1 2 3] [4 5 6 7] [8 9 :a]]" "(partition 4 4 [:a] (range 10))"]
["splitv-at" "[[1 2] [3 4]]" "(splitv-at 2 [1 2 3 4])"]
["with-redefs" "[42 1]" "(do (defn cwr [] 1) [(with-redefs [cwr (fn [] 42)] (cwr)) (cwr)])"]
["time returns value" "3" "(time (+ 1 2))"]
["macroexpand" "true" "(= (quote if) (first (macroexpand (quote (when-not false 1)))))"]
["require bare symbol" "\"a,b\"" "(do (require (quote clojure.string)) (clojure.string/join \",\" [\"a\" \"b\"]))"]
["ns-publics lookup" "true" "(do (def cnp 7) (some? (get (ns-publics (quote user)) (quote cnp))))"]
### ---- #inst + syntax-quote literal collapse (spec 2.4/2.3) ----
["inst? + inst-ms" "0" "(inst-ms #inst \"1970-01-01T00:00:00Z\")"]
["inst partial = full" "true" "(= #inst \"2020\" #inst \"2020-01-01T00:00:00Z\")"]
["inst offset normalized" "true" "(= #inst \"2020-01-01T01:00:00+01:00\" #inst \"2020-01-01T00:00:00Z\")"]
["sq literal collapse" "true" "(= \"meow\" ```\"meow\")"]
["sq number collapse" "42" "``42"]
### ---- stage 3: proper vars replace the Janet root-env leak ----
["compare total order" "[-1 0 1]" "[(compare nil 1) (compare :a :a) (compare \"b\" \"a\")]"]
["compare vectors" "-1" "(compare [1 2] [1 3])"]
["gensym jolt symbol" "true" "(symbol? (gensym))"]
["any? anything" "true" "(and (any? nil) (any? 1) (any? :k))"]
["int? excludes Inf" "false" "(int? ##Inf)"]
["macroexpand-1 when" "2" "(count (rest (macroexpand-1 (quote (when true 1)))))"]
### ---- HIGH: aliased namespace calls ----
["require :as alias" "\"1,2,3\"" "(do (require (quote [clojure.string :as s])) (s/join \",\" [1 2 3]))"]
["ns form + alias" "\"HI\"" "(do (ns my.a (:require [clojure.string :as s])) (s/upper-case \"hi\"))"]
["ns :use refers" "42" "(do (ns src.u) (def helper 42) (ns dst.u (:use [src.u])) helper)"]
### ---- MED: missing core fns ----
["peek vec" "3" "(peek [1 2 3])"]
["peek list" "1" "(peek (list 1 2 3))"]
["pop vec" "[1 2]" "(pop [1 2 3])"]
["pop list" "(quote (2 3))" "(pop (list 1 2 3))"]
["subvec" "[2 3]" "(subvec [1 2 3 4 5] 1 3)"]
["subvec to-end" "[3 4 5]" "(subvec [1 2 3 4 5] 2)"]
["reduce-kv" "{:a 2 :b 3}" "(reduce-kv (fn [m k v] (assoc m k (inc v))) {} {:a 1 :b 2})"]
["reduce-kv vector idx" "(quote ([0 :a] [1 :b]))" "(reduce-kv (fn [a i v] (conj a [i v])) [] [:a :b])"]
### ---- iterating maps yields entries ----
["map over map" "true" "(= #{1 2} (set (map val {:a 1 :b 2})))"]
["map keys over map" "true" "(= #{:a :b} (set (map key {:a 1 :b 2})))"]
["first of map" "true" "(let [e (first {:a 1})] (and (= (key e) :a) (= (val e) 1)))"]
["vec of map" "[[:a 1]]" "(vec {:a 1})"]
["reduce over map" "6" "(reduce (fn [a [k v]] (+ a v)) 0 {:a 1 :b 2 :c 3})"]
["into transform map" "{:a 2 :b 3}" "(into {} (map (fn [[k v]] [k (inc v)]) {:a 1 :b 2}))"]
["filter over map" "true" "(= [[:b 2]] (filterv (fn [[k v]] (> v 1)) {:a 1 :b 2}))"]
["doall realizes" "(quote (2 3 4))" "(doall (map inc [1 2 3]))"]
["tree-seq" "(quote (1 2 3))" "(map (fn [x] x) (filter (complement coll?) (tree-seq coll? seq [1 [2 [3]]])))"]
["key/val" "true" "(let [e (first {:k 9})] (and (= :k (key e)) (= 9 (val e))))"]
["nat-int?" "true" "(and (nat-int? 0) (nat-int? 5) (not (nat-int? -1)))"]
["list* prepend" "(quote (1 2 3 4))" "(list* 1 2 [3 4])"]
["cycle" "(quote (1 2 3 1 2 3 1))" "(take 7 (cycle [1 2 3]))"]
["partition-all" "(quote ((1 2) (3 4) (5)))" "(partition-all 2 [1 2 3 4 5])"]
["reductions" "(quote (1 3 6 10))" "(reductions + [1 2 3 4])"]
["reductions init" "(quote (0 1 3 6))" "(reductions + 0 [1 2 3])"]
["dedupe" "(quote (1 2 3 1))" "(dedupe [1 1 2 3 3 1])"]
# partition-by with a strict pred (odd?) — guards jolt-r81: a lazy overlay fn
# whose lazy-seq leaked its expansion in compile mode passed a non-int to odd?.
["partition-by odd?" "(quote ((1 1) (2) (3 3)))" "(partition-by odd? [1 1 2 3 3])"]
["reductions inf" "(quote (0 1 3 6))" "(take 4 (reductions + (range)))"]
["tree-seq strict" "10" "(reduce + 0 (filter (complement coll?) (tree-seq coll? seq [1 [2 [3 4]]])))"]
# nil/collection case-constants past the point where Option A's lazy `drop`
# made the case macro's (empty? (drop 2 cls)) hit a nil-first lazy seq.
["case nil + default" "[:nilr :def]" "(let [f (fn [x] (case x 1 :one nil :nilr :def))] [(f nil) (f 9)])"]
["case collection consts" "[:v :m :s]" "(let [f (fn [x] (case x [1 2] :v {:a 1} :m #{3} :s :def))] [(f [1 2]) (f {:a 1}) (f #{3})])"]
# a lazy seq whose first element is nil is non-empty (seq/empty?/reverse)
["seq of nil-first" "true" "(boolean (seq (cons nil (list 1))))"]
["reverse nil elem" "[2 nil 1]" "(vec (reverse (list 1 nil 2)))"]
# lazy transformer over a non-seqable scalar throws (matches Clojure)
["map non-seqable throws" "true" "(try (doall (map inc 5)) false (catch Throwable _ true))"]
["keep-indexed" "(quote (:b :d))" "(keep-indexed (fn [i x] (if (odd? i) x)) [:a :b :c :d])"]
["map-indexed" "(quote ([0 :a] [1 :b]))" "(map-indexed (fn [i x] [i x]) [:a :b])"]
["trampoline" ":done" "(do (defn a [n] (if (zero? n) :done (fn [] (a (dec n))))) (trampoline a 5))"]
["format" "\"1-x\"" "(format \"%d-%s\" 1 \"x\")"]
["read-string" "(quote (+ 1 2))" "(read-string \"(+ 1 2)\")"]
["letfn mutual" "true" "(letfn [(ev? [n] (if (= n 0) true (od? (dec n)))) (od? [n] (if (= n 0) false (ev? (dec n))))] (ev? 10))"]
["doseq side" "[1 2 3]" "(do (def a (atom [])) (doseq [x [1 2 3]] (swap! a conj x)) @a)"]
["doseq nested" "4" "(do (def c (atom 0)) (doseq [x [1 2] y [10 20]] (swap! c inc)) @c)"]
### ---- MED: lazy filter / take-while over infinite seqs ----
["lazy filter inf" "(quote (1 3 5 7 9))" "(take 5 (filter odd? (range)))"]
["lazy take-while inf" "(quote (0 1 2 3 4))" "(take-while (fn [x] (< x 5)) (range))"]
["lazy remove inf" "(quote (0 2 4 6 8))" "(take 5 (remove odd? (range)))"]
["filter finite" "(quote (2 4))" "(filter even? [1 2 3 4 5])"]
### ==== atoms (full support) ====
["swap! args" "7" "(do (def a (atom 1)) (swap! a + 2 4) @a)"]
["reset! ret" "9" "(do (def a (atom 1)) (reset! a 9))"]
["compare-and-set!" "true" "(do (def a (atom 1)) (compare-and-set! a 1 2))"]
["compare-and-set! no" "false" "(do (def a (atom 1)) (compare-and-set! a 5 2))"]
["swap-vals!" "[1 2]" "(do (def a (atom 1)) (swap-vals! a inc))"]
["reset-vals!" "[1 9]" "(do (def a (atom 1)) (reset-vals! a 9))"]
["atom map swap" "{:a 1 :b 2}" "(do (def a (atom {:a 1})) (swap! a assoc :b 2) @a)"]
["add-watch" "[:k 1 2]" "(do (def lg (atom nil)) (def a (atom 1)) (add-watch a :k (fn [k r o n] (reset! lg [k o n]))) (swap! a inc) @lg)"]
["atom validator" "5" "(do (def a (atom 1 :validator pos?)) (reset! a 5) @a)"]
["instance? Atom" "true" "(instance? clojure.lang.Atom (atom 1))"]
### ==== volatiles / delays ====
["volatile" "2" "(do (def v (volatile! 1)) (vreset! v 2) @v)"]
["vswap!" "2" "(do (def v (volatile! 1)) (vswap! v inc) @v)"]
["volatile?" "true" "(volatile? (volatile! 1))"]
["delay force" "3" "(force (delay (+ 1 2)))"]
["delay deref once" "1" "(do (def c (atom 0)) (def d (delay (swap! c inc))) @d @d @c)"]
["realized? delay" "true" "(do (def d (delay 1)) @d (realized? d))"]
["realized? not" "false" "(realized? (delay 1))"]
### ==== numbers / math ====
["quot neg" "-2" "(quot -7 3)"]
["rem neg" "-1" "(rem -7 3)"]
["mod neg" "2" "(mod -7 3)"]
["bit ops" "[4 14 10]" "[(bit-and 12 6) (bit-or 12 6) (bit-xor 12 6)]"]
["bit-shift" "[8 2]" "[(bit-shift-left 1 3) (bit-shift-right 8 2)]"]
["Math/sqrt" "3.0" "(Math/sqrt 9)"]
["Math/pow" "8.0" "(Math/pow 2 3)"]
["min-key" "1" "(min-key abs 1 -2 3)"]
["max-key" "-4" "(max-key abs 1 -2 -4 3)"]
### ==== strings (clojure.string) ====
["str/trim" "\"hi\"" "(do (require (quote [clojure.string :as s])) (s/trim \" hi \"))"]
["str/split regex" "[\"a\" \"b\" \"c\"]" "(do (require (quote [clojure.string :as s])) (s/split \"a,b,c\" #\",\"))"]
["str/split ws" "[\"a\" \"b\" \"c\"]" "(do (require (quote [clojure.string :as s])) (s/split \"a b c\" #\"\\s+\"))"]
["str/replace" "\"hexxo\"" "(do (require (quote [clojure.string :as s])) (s/replace \"hello\" \"ll\" \"xx\"))"]
["str/replace regex" "\"ab\"" "(do (require (quote [clojure.string :as s])) (s/replace \"a1b2\" #\"[0-9]\" \"\"))"]
["str/includes?" "true" "(do (require (quote [clojure.string :as s])) (s/includes? \"hello\" \"ell\"))"]
["str/reverse" "\"cba\"" "(do (require (quote [clojure.string :as s])) (s/reverse \"abc\"))"]
["subs" "\"ell\"" "(subs \"hello\" 1 4)"]
### ==== regex ====
["re-find" "\"123\"" "(re-find #\"[0-9]+\" \"abc123def\")"]
["re-matches" "\"abc\"" "(re-matches #\"a.c\" \"abc\")"]
["re-matches no" "nil" "(re-matches #\"a.c\" \"abcd\")"]
["re-seq" "(quote (\"12\" \"34\"))" "(re-seq #\"[0-9]+\" \"a12b34\")"]
### ==== sequences ====
["split-at" "[[1 2] [3 4 5]]" "(split-at 2 [1 2 3 4 5])"]
["split-with" "[[1 2] [3 4 1]]" "(split-with (fn [x] (< x 3)) [1 2 3 4 1])"]
["interpose" "(quote (1 0 2 0 3))" "(interpose 0 [1 2 3])"]
["partition step" "(quote ((1 2) (3 4)))" "(partition 2 2 [1 2 3 4 5])"]
["not-every?" "true" "(not-every? pos? [1 -2 3])"]
["not-any?" "true" "(not-any? neg? [1 2 3])"]
["take-nth" "(quote (0 2 4))" "(take-nth 2 [0 1 2 3 4])"]
["butlast" "(quote (1 2))" "(butlast [1 2 3])"]
["filterv" "[2 4]" "(filterv even? [1 2 3 4])"]
["mapv" "[2 3 4]" "(mapv inc [1 2 3])"]
["reduced early" "3" "(reduce (fn [a x] (if (> a 2) (reduced a) (+ a x))) 0 [1 2 3 4 5])"]
["sort cmp" "[3 2 1]" "(sort > [1 3 2])"]
["frequencies" "{1 2 2 1}" "(frequencies [1 1 2])"]
["empty" "[]" "(empty [1 2 3])"]
["not-empty" "nil" "(not-empty [])"]
["rseq" "(quote (3 2 1))" "(rseq [1 2 3])"]
["replace map" "[:a :b :a]" "(replace {1 :a 2 :b} [1 2 1])"]
### ==== data structures ====
["sorted-map seq" "(quote ([:a 1] [:b 2] [:c 3]))" "(seq (sorted-map :c 3 :a 1 :b 2))"]
["sorted-set seq" "(quote (1 2 3))" "(seq (sorted-set 3 1 2))"]
["assoc vector" "[1 9 3]" "(assoc [1 2 3] 1 9)"]
["update vector" "[1 3 3]" "(update [1 2 3] 1 inc)"]
["coll? set" "true" "(coll? #{1 2})"]
["find entry" "[:a 1]" "(find {:a 1} :a)"]
["conj map entry" "{:a 1 :b 2}" "(conj {:a 1} [:b 2])"]
["conj list prepend" "(quote (0 1 2))" "(conj (list 1 2) 0)"]
### ==== keywords / symbols ====
["keyword ns" ":a/b" "(keyword \"a\" \"b\")"]
["name ns-kw" "\"b\"" "(name :a/b)"]
["namespace" "\"a\"" "(namespace :a/b)"]
["namespace none" "nil" "(namespace :a)"]
### ==== metadata / vars ====
["vary-meta" "{:x 2}" "(meta (vary-meta (with-meta [1] {:x 1}) update :x inc))"]
["defonce no-redef" "1" "(do (defonce dv1 1) (defonce dv1 2) dv1)"]
["binding dynamic" "10" "(do (def ^:dynamic *x* 1) (binding [*x* 10] *x*))"]
### ==== try / catch ====
["try catch" ":caught" "(try (throw (ex-info \"e\" {})) (catch :default e :caught))"]
["ex-data" "{:a 1}" "(try (throw (ex-info \"m\" {:a 1})) (catch :default e (ex-data e)))"]
["ex-message" "\"m\"" "(try (throw (ex-info \"m\" {})) (catch :default e (ex-message e)))"]
### ==== macros ====
["macroexpand-1" "true" "(do (defmacro mm [x] (list (quote inc) x)) (= (quote (inc 5)) (macroexpand-1 (quote (mm 5)))))"]
["doto" "{:a 1}" "(deref (doto (atom {}) (swap! assoc :a 1)))"]
### ==== printing ====
["pr-str vec" "\"[1 2 3]\"" "(pr-str [1 2 3])"]
["prn-str" "\"1\\n\"" "(prn-str 1)"]
### ==== characters ====
["char?" "true" "(char? \\a)"]
["char not string" "false" "(= \\a \"a\")"]
["char eq" "true" "(= \\a \\a)"]
["int of char" "97" "(int \\a)"]
["char of int" "true" "(= \\A (char 65))"]
["str of chars" "\"abc\"" "(str \\a \\b \\c)"]
["seq of string" "(quote (\\a \\b))" "(seq \"ab\")"]
["first of string" "\\h" "(first \"hello\")"]
["nth of string" "\\e" "(nth \"hello\" 1)"]
["char newline" "10" "(int \\newline)"]
["char space" "32" "(int \\space)"]
["char unicode" "65" "(int \\u0041)"]
["pr-str char" "\"\\\\a\"" "(pr-str \\a)"]
["chars in vec" "[\\a \\b]" "[\\a \\b]"]
["apply str chars" "\"hi\"" "(apply str [\\h \\i])"]
### ==== transducers ====
["transduce map" "9" "(transduce (map inc) + 0 [1 2 3])"]
["transduce comp" "12" "(transduce (comp (map inc) (filter even?)) + 0 [1 2 3 4 5])"]
["transduce conj" "[2 3 4]" "(transduce (map inc) conj [] [1 2 3])"]
["into xform" "[2 3 4]" "(into [] (map inc) [1 2 3])"]
["into comp xform" "[1 9 25]" "(into [] (comp (filter odd?) (map (fn [x] (* x x)))) [1 2 3 4 5])"]
["into take xform" "[0 1 2]" "(into [] (take 3) (range 100))"]
["sequence xform" "(quote (2 3 4))" "(sequence (map inc) [1 2 3])"]
["transduce no-init" "6" "(transduce (map inc) + [0 1 2])"]
["transduce drop" "[3 4 5]" "(into [] (drop 2) [1 2 3 4 5])"]
["transduce remove" "[1 3 5]" "(into [] (remove even?) [1 2 3 4 5])"]
["transduce take-while" "[1 2]" "(into [] (take-while (fn [x] (< x 3))) [1 2 3 4 1])"]
["transduce map-indexed" "[[0 :a] [1 :b]]" "(into [] (map-indexed (fn [i x] [i x])) [:a :b])"]
["partition-all xform" "[[1 2] [3 4] [5]]" "(into [] (partition-all 2) [1 2 3 4 5])"]
["partition-all xform comp" "[2 2 1]" "(into [] (comp (partition-all 2) (map count)) [1 2 3 4 5])"]
["partition-by xform" "[[1 1] [2 4] [5]]" "(into [] (partition-by odd?) [1 1 2 4 5])"]
["partition-by xform reduced" "[[1 1] [2 4]]" "(into [] (comp (partition-by odd?) (take 2)) [1 1 2 4 5 5])"]
### ==== regex (capturing groups, backtracking, flags, lookahead) ====
["re-find groups" "[\"12-34\" \"12\" \"34\"]" "(re-find #\"(\\d+)-(\\d+)\" \"x12-34y\")"]
["re-find no-groups" "\"123\"" "(re-find #\"\\d+\" \"ab123\")"]
["re-matches groups" "[\"1.2\" \"1\" \"2\"]" "(re-matches #\"(\\d+)\\.(\\d+)\" \"1.2\")"]
["re-matches no" "nil" "(re-matches #\"a.c\" \"abcd\")"]
["re-seq" "[\"foo\" \"bar\"]" "(re-seq #\"\\w+\" \"foo bar\")"]
["greedy backtrack" "\"xxfoo\"" "(re-find #\".*foo\" \"xxfoo\")"]
["greedy thru group" "[\"a,b,c\" \"a,b\" \"c\"]" "(re-find #\"(.*),(.*)\" \"a,b,c\")"]
["lazy quantifier" "[\"<a>\" \"a\"]" "(re-find #\"<(.+?)>\" \"<a><b>\")"]
["flag case-insens" "\"CAT\"" "(re-find #\"(?i)cat\" \"a CAT\")"]
["lookahead" "\"foo\"" "(re-find #\"foo(?=bar)\" \"foobar\")"]
["neg-lookahead" "\"foo\"" "(re-find #\"foo(?!bar)\" \"foobaz\")"]
["word-boundary" "\"word\"" "(re-find #\"\\bword\\b\" \"a word!\")"]
["word-boundary no" "nil" "(re-find #\"\\bword\\b\" \"swordfish\")"]
["optional group" "[\"1.2.3\" \"1\" \"2\" \"3\" nil]" "(re-find #\"(\\d+)\\.(\\d+)\\.(\\d+)(?:-([a-z]+))?\" \"1.2.3\")"]
["alternation" "\"dog\"" "(re-find #\"cat|dog\" \"a dog cat\")"]
["str/replace $1" "\"he[ll]o\"" "(do (require (quote [clojure.string :as s])) (s/replace \"hello\" #\"(l+)\" \"[$1]\"))"]
["str/replace regex" "\"X-X\"" "(do (require (quote [clojure.string :as s])) (s/replace \"a-b\" #\"[a-z]\" \"X\"))"]
### ==== map literals evaluate their values ====
["map literal expr" "{:a 3}" "{:a (+ 1 2)}"]
["map literal var" "{:k 5}" "(let [x 5] {:k x})"]
["map literal nested" "{:a {:b 2}}" "(let [y 2] {:a {:b y}})"]
["map literal keyfn" "{:x 1}" "(let [k :x] {k 1})"]
["map literal in fn" "6" "(do (defn mk [a b] {:sum (+ a b)}) (:sum (mk 2 4)))"]
### ---- overlay migration (jolt-1j0): run in all 3 modes ----
# if-let/when-let bind only in the taken branch (else sees outer scope)
["if-let else outer scope" "5" "(let [x 5] (if-let [x nil] :then x))"]
["if-some else outer" "5" "(let [x 5] (if-some [x nil] :then x))"]
["when-let body multi" "14" "(when-let [x 7] (inc x) (* x 2))"]
# nthrest returns () (not nil) for an exhausted n>0 walk; coll for n<=0
["nthrest exhausted" "(quote ())" "(nthrest nil 100)"]
["nthrest n=0 keeps coll" "[1 2 3]" "(nthrest [1 2 3] 0)"]
["nthnext surprising nil" "nil" "(nthnext nil nil)"]
# distinct? compares by value
["distinct? equal colls" "false" "(distinct? [1 2] [1 2])"]
["not-any?" "true" "(not-any? even? [1 3 5])"]
["take-last" "[3 4]" "(take-last 2 [1 2 3 4])"]
["replace nil val" "[1 nil 3]" "(replace {2 nil} [1 2 3])"]
### ---- migratus enablement: def/defmacro/defmulti forms, assoc, try, ns ----
# (def name docstring value): the value is the 3rd form, not the docstring
# (jolt-6ym — the analyzer used to bind the docstring as the value).
["def 3-arg docstring" "42" "(do (def dd \"the doc\" 42) dd)"]
["def docstring value type" "true" "(do (def ds \"doc\" [1 2]) (vector? ds))"]
# ^{:map} metadata on a def/defn name reads as a with-meta form (jolt-8w2);
# def/defn/defmacro unwrap it instead of choking.
["def ^{:map} name" "5" "(do (def ^{:private true} mmv 5) mmv)"]
["defn ^{:map} name" "25" "(do (defn ^{:private true} sqf [x] (* x x)) (sqf 5))"]
# defmacro arity-clause form (jolt-whp) and a leading docstring (with-store shape)
["defmacro arity-clause" "10" "(do (defmacro m2c ([x] (list (quote *) x 2))) (m2c 5))"]
["defmacro doc + arity" "30" "(do (defmacro m3c \"doc\" ([x] (list (quote *) x 3))) (* (m3c 5) 2))"]
# defmulti drops a leading docstring (jolt-es4 — it used to be the dispatch fn)
["defmulti docstring" "\"A\"" "(do (defmulti gmm \"the doc\" identity) (defmethod gmm :a [_] \"A\") (gmm :a))"]
# (assoc nil k v) yields a real map (jolt-w4s); assoc-in nests real maps
["assoc nil is a map" "1" "(count (assoc nil :a 1))"]
["assoc-in nested is a map" "1" "(count (:a (assoc-in {} [:a :b] 1)))"]
["assoc-in deep get" "9" "(get-in (assoc-in {} [:a :b :c] 9) [:a :b :c])"]
# try: a multi-form body and finally that runs on the SUCCESS path with a
# catch present (jolt-0z9 — body forms past the first were dropped and
# finally was skipped on success).
["try multi-body last" "3" "(try 1 2 3 (catch :default e 0))"]
["try finally on ok+catch" "9" "(let [a (atom 0)] (try 1 2 (catch :default e :c) (finally (reset! a 9))) @a)"]
["try finally on throw" "9" "(let [a (atom 0)] (try (throw (ex-info \"x\" {})) (catch :default e nil) (finally (reset! a 9))) @a)"]
# current-ns is restored after a caught throw (jolt-96m): the alias/ns seen by
# code after the catch is the one at the catch site, not the thrower's.
["ns restored after catch" "\"user\""
"(do (ns cf.boom) (defn bz [] (throw (Exception. \"e\"))) (in-ns (quote user)) (try (cf.boom/bz) (catch :default e nil)) (str *ns*))"]
# methods sees cross-ns defmethods through a bare multifn ref in its defining
# ns (jolt-9pu — it used to see an empty table).
["cross-ns methods visible" "[:sql]"
"(do (ns cf.mm) (defmulti ext identity) (defmethod ext :default [_] :d) (defn allk [] (vec (for [[k v] (methods ext) :when (not= k :default)] k))) (ns cf.mmi) (defmethod cf.mm/ext :sql [_] :s) (in-ns (quote user)) (cf.mm/allk))"]
### ---- defmacro surface + syntax-quote/ns (enabling real clojure libs) ----
# multi-arity defmacro (clojure.tools.logging/log has 4 arities)
["defmacro multi-arity" "[6 5 6]"
"(do (defmacro mar ([a] (list (quote +) a 1)) ([a b] (list (quote +) a b)) ([a b c] (list (quote +) a b c))) [(mar 5) (mar 2 3) (mar 1 2 3)])"]
# defmacro with docstring AND attr-map before the params (every tools.logging
# level macro is shaped this way)
["defmacro doc + attr-map" "10"
"(do (defmacro mam \"doc\" {:arglists (quote ([x]))} [x] (list (quote inc) x)) (mam 9))"]
# syntax-quote resolves a namespace ALIAS to its target ns, so a macro's
# template resolves at the USE site (jolt-9av)
["syntax-quote resolves alias" "\"HI\""
"(do (ns sq.lib (:require [clojure.string :as s])) (defmacro up [x] `(s/upper-case ~x)) (in-ns (quote user)) (sq.lib/up \"hi\"))"]
# ^{:map} metadata on an ns name (jolt-8w2): the ns name is the bare symbol
["ns name with ^{:map} meta" "5"
"(do (ns ^{:author \"a\" :doc \"d\"} nm.meta) (def q 5) (in-ns (quote user)) nm.meta/q)"]
# ~*ns* splices the live namespace object into a template (it self-evaluates)
["unquote *ns* in template" "true"
"(do (defmacro cur-ns [] `(str ~*ns*)) (string? (cur-ns)))"]
])
# Run every case under a given context factory and return the failures. The same
# cases run under both the interpreter and the compiler: results must match real
# Clojure semantics either way, so the compile path (hybrid: hot compiles,
# unsupported forms fall back to the interpreter) must not diverge.
# mode: {} interpret, {:compile? true} bootstrap compiler, {:selfhost true} the
# self-hosted pipeline (portable Clojure analyzer -> IR -> Janet back end).
(defn- run-cases [mode]
(def selfhost? (get mode :selfhost))
(def init-opts (if selfhost? {} mode))
(defn ev [ctx prog]
(if selfhost? (selfhost/compile-and-eval ctx (parse-string prog)) (eval-string ctx prog)))
# One expensive init per mode; every case runs on a cheap isolated fork (~2 ms)
# instead of its own init (~50 ms interpreted / ~900 ms compiled). Isolation is
# preserved — a fork shares nothing mutable with its siblings. For self-host
# mode, compile one form first so the lazily-built analyzer is in the snapshot.
(def base (init-cached init-opts))
(when selfhost? (selfhost/compile-and-eval base (parse-string "1")))
(def snap (snapshot base))
(def fails @[])
(each [name expected actual] cases
(def ctx (fork snap))
(def prog (string "(= " expected " " actual ")"))
(def res (protect (ev ctx prog)))
(cond
(not= (res 0) true)
(array/push fails [name "ERROR" (string (res 1))])
(= (res 1) true)
nil
(let [got (protect (ev (fork snap) actual))]
(array/push fails [name "MISMATCH"
(string "want=" expected
" got=" (if (= (got 0) true) (string/format "%q" (got 1)) (string "ERR:" (got 1))))]))))
fails)
(defn- report [label fails]
(printf "=== CONFORMANCE (%s): %d/%d passed ===" label (- (length cases) (length fails)) (length cases))
(unless (empty? fails)
(print "--- Failures ---")
(each [name kind detail] fails
(printf "[%s] %s: %s" kind name detail))))
(def interp-fails (run-cases {}))
(report "interpret" interp-fails)
(def compile-fails (run-cases {:compile? true}))
(report "compile" compile-fails)
(def selfhost-fails (run-cases {:selfhost true}))
(report "self-host" selfhost-fails)
(print)
(when (or (pos? (length interp-fails)) (pos? (length compile-fails))
(pos? (length selfhost-fails)))
(os/exit 1))

72
test/integration/cross-ns-hints-test.janet
View file

@ -1,72 +0,0 @@
# Cross-namespace ^Type field hints (jolt-3ko follow-up): a record field hinted
# with a record type defined in ANOTHER namespace — referred (:refer) or aliased
# (:as) in — must resolve to that type's HOME ctor key in the record-shapes
# registry, the same as a same-namespace hint does. That resolved key is what
# lets the inference type a field read back to the foreign record type instead of
# :any (the lever for fast nested-record code across a multi-namespace program).
# Guards both the :refer and :as spellings — for record FIELD hints and for
# fn PARAM hints (which seed the inference so a record param's reads are typed
# across a namespace boundary without whole-program). Also guards that the
# reader keeps a tag's namespace qualifier (^g/Pt -> "g/Pt", not "Pt").
(use ../../src/jolt/api)
(import ../../src/jolt/types :as ty)
(import ../../src/jolt/core :as jc)
(import ../../src/jolt/reader :as rd)
(var failures 0)
(defn- check [label got want]
(unless (deep= got want)
(++ failures)
(printf "FAIL [%s] got %q want %q" label got want)))
(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-xns-hints"))
(os/mkdir dir)
(os/mkdir (string dir "/geo"))
# Pt lives in geo.pt; shape records in geo.shape hint ^Pt across the boundary.
(spit (string dir "/geo/pt.clj")
"(ns geo.pt)\n(defrecord Pt [x y z])\n")
(spit (string dir "/geo/shape.clj")
(string "(ns geo.shape (:require [geo.pt :as g :refer [Pt]]))\n"
"(defrecord Seg [^Pt a ^Pt b])\n" # :refer field hint
"(defrecord Tri [^g/Pt a ^g/Pt b ^g/Pt c])\n" # :as field hint
# param hints, both spellings: ^Pt (referred), ^g/Pt (aliased)
"(defn mid [^Pt a ^g/Pt b] a)\n"))
(def ctx (init {:compile? true :direct-linking? true}))
(array/push (get (ctx :env) :source-paths) dir)
(eval-string ctx "(require '[geo.shape])")
(def rs (get (ctx :env) :record-shapes))
(check ":refer ^Pt field hint resolves to home ctor key"
(get (get rs "geo.shape/->Seg") :tags)
["geo.pt/->Pt" "geo.pt/->Pt"])
(check ":as ^g/Pt field hint resolves to home ctor key"
(get (get rs "geo.shape/->Tri") :tags)
["geo.pt/->Pt" "geo.pt/->Pt" "geo.pt/->Pt"])
# the foreign type's own shape is registered under its home key
(check "home type registered"
(get (get rs "geo.pt/->Pt") :fields)
[:x :y :z])
# --- param hints: the arity carries [name ctor-key] for each record param, both
# the :refer (^Pt) and :as (^g/Pt) spellings resolved to the home key ----------
(def shape-ns (ty/ctx-find-ns ctx "geo.shape"))
(def mid-ir (get (get (get shape-ns :mappings) "mid") :infer-ir))
(def mid-arity (first (jc/vview (get (get mid-ir :init) :arities))))
(def phints (when (get mid-arity :phints)
(map jc/vview (jc/vview (get mid-arity :phints)))))
(check "param hints resolve cross-ns (refer + as)"
phints
@[@["a" "geo.pt/->Pt"] @["b" "geo.pt/->Pt"]])
# --- reader keeps a tag's namespace qualifier ---------------------------------
(check "reader preserves qualified tag ^g/Pt"
(get (get (rd/parse-string "^g/Pt x") :meta) :tag)
"g/Pt")
(check "reader bare tag ^Pt unchanged"
(get (get (rd/parse-string "^Pt x") :meta) :tag)
"Pt")
(if (= 0 failures)
(print "cross-ns-hints: all cases passed")
(do (printf "cross-ns-hints: %d FAILURES" failures) (os/exit 1)))

78
test/integration/ctx-image-test.janet
View file

@ -1,78 +0,0 @@
# init-cached: disk-cached AOT image of the fully-built context.
#
# init in compile mode costs ~2.4 s (tier loading, analyzer self-compile, macro
# recompilation). init-cached pays that once, marshals the built ctx to an image
# file (the same machinery as api/snapshot), and every later process unmarshals
# it instead of rebuilding. The cache key fingerprints the embedded .clj stdlib,
# the .janet seed sources, and the init opts, so any source change invalidates.
#
# The cross-process case is the one that matters (each `jpm test` file is its
# own janet process), so the warm-load checks run in a SUBPROCESS against the
# image this process bakes.
(use ../../src/jolt/api)
(print "ctx image cache...")
(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-img-test-" (os/getpid)))
(os/mkdir dir)
(os/setenv "JOLT_IMAGE_CACHE_DIR" dir)
# The cache is the test subject — undo an ambient opt-out (and for the subprocess).
(os/setenv "JOLT_NO_IMAGE_CACHE" nil)
(defer (do (each f (os/dir dir) (os/rm (string dir "/" f))) (os/rmdir dir))
# 1. Cold init: builds the ctx, writes an image, and is fully functional.
(def t0 (os/clock))
(def ctx1 (init-cached {:compile? true}))
(def cold-s (- (os/clock) t0))
(assert (= 3 (eval-string ctx1 "(+ 1 2)")) "cold ctx evaluates")
(def files (filter |(string/has-suffix? ".jimg" $) (os/dir dir)))
(assert (= 1 (length files)) (string "one image written, got " (length files)))
# 2. Warm init in THIS process: loads the image, functional, and much faster.
(def t1 (os/clock))
(def ctx2 (init-cached {:compile? true}))
(def warm-s (- (os/clock) t1))
(assert (= 10 (eval-string ctx2 "(do (defn f [x] (* 2 x)) (f 5))")) "warm ctx compiles defns")
(assert (< warm-s (/ cold-s 4))
(string/format "warm load (%.0f ms) at least 4x faster than cold (%.0f ms)"
(* 1000 warm-s) (* 1000 cold-s)))
# 3. Different opts get a different image (no false sharing between modes).
(init-cached {})
(def files2 (filter |(string/has-suffix? ".jimg" $) (os/dir dir)))
(assert (= 2 (length files2)) "interpret-mode image is keyed separately")
# 4. Cross-process warm load: a fresh janet process loads the image this
# process baked and runs real work — compiled defns, redefinition,
# macros, lazy seqs, protocols, multimethods, stdlib require.
(def checks
``(use ./src/jolt/api)
(def t0 (os/clock))
(def ctx (init-cached {:compile? true}))
(def warm-ms (* 1000 (- (os/clock) t0)))
(def img-files (filter |(string/has-suffix? ".jimg" $)
(os/dir (os/getenv "JOLT_IMAGE_CACHE_DIR"))))
(assert (= 2 (length img-files)) "subprocess hit the cache (no new image)")
(assert (= 3 (eval-string ctx "(+ 1 2)")) "arith")
(assert (= 120 (eval-string ctx "(do (defn fact [n] (if (zero? n) 1 (* n (fact (dec n))))) (fact 5))")) "compiled defn")
(assert (= 7 (eval-string ctx "(do (def a 3) (def a 7) a)")) "redefinition")
(assert (= 6 (eval-string ctx "(-> 1 inc (* 3))")) "macros expand")
(assert (= 9 (eval-string ctx "(do (defmacro tw [x] `(* 3 ~x)) (tw 3))")) "defmacro works post-load")
(assert (= [2 4 6] (normalize-pvecs (eval-string ctx "(vec (map #(* 2 %) [1 2 3]))"))) "lazy/HOF")
(assert (= "a-b" (eval-string ctx "(do (require '[clojure.string :as str]) (str/join \"-\" [\"a\" \"b\"]))")) "stdlib require")
(assert (= 42 (eval-string ctx "(do (defprotocol P (pf [x])) (defrecord R [] P (pf [x] 42)) (pf (->R)))")) "protocols")
(assert (= :big (eval-string ctx "(do (defmulti m (fn [x] (if (> x 5) :big :small))) (defmethod m :big [_] :big) (m 10))")) "multimethods")
(print "subprocess warm load ok in " (math/round warm-ms) " ms")``)
(def code (os/execute ["janet" "-e" checks] :p))
(assert (= 0 code) "cross-process warm load passes")
# 5. A source change invalidates: poisoning the fingerprint env knob is not
# possible from here, but a corrupted image must fall back to a rebuild
# rather than crash.
(each f (os/dir dir)
(when (string/has-suffix? ".jimg" f) (spit (string dir "/" f) "garbage")))
(def ctx3 (init-cached {:compile? true}))
(assert (= 3 (eval-string ctx3 "(+ 1 2)")) "corrupted image falls back to rebuild")
(printf "ctx image cache passed! (cold %.0f ms, warm %.0f ms)"
(* 1000 cold-s) (* 1000 warm-s)))

119
test/integration/deps-aliases-test.janet
View file

@ -1,119 +0,0 @@
# deps.edn aliases + user-level config merge (jolt-4go).
#
# Mirrors tools.deps semantics scoped to what jolt supports (git/:local, no
# maven): :aliases with :extra-paths / :extra-deps / :main-opts selected by
# keyword; a user deps.edn (under $JOLT_CONFIG, else $XDG_CONFIG_HOME/jolt,
# else ~/.jolt) merged UNDER the project file — :deps and :aliases merge per
# key with the project winning, :paths replaces. Local deps only: no network.
(import ../../src/jolt/deps :as deps)
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-aliases-" (os/time)))
(defn rmrf [p]
(when (os/stat p)
(if (= :directory (os/stat p :mode))
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
(os/rm p))))
(rmrf base)
(defn mkdirs [p]
(def abs (string/has-prefix? "/" p))
(var acc nil)
(each seg (filter |(not= "" $) (string/split "/" p))
(set acc (cond (nil? acc) (if abs (string "/" seg) seg) (string acc "/" seg)))
(unless (os/stat acc) (os/mkdir acc))))
(each d ["proj/src" "proj/dev" "proj/test" "a/src" "c/src" "u/src" "config"]
(mkdirs (string base "/" d)))
# project: src + dep a; :dev alias adds dev/ + dep c; :test alias adds test/
(spit (string base "/proj/deps.edn")
`{:paths ["src"]
:deps {my/a {:local/root "../a"}}
:aliases {:dev {:extra-paths ["dev"]
:extra-deps {my/c {:local/root "../c"}}}
:test {:extra-paths ["test"]
:main-opts ["-e" "(run-tests)"]}
:bench {:main-opts ["-e" "(bench)"]}}}`)
(spit (string base "/a/deps.edn") `{:paths ["src"]}`)
(spit (string base "/c/deps.edn") `{:paths ["src"]}`)
(spit (string base "/u/deps.edn") `{:paths ["src"]}`)
# user-level config: a :user-tool alias the project file doesn't have, plus a
# :dev alias that the PROJECT's :dev must shadow (per-key merge, project wins)
(spit (string base "/config/deps.edn")
`{:aliases {:user-tool {:extra-deps {my/u {:local/root "BASE/u"}}}
:dev {:extra-paths ["should-not-win"]}}}`)
# :local/root in the user file is relative to... nothing useful; use absolute
(spit (string base "/config/deps.edn")
(string/replace "BASE" base (slurp (string base "/config/deps.edn"))))
(var fails 0)
(defn check [label got expected]
(if (= got expected) (print " ok " label)
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got))))
(defn has-suffix-root [roots suff]
(truthy? (some |(string/has-suffix? suff $) roots)))
(os/cd (string base "/proj"))
(os/setenv "JOLT_CONFIG" (string base "/config"))
(def tree (string base "/proj/jpm_tree"))
# --- no aliases: plain resolution, dev/test/c absent ---------------------------
(def plain (deps/resolve-deps "deps.edn" tree))
(check "plain: project src present" (has-suffix-root plain "/proj/src") true)
(check "plain: dep a present" (has-suffix-root plain "/a/src") true)
(check "plain: alias path absent" (has-suffix-root plain "/proj/dev") false)
(check "plain: alias dep absent" (has-suffix-root plain "/c/src") false)
# --- :dev alias: extra-paths + extra-deps --------------------------------------
(def dev (deps/resolve-deps "deps.edn" tree [:dev]))
(check "dev: extra path present" (has-suffix-root dev "/proj/dev") true)
(check "dev: extra dep present" (has-suffix-root dev "/c/src") true)
(check "dev: base dep still present" (has-suffix-root dev "/a/src") true)
(check "dev: project :dev shadows user :dev"
(has-suffix-root dev "/proj/should-not-win") false)
# --- multiple aliases combine ---------------------------------------------------
(def both (deps/resolve-deps "deps.edn" tree [:dev :test]))
(check "multi: both extra paths"
(and (has-suffix-root both "/proj/dev") (has-suffix-root both "/proj/test")) true)
# --- alias from the USER deps.edn ----------------------------------------------
(def ut (deps/resolve-deps "deps.edn" tree [:user-tool]))
(check "user alias resolves its dep" (has-suffix-root ut "/u/src") true)
# --- main-opts: from alias, last alias wins ------------------------------------
(check "main-opts from alias"
(deps/alias-main-opts "deps.edn" [:test]) ["-e" "(run-tests)"])
(check "main-opts last alias wins"
(deps/alias-main-opts "deps.edn" [:test :bench]) ["-e" "(bench)"])
(check "main-opts absent is nil"
(deps/alias-main-opts "deps.edn" [:dev]) nil)
# --- cached resolution keys on aliases + user config ----------------------------
(check "cache: aliased result differs from plain"
(deep= (deps/resolve-deps-cached "deps.edn" tree)
(deps/resolve-deps-cached "deps.edn" tree [:dev]))
false)
(check "cache: same key returns same roots"
(deep= (deps/resolve-deps-cached "deps.edn" tree [:dev])
(deps/resolve-deps-cached "deps.edn" tree [:dev]))
true)
# --- unknown alias errors --------------------------------------------------------
(check "unknown alias errors"
(let [r (protect (deps/resolve-deps "deps.edn" tree [:nope]))] (r 0))
false)
# --- works without a user config (env unset) ------------------------------------
(os/setenv "JOLT_CONFIG" (string base "/no-such-dir"))
(check "no user config still resolves"
(has-suffix-root (deps/resolve-deps "deps.edn" tree) "/a/src") true)
(os/cd "/")
(rmrf base)
(if (> fails 0)
(error (string "deps-aliases-test: " fails " failing check(s)"))
(print "\nAll deps-aliases tests passed!"))

41
test/integration/deps-cache-args-test.janet
View file

@ -1,41 +0,0 @@
# The deps-image cache must not drop -main's command-line args under
# whole-program (jolt-4mui). A cache HIT swaps the running ctx for the saved
# image; *command-line-args* must be (re)bound from the CURRENT invocation's
# argv, not the stale value baked into the image. Drives the built binary:
# first run builds the cache (arg "first"), second run (cache hit) passes "second"
# — both must echo their own arg. Skips if build/jolt is absent.
(def repo (os/cwd))
(def jolt (string repo "/build/jolt"))
(if-not (os/stat jolt)
(do (print "deps-cache-args: SKIP (no build/jolt)") (os/exit 0)))
(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dca-" (os/time)))
(os/mkdir dir)
(spit (string dir "/echoargs.clj")
"(ns echoargs)\n(defn -main [& args] (println \"GOT\" (pr-str (vec args))))\n")
# fresh per-run image cache dir so the first run is a guaranteed miss
(def imgdir (string dir "/imgcache")) (os/mkdir imgdir)
(each [k v] [["JOLT_DIRECT_LINK" "1"] ["JOLT_WHOLE_PROGRAM" "1"]
["JOLT_PATH" dir] ["JOLT_APP_PATHS" dir] ["JOLT_IMAGE_CACHE_DIR" imgdir]]
(os/setenv k v))
(defn- run [arg]
(def p (os/spawn [jolt "-m" "echoargs" arg] :p {:out :pipe :err :pipe}))
(def out (:read (p :out) :all))
(os/proc-wait p)
(string (or out "")))
(var fails 0)
(defn check [label got want]
(if (string/find want got) (print " ok " label)
(do (++ fails) (printf " FAIL %s: want %p in %p" label want got))))
(def r1 (run "first")) # cache MISS — builds + saves the image
(check "first run passes its arg" r1 `GOT ["first"]`)
(def r2 (run "second")) # cache HIT — must use the NEW arg, not the baked one
(check "second run (cache hit) passes its arg, not the baked one" r2 `GOT ["second"]`)
(defn rmrf [p] (when (os/stat p) (if (= :directory (os/stat p :mode)) (do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p)) (os/rm p))))
(rmrf dir)
(if (> fails 0) (do (printf "deps-cache-args: %d FAILED" fails) (os/exit 1))
(print "deps-cache-args (jolt-4mui) passed!"))

69
test/integration/deps-conflicts-test.janet
View file

@ -1,69 +0,0 @@
# deps.edn conflict semantics (jolt-42f), tools.deps-shaped:
# a TOP-LEVEL :deps entry beats any transitive coordinate for the same lib
# (resolution is breadth-first, top level enqueued first), and when two
# DIFFERENT coordinates for one lib meet, a warning naming both goes to stderr.
# Local deps only: no network.
(import ../../src/jolt/deps :as deps)
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-conflicts-" (os/time)))
(defn rmrf [p]
(when (os/stat p)
(if (= :directory (os/stat p :mode))
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
(os/rm p))))
(rmrf base)
(defn mkdirs [p]
(def abs (string/has-prefix? "/" p))
(var acc nil)
(each seg (filter |(not= "" $) (string/split "/" p))
(set acc (cond (nil? acc) (if abs (string "/" seg) seg) (string acc "/" seg)))
(unless (os/stat acc) (os/mkdir acc))))
# proj depends on A and on B@b2 (top level). A depends on B@b1 (transitive).
# DFS-first-wins would pick b1; tools.deps semantics pick the top-level b2.
(each d ["proj/src" "a/src" "b1/src" "b2/src"] (mkdirs (string base "/" d)))
(spit (string base "/proj/deps.edn")
`{:paths ["src"]
:deps {my/a {:local/root "../a"}
my/b {:local/root "../b2"}}}`)
(spit (string base "/a/deps.edn")
`{:paths ["src"] :deps {my/b {:local/root "../b1"}}}`)
(spit (string base "/b1/deps.edn") `{:paths ["src"]}`)
(spit (string base "/b2/deps.edn") `{:paths ["src"]}`)
(var fails 0)
(defn check [label got expected]
(if (= got expected) (print " ok " label)
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got))))
(defn has-suffix-root [roots suff]
(truthy? (some |(string/has-suffix? suff $) roots)))
(os/cd (string base "/proj"))
(def tree (string base "/proj/jpm_tree"))
(def warn-buf @"")
(def roots (with-dyns [:err warn-buf] (deps/resolve-deps "deps.edn" tree)))
(check "top-level coordinate wins" (has-suffix-root roots "/b2/src") true)
(check "transitive loser not on path" (has-suffix-root roots "/b1/src") false)
(check "dep a still resolved" (has-suffix-root roots "/a/src") true)
(check "conflict warning names the lib"
(truthy? (string/find "my/b" (string warn-buf))) true)
(check "conflict warning names both coordinates"
(and (truthy? (string/find "../b1" (string warn-buf)))
(truthy? (string/find "../b2" (string warn-buf)))) true)
# same coordinate twice from different parents: no warning
(spit (string base "/a/deps.edn")
`{:paths ["src"] :deps {my/b {:local/root "../b2"}}}`)
(def warn2 @"")
(with-dyns [:err warn2] (deps/resolve-deps "deps.edn" tree))
(check "agreeing coordinates warn nothing" (string warn2) "")
(os/cd "/")
(rmrf base)
(if (> fails 0)
(error (string "deps-conflicts-test: " fails " failing check(s)"))
(print "\nAll deps-conflicts tests passed!"))

59
test/integration/deps-conformance-test.janet
View file

@ -1,59 +0,0 @@
# Conformance pass for deps.edn-loaded libraries: resolve a few real, pure-cljc
# git libraries and check that their namespaces load and a sample call works.
#
# Network-gated: set JOLT_CONFORMANCE=1 to run (it clones from GitHub). Skipped by
# default so CI stays offline. Findings are summarized in docs/tools-deps.md.
(use ../../src/jolt/api)
(use ../../src/jolt/types)
(import ../../src/jolt/deps :as deps)
(use ../../src/jolt/reader)
# deps are clj/cljc libraries by definition (the jolt-dw4 premise): read them
# under clj-compat features so their #?(:clj ...) branches resolve (spec
# 02-reader S18 — features are a property of the loading context).
(reader-features-set! ["jolt" "clj" "default"])
(unless (os/getenv "JOLT_CONFORMANCE")
(print "deps-conformance: set JOLT_CONFORMANCE=1 to run (needs network) — skipped")
(os/exit 0))
(def libs
[{:name "medley" :url "https://github.com/weavejester/medley" :tag "1.4.0"
:ns "medley.core" :check "(medley.core/find-first odd? [2 4 5])" :expect "5"}
{:name "cuerdas" :url "https://github.com/funcool/cuerdas" :tag "2022.06.16-403"
:ns "cuerdas.core" :check "(cuerdas.core/kebab \"helloWorld\")" :expect "hello-world"}
{:name "dependency" :url "https://github.com/stuartsierra/dependency" :tag "dependency-1.0.0"
:ns "com.stuartsierra.dependency"
:check "(boolean (com.stuartsierra.dependency/graph))" :expect "true"}])
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-conf-" (os/time)))
(os/mkdir base)
(defn- try-lib [lib]
(def dir (string base "/" (lib :name)))
(os/mkdir dir)
(spit (string dir "/deps.edn")
(string "{:deps {the/lib {:git/url \"" (lib :url) "\" :git/tag \"" (lib :tag) "\"}}}"))
(def prev (os/cwd))
(defer (os/cd prev)
(os/cd dir)
(def r (protect (deps/resolve-deps "deps.edn")))
(if (not (r 0))
[:resolve-failed (string (r 1))]
(let [ctx (init {:paths (r 1)})]
(ctx-set-current-ns ctx "user")
(def lr (protect (eval-string ctx (string "(require (quote [" (lib :ns) "]))"))))
(if (not (lr 0))
[:load-failed (string (lr 1))]
(let [cr (protect (eval-string ctx (lib :check)))]
(cond
(not (cr 0)) [:check-error (string (cr 1))]
(= (string (normalize-pvecs (cr 1))) (lib :expect)) [:ok nil]
[:check-mismatch (string "got " (string (normalize-pvecs (cr 1))))])))))))
(print "deps conformance — pure-cljc git libs:\n")
(each lib libs
(def [status detail] (try (try-lib lib) ([err] [:crash (string err)])))
(printf " %-12s %-16s %s" (lib :name) status (or detail "")))
(print "")
(os/exit 0)

48
test/integration/deps-loader-test.janet
View file

@ -1,48 +0,0 @@
# The loader resolves namespaces against an ordered list of source roots (the
# stdlib first, then deps.edn-resolved dirs), trying .clj then .cljc. This is the
# foundation for loading Clojure libraries via deps.edn — here we point a root at
# a hand-written "library" and require it.
(use ../../src/jolt/api)
(use ../../src/jolt/types)
(def tmp (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-test-" (os/time)))
(os/mkdir tmp)
(os/mkdir (string tmp "/mylib"))
(os/mkdir (string tmp "/other"))
# a .cljc library with its own ns form and a require of a sibling ns
(spit (string tmp "/mylib/core.cljc")
"(ns mylib.core (:require [other.util :as u]))\n(defn double [x] (* 2 x))\n(defn doubled-inc [x] (u/inc1 (double x)))\n")
# a .clj sibling, with a dash in the name (-> underscore in the path)
(os/mkdir (string tmp "/other"))
(spit (string tmp "/other/util.clj") "(ns other.util)\n(defn inc1 [x] (+ x 1))\n")
(def ctx (init {:paths [tmp]}))
(ctx-set-current-ns ctx "user")
(var fails 0)
(defn check [label expr expected]
(let [r (protect (eval-string ctx expr))
got (if (r 0) (normalize-pvecs (r 1)) (string "ERR " (r 1)))]
(if (= got expected)
(print " ok " label)
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got)))))
# require a .cljc lib from the added root and call it
(check "require .cljc lib" "(do (require (quote [mylib.core :as m])) (m/double 21))" 42)
# transitive require (mylib.core requires other.util) resolved from the root too
(check "transitive .clj require" "(mylib.core/doubled-inc 10)" 21)
# the stdlib still resolves from its default root
(check "stdlib still loads" "(do (require (quote [jolt.interop :as j])) (j/janet-type 1))" :number)
# clean up
(defn rmrf [p]
(if (= :directory (os/stat p :mode))
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
(os/rm p)))
(rmrf tmp)
(if (> fails 0)
(error (string "deps-loader-test: " fails " failing check(s)"))
(print "\nAll deps-loader tests passed!"))

98
test/integration/deps-merged-cli-test.janet
View file

@ -1,98 +0,0 @@
# jolt-deps folded into jolt: the single `jolt` binary resolves a deps.edn into
# JOLT_PATH in-process and dispatches the deps subcommands (path/-M/run/tasks/
# task), and auto-resolves a deps.edn for runnable commands (repl/-m/-e/FILE).
# Drives the BUILT binary (baked overlay -> cwd-independent) from a fixture
# project dir so deps.edn in cwd is picked up. :local/root deps only — no
# network. Skips cleanly if build/jolt is absent (source-only run).
(def repo-root (os/cwd))
(def jolt (string repo-root "/build/jolt"))
(if-not (os/stat jolt)
(do (print "deps-merged-cli: SKIP (no build/jolt — run from source)") (os/exit 0)))
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-merged-cli-" (os/time)))
(defn rmrf [p]
(when (os/stat p)
(if (= :directory (os/stat p :mode))
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
(os/rm p))))
(rmrf base)
(defn mkdirs [p]
(var acc nil)
(each seg (filter |(not= "" $) (string/split "/" p))
(set acc (if (nil? acc) (string "/" seg) (string acc "/" seg)))
(unless (os/stat acc) (os/mkdir acc))))
# project depends on a local lib; an alias with :main-opts; an :extra-paths
# alias; a :tasks map (shell task)
(each d ["proj/src/app" "lib/src/mylib"] (mkdirs (string base "/" d)))
(spit (string base "/proj/deps.edn")
`{:paths ["src"]
:deps {my/lib {:local/root "../lib"}}
:aliases {:run {:main-opts ["-m" "app.core"]}
:dev {:extra-paths ["dev"]}}
:tasks {greet "echo hello-task"}}`)
(spit (string base "/lib/deps.edn") `{:paths ["src"]}`)
(spit (string base "/lib/src/mylib/core.clj") "(ns mylib.core)\n(defn answer [] 42)\n")
(spit (string base "/proj/src/app/core.clj")
"(ns app.core (:require [mylib.core :as m]))\n(defn -main [& args] (println \"MAIN\" (m/answer) (count args)))\n")
(spit (string base "/proj/script.clj")
"(require '[mylib.core :as m])\n(println \"SCRIPT\" (m/answer))\n")
# Run the built jolt from a given dir (cwd matters: deps.edn is read from cwd).
# Direct spawn (no shell) so arbitrary -e exprs need no quoting. Returns out+err.
(defn- run-in [dir & args]
(def prev (os/cwd))
(os/cd dir)
(def p (os/spawn [jolt ;args] :p {:out :pipe :err :pipe}))
(def out (:read (p :out) :all))
(def err (:read (p :err) :all))
(os/proc-wait p)
(os/cd prev)
(string (or out "") (or err "")))
(var fails 0)
(defn check [label got pred]
(if (pred got) (print " ok " label)
(do (++ fails) (printf " FAIL %s: got %q" label got))))
(defn- has [sub] (fn [s] (truthy? (string/find sub s))))
(def proj (string base "/proj"))
# `path` prints the resolved roots: project's own src + the local dep's src
(check "path includes project src" (run-in proj "path") (has "/proj/src"))
(check "path includes local dep src" (run-in proj "path") (has "/lib/src"))
# `-M:run` runs the alias :main-opts (-m app.core), requiring the local dep
(check "-M:run runs -main through resolved deps" (run-in proj "-M:run" "x" "y") (has "MAIN 42 2"))
# `run FILE` resolves deps then runs the file
(check "run FILE resolves deps" (run-in proj "run" "script.clj") (has "SCRIPT 42"))
# `tasks` lists the :tasks entries; `task NAME` runs a shell task
(check "tasks lists greet" (run-in proj "tasks") (has "greet"))
(check "task runs shell command" (run-in proj "task" "greet") (has "hello-task"))
# auto-resolve: a plain -e in a deps.edn dir can require the local dep
(check "-e auto-resolves deps.edn in cwd"
(run-in proj "-e" "(require '[mylib.core :as m]) (println (m/answer))")
(has "42"))
# -A:alias forces resolution (with that alias) for a runnable command
(check "-A:dev with -e resolves + runs"
(run-in proj "-A:dev" "-e" "(println (+ 1 2))")
(has "3"))
# no deps.edn: plain run is unaffected (resolver/jpm never touched)
(mkdirs (string base "/plain"))
(check "-e in a no-deps dir works unchanged"
(run-in (string base "/plain") "-e" "(println (* 6 7))")
(has "42"))
# help/version never trigger resolution
(check "version works in a deps dir" (run-in proj "--version") (has "jolt v"))
(rmrf base)
(if (> fails 0)
(do (printf "deps-merged-cli: %d FAILED" fails) (os/exit 1))
(print "deps-merged-cli: all cases passed"))

156
test/integration/deps-resolve-test.janet
View file

@ -1,156 +0,0 @@
# deps.edn resolution into source roots, then loading a library through them.
# Uses :local/root deps only so it needs no network (the git path is the same
# code, exercised manually against real repos).
(use ../../src/jolt/api)
(use ../../src/jolt/types)
(import ../../src/jolt/deps :as deps)
# Captured before any os/cd: subprocess tests below re-import src/jolt/deps.
(def repo-root (os/cwd))
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-resolve-" (os/time)))
(defn rmrf [p]
(when (os/stat p)
(if (= :directory (os/stat p :mode))
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
(os/rm p))))
(rmrf base)
(defn mkdirs [p]
(def abs (string/has-prefix? "/" p))
(var acc nil)
(each seg (filter |(not= "" $) (string/split "/" p))
(set acc (cond (nil? acc) (if abs (string "/" seg) seg) (string acc "/" seg)))
(unless (os/stat acc) (os/mkdir acc))))
# project -> depends on lib-a (local), which depends on lib-b (local, transitive)
(each d ["proj/src" "a/src/liba" "b/src/libb"] (mkdirs (string base "/" d)))
(spit (string base "/proj/deps.edn") `{:paths ["src"] :deps {my/a {:local/root "../a"}}}`)
(spit (string base "/a/deps.edn") `{:paths ["src"] :deps {my/b {:local/root "../b"}}}`)
(spit (string base "/b/deps.edn") `{:paths ["src"]}`)
(spit (string base "/a/src/liba/core.clj") "(ns liba.core (:require [libb.core :as b]))\n(defn val [] (b/n))\n")
(spit (string base "/b/src/libb/core.clj") "(ns libb.core)\n(defn n [] 99)\n")
(var fails 0)
(defn check [label got expected]
(if (= got expected) (print " ok " label)
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got))))
(os/cd (string base "/proj"))
(def roots (deps/resolve-deps "deps.edn" (string base "/proj/jpm_tree")))
# roots: proj/src, a/src (transitive: b/src) — at least the two dep srcs present
(check "resolves transitive local dep roots"
(truthy? (and (some |(string/has-suffix? "/a/src" $) roots)
(some |(string/has-suffix? "/b/src" $) roots)))
true)
# load through the resolved roots: liba.core requires libb.core transitively
(def ctx (init {:paths roots}))
(ctx-set-current-ns ctx "user")
(let [r (protect (eval-string ctx "(do (require (quote [liba.core :as a])) (a/val))"))]
(check "require local lib + transitive dep" (if (r 0) (r 1) (string "ERR " (r 1))) 99))
# cached resolution returns the same roots without re-walking
(check "cached resolve matches"
(deep= roots (deps/resolve-deps-cached "deps.edn" (string base "/proj/jpm_tree")))
true)
# The cache must hit across PROCESSES: janet's (hash ...) is seeded per process,
# so a key built with it never matches a cached one and every invocation
# re-resolved (and re-fetched git deps). Detection: plant a sentinel root in the
# cache file — a fresh process that hits the cache returns it; a process that
# misses re-resolves and overwrites it.
(os/cd (string base "/proj"))
(def cache-file ".cpcache/jolt-deps.jdn")
(def cached-now (parse (slurp cache-file)))
(spit cache-file
(string/format "%j" (merge cached-now
{:roots [;(get cached-now :roots) "/SENTINEL"]})))
(defn subprocess-roots []
(def code
(string `(os/cd "` repo-root `") `
`(import ./src/jolt/deps :as deps) `
`(os/cd "` base "/proj" `") `
`(print (string/join (deps/resolve-deps-cached "deps.edn" "` base "/proj/jpm_tree" `") ":"))`))
(def p (os/spawn ["janet" "-e" code] :px {:out :pipe}))
(def out (ev/read (p :out) :all))
(os/proc-wait p)
(string/trim (string out)))
(check "cache hits across processes"
(string/has-suffix? "/SENTINEL" (subprocess-roots))
true)
(os/cd "/")
(rmrf base)
# Git-dep resolution must keep stdout clean: `JOLT_PATH=$(jolt-deps path)` is
# the documented capture, and git's checkout chatter ("HEAD is now at …") was
# corrupting it. Uses a file:// git dep so no network is needed.
(def gbase (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-gitout-" (os/time)))
(rmrf gbase)
(each d ["lib/src/glib" "proj2"] (mkdirs (string gbase "/" d)))
(spit (string gbase "/lib/src/glib/core.clj") "(ns glib.core)\n(defn n [] 7)\n")
(spit (string gbase "/lib/deps.edn") `{:paths ["src"]}`)
(defn sh-out [args &opt cwd]
(def p (os/spawn args :px {:out :pipe :err :pipe :cd (or cwd ".")}))
(def out (ev/read (p :out) :all))
(os/proc-wait p)
(string/trim (string out)))
(def git-ok
(truthy?
(protect
(do (sh-out ["git" "-c" "init.defaultBranch=master" "init"] (string gbase "/lib"))
(sh-out ["git" "add" "-A"] (string gbase "/lib"))
(sh-out ["git" "-c" "user.email=t@t" "-c" "user.name=t" "commit" "-m" "init" "-q"]
(string gbase "/lib"))))))
(if (not git-ok)
(print " skip git-dep stdout test (git unavailable)")
(do
(def sha (sh-out ["git" "rev-parse" "HEAD"] (string gbase "/lib")))
(spit (string gbase "/proj2/deps.edn")
(string `{:paths ["src"] :deps {my/glib {:git/url "file://` gbase `/lib" :git/sha "` sha `"}}}`))
(os/setenv "JOLT_GITLIBS" (string gbase "/gitlibs"))
(def code
(string `(os/cd "` repo-root `") `
`(import ./src/jolt/deps :as deps) `
`(os/cd "` gbase "/proj2" `") `
`(deps/resolve-deps "deps.edn" "` gbase "/proj2/jpm_tree" `") `
`(eprint "done")`))
(def p (os/spawn ["janet" "-e" code] :px {:out :pipe}))
(def out (ev/read (p :out) :all))
(os/proc-wait p)
(os/setenv "JOLT_GITLIBS" nil)
(check "git-dep resolution keeps stdout clean" (string (or out "")) ""))
)
(rmrf gbase)
# --- :jpm/module deps: janet libraries installed through jpm -----------------
# Verification only (jpm owns installation): an importable module passes and
# contributes no roots; a missing one errors with the install hint. jpm/pm is
# always importable wherever jpm itself runs (CI included).
(do
(def jbase (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-jpm-" (os/time)))
(mkdirs (string jbase "/src"))
(spit (string jbase "/deps.edn")
`{:paths ["src"] :deps {janet/jpm-pm {:jpm/module "jpm/pm"}}}`)
(def cwd (os/cwd))
(os/cd jbase)
(def roots (deps/resolve-deps "deps.edn" (string jbase "/jpm_tree")))
(os/cd cwd)
(check "jpm module dep resolves" true (not (nil? roots)))
(check "jpm module contributes no roots" 1 (length roots))
(spit (string jbase "/deps.edn")
`{:paths ["src"] :deps {janet/nope {:jpm/module "no/such-module-xyz"}}}`)
(os/cd jbase)
(def r (protect (deps/resolve-deps "deps.edn" (string jbase "/jpm_tree"))))
(os/cd cwd)
(check "missing jpm module errors" false (r 0))
(check "error carries the install hint" true
(not (nil? (string/find "jpm install" (string (r 1))))))
(rmrf jbase))
(if (> fails 0)
(error (string "deps-resolve-test: " fails " failing check(s)"))
(print "\nAll deps-resolve tests passed!"))

89
test/integration/deps-tasks-test.janet
View file

@ -1,89 +0,0 @@
# deps.edn :tasks (jolt-x4o) + the global gitlibs-style clone cache default
# (jolt-xkd). Tasks are the honest subset of babashka's: a STRING task is a
# shell command; a MAP task carries :main-opts (jolt args) and optional :doc.
# Local-only: no network, no jolt binary — the CLI wrappers stay thin.
(import ../../src/jolt/deps :as deps)
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-deps-tasks-" (os/time)))
(defn rmrf [p]
(when (os/stat p)
(if (= :directory (os/stat p :mode))
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
(os/rm p))))
(rmrf base)
(defn mkdirs [p]
(def abs (string/has-prefix? "/" p))
(var acc nil)
(each seg (filter |(not= "" $) (string/split "/" p))
(set acc (cond (nil? acc) (if abs (string "/" seg) seg) (string acc "/" seg)))
(unless (os/stat acc) (os/mkdir acc))))
(each d ["proj/src" "config"] (mkdirs (string base "/" d)))
(spit (string base "/proj/deps.edn")
`{:paths ["src"]
:tasks {clean "rm -rf target"
test {:doc "run the suite" :main-opts ["-e" "(run-tests)"]}
fmt {:main-opts ["-e" "(fmt)"]}}}`)
# user-level task, and a project-shadowed name
(spit (string base "/config/deps.edn")
`{:tasks {lint "echo lint" clean "echo SHADOWED"}}`)
(var fails 0)
(defn check [label got expected]
(if (= got expected) (print " ok " label)
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got))))
(os/cd (string base "/proj"))
(os/setenv "JOLT_CONFIG" (string base "/config"))
# --- task listing (merged user+project, sorted) ---------------------------------
(def listing (deps/tasks "deps.edn"))
(check "lists all task names"
(tuple ;(sort (map first listing))) ["clean" "fmt" "lint" "test"])
(check "doc shows in listing"
(truthy? (some |(and (= (first $) "test") (= (get $ 1) "run the suite")) listing))
true)
# --- task lookup ------------------------------------------------------------------
(check "string task is shell"
(deps/task-spec "deps.edn" "clean") {:type :shell :cmd "rm -rf target"})
(check "project task shadows user task"
(get (deps/task-spec "deps.edn" "clean") :cmd) "rm -rf target")
(check "map task is jolt argv"
(deps/task-spec "deps.edn" "test") {:type :jolt :argv ["-e" "(run-tests)"]})
(check "user-level task visible"
(deps/task-spec "deps.edn" "lint") {:type :shell :cmd "echo lint"})
(check "unknown task is nil"
(deps/task-spec "deps.edn" "nope") nil)
# --- tasks resolve with NO user config (regression: load-config skipped the
# name re-keying when only the project file existed) -----------------------------
(os/setenv "JOLT_CONFIG" (string base "/no-such-dir"))
(check "task works without user config"
(deps/task-spec "deps.edn" "clean") {:type :shell :cmd "rm -rf target"})
(check "listing works without user config"
(tuple ;(sort (map first (deps/tasks "deps.edn")))) ["clean" "fmt" "test"])
(os/setenv "JOLT_CONFIG" (string base "/config"))
# --- global clone-tree default (jolt-xkd) ----------------------------------------
# resolution with :local deps never clones, but the default tree dir must come
# from $JOLT_GITLIBS (else (config-dir)/gitlibs), not ./jpm_tree
(os/setenv "JOLT_GITLIBS" (string base "/deep/nested/gitlibs"))
(deps/resolve-deps "deps.edn")
(check "JOLT_GITLIBS dir created (parents too)"
(truthy? (os/stat (string base "/deep/nested/gitlibs"))) true)
(check "no per-project jpm_tree" (os/stat (string base "/proj/jpm_tree")) nil)
# roots cache is project-local .cpcache, not inside the clone tree
(deps/resolve-deps-cached "deps.edn")
(check "roots cache in ./.cpcache"
(truthy? (os/stat (string base "/proj/.cpcache/jolt-deps.jdn"))) true)
(os/setenv "JOLT_GITLIBS" "")
(os/cd "/")
(rmrf base)
(if (> fails 0)
(error (string "deps-tasks-test: " fails " failing check(s)"))
(print "\nAll deps-tasks tests passed!"))

43
test/integration/devirt-test.janet
View file

@ -1,43 +0,0 @@
# Protocol-dispatch devirtualization (jolt-41m): when the inference proves a
# protocol call's receiver is a known record type, the call is compiled to a
# DIRECT method call, skipping the runtime dispatch registry. This must stay
# SOUND — same results as the dispatched path — including polymorphic dispatch
# (the right method per type), fallback when the receiver type is unknown, and
# heterogeneous collections. Runs a protocol+record program through the built
# binary (devirt needs infer-unit!, which runs on ns load, not eval-string) and
# checks the output. Skips cleanly if build/jolt is absent.
(def jolt "build/jolt")
(defn- run [whole?]
(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dv-test"))
(os/mkdir dir)
(spit (string dir "/dv.clj")
(string
"(ns dv)\n"
"(defprotocol Shape (area [s]) (kind [s]))\n"
"(defrecord Rect [w h] Shape (area [r] (* (:w r) (:h r))) (kind [_] :rect))\n"
"(defrecord Circ [r] Shape (area [c] (* 3 (:r c) (:r c))) (kind [_] :circ))\n"
"(defn poly [s] (area s))\n" # receiver unknown -> must fall back
"(defn -main []\n"
" (println (area (->Rect 3 4)) (area (->Circ 5))\n" # devirt: 12 75
" (kind (->Rect 1 1)) (kind (->Circ 1))\n" # devirt: :rect :circ
" (poly (->Rect 3 4)) (poly (->Circ 5))\n" # fallback: 12 75
" (mapv area [(->Rect 2 3) (->Circ 2)])))\n")) # heterogeneous: [6 12]
(def out (string dir "/out.txt"))
(def jbin (string (os/cwd) "/" jolt))
# -m auto-enables whole-program under direct-linking now, so the per-ns case
# (whole? false) must explicitly opt out to test the dispatched/per-ns path.
(def cmd (string (if whole? "JOLT_WHOLE_PROGRAM=1 " "JOLT_NO_WHOLE_PROGRAM=1 ")
"JOLT_DIRECT_LINK=1 JOLT_PATH=" dir " " jbin " -m dv > " out " 2>&1"))
(os/execute ["sh" "-c" cmd] :p)
(string/trimr (slurp out)))
(def expected "12 75 :rect :circ 12 75 [6 12]")
(if (not (os/stat jolt))
(print "devirt: SKIP (no build/jolt — run from source)")
(let [per-ns (run false) whole (run true)]
(printf " per-ns: %s" per-ns)
(printf " whole-program: %s" whole)
(if (and (= per-ns expected) (= whole expected))
(print "devirt: correct (dispatched == devirtualized)")
(do (printf "devirt: WRONG — expected %q" expected) (os/exit 1)))))

76
test/integration/direct-linking-test.janet
View file

@ -1,76 +0,0 @@
# Direct-linking / redefinition matrix (jolt-d9j, jolt-g86).
#
# Direct-linking is a per-compilation-UNIT property (Clojure model). A call
# compiles direct iff the unit has direct-linking on AND the target is not
# ^:redef/^:dynamic AND the target is an already-defined fn. Otherwise indirect
# (live var deref → redefinable). This pins the user-visible semantics:
# - default user/REPL unit (direct-linking off): redefine anything, callers see it
# - direct-linked unit: callers don't see a later redef (unless target ^:redef)
# - :aot-core? gates whether the core tiers compile direct-linked
(use ../../src/jolt/api)
(var failures 0)
(defn- check [label got want]
(unless (= got want)
(++ failures)
(printf "FAIL [%s] got %q want %q" label got want)))
# 1. Default unit (direct-linking OFF): redefinition reaches compiled callers.
(let [ctx (init {:compile? true})]
(eval-string ctx "(defn add [a b] (+ a b))")
(eval-string ctx "(defn caller [] (add 1 2))")
(check "default before redef" (eval-string ctx "(caller)") 3)
(eval-string ctx "(defn add [a b] (* a b))")
(check "default sees redef (indirect)" (eval-string ctx "(caller)") 2))
# 2. Direct-linked unit: compiled caller keeps the original target after a redef.
(let [ctx (init {:compile? true :direct-linking? true})]
(eval-string ctx "(defn add [a b] (+ a b))")
(eval-string ctx "(defn caller [] (add 1 2))")
(check "direct before redef" (eval-string ctx "(caller)") 3)
(eval-string ctx "(defn add [a b] (* a b))")
(check "direct ignores redef (sealed)" (eval-string ctx "(caller)") 3)
# the var itself is still redefined; only the direct-linked call is frozen
(check "direct var still updated" (eval-string ctx "(add 3 4)") 12))
# 3. ^:redef opts a var OUT of direct-linking even in a direct-linked unit.
(let [ctx (init {:compile? true :direct-linking? true})]
(eval-string ctx "(defn ^:redef add [a b] (+ a b))")
(eval-string ctx "(defn caller [] (add 1 2))")
(check "redef-tagged before" (eval-string ctx "(caller)") 3)
(eval-string ctx "(defn ^:redef add [a b] (* a b))")
(check "redef-tagged sees redef" (eval-string ctx "(caller)") 2))
# 4. :aot-core? true (default): redefining a core fn (in clojure.core) is still
# seen by USER code, because user calls are indirect regardless of core being
# direct-linked internally.
(let [ctx (init {:compile? true})]
(eval-string ctx "(defn uses-last [] (last [1 2 3]))")
(check "core call before" (eval-string ctx "(uses-last)") 3)
(eval-string ctx "(in-ns (quote clojure.core))")
(eval-string ctx "(def last (fn [coll] :patched))")
(eval-string ctx "(in-ns (quote user))")
(check "user sees core redef (indirect)" (eval-string ctx "(uses-last)") :patched))
# 5. :aot-core? false: core compiles indirect too, so even core-internal callers
# see a redef — the whole language is redefinable.
(let [ctx (init {:compile? true :aot-core? false})]
(check "aot-core off still correct" (eval-string ctx "(last [1 2 3])") 3))
# 6. Redefining a record with REORDERED fields must rebind the ctor (jolt-wf4).
# deftype expands to (do (def R (make-deftype-ctor ...)) (def ->R R) ...): the
# `->R` alias references R in the SAME compiled unit. Direct-link embeds a var's
# root as a compile-time constant, but R's redefined root hasn't RUN yet when
# that unit compiles — so ->R must NOT seal to R's stale (pre-redef) ctor.
(let [ctx (init {:compile? true :direct-linking? true})]
(eval-string ctx "(defrecord R [x a])")
(eval-string ctx "(defrecord R [a x])")
(check "record field-reorder redefine: :a reads the new layout"
(eval-string ctx "(:a (->R 10 20))") 10)
(check "record field-reorder redefine: :x reads the new layout"
(eval-string ctx "(:x (->R 10 20))") 20))
(if (pos? failures)
(do (printf "direct-linking: %d failure(s)" failures) (os/exit 1))
(print "direct-linking: all matrix cases passed"))

51
test/integration/dispatch-cache-test.janet
View file

@ -1,51 +0,0 @@
# Protocol host-value dispatch cache (jolt-4ay).
#
# Host-value protocol dispatch used to recompute the candidate type-tag list and
# walk the registry on every call. It's now a generation-guarded cache keyed by
# (most-specific-host-tag, protocol, method); registering a protocol impl bumps
# the registry generation and invalidates it. This pins correctness: the cache
# must never hide a re-extension.
(use ../../src/jolt/api)
(var failures 0)
(defn- check [label got want]
(unless (= got want)
(++ failures)
(printf "FAIL [%s] got %q want %q" label got want)))
(each mode [{:compile? true} {} {:aot-core? false}]
(def ctx (init-cached mode))
(eval-string ctx "(defprotocol P (m [x]))")
(eval-string ctx "(extend-protocol P Number (m [x] (* x 2)))")
(check (string mode " host dispatch") (eval-string ctx "(m 5)") 10)
(check (string mode " cache hit (same class)") (eval-string ctx "(m 7)") 14)
# Re-extend: registry generation bumps, cache must invalidate.
(eval-string ctx "(extend-protocol P Number (m [x] (+ x 100)))")
(check (string mode " sees re-extension") (eval-string ctx "(m 5)") 105)
# Extending a different host class bumps gen too; number impl re-resolves.
(eval-string ctx "(extend-protocol P String (m [x] (str \"s:\" x)))")
(check (string mode " other class") (eval-string ctx "(m \"hi\")") "s:hi")
(check (string mode " number after other-class extend") (eval-string ctx "(m 3)") 103))
# Multimethod hierarchy-fallback cache (jolt-g8w): the isa? walk result for a
# dispatch value is cached; defmethod/remove-method must invalidate it.
(each mode [{:compile? true} {} {:aot-core? false}]
(def ctx (init-cached mode))
(eval-string ctx "(derive ::circle ::shape)")
(eval-string ctx "(derive ::square ::shape)")
(eval-string ctx "(defmulti area identity)")
(eval-string ctx "(defmethod area ::shape [_] :generic)")
(check (string mode " mm hierarchy") (eval-string ctx "(area ::circle)") :generic)
(check (string mode " mm cache hit") (eval-string ctx "(area ::circle)") :generic)
# adding a more specific method must invalidate the cached hierarchy result
(eval-string ctx "(defmethod area ::circle [_] :specific)")
(check (string mode " mm sees new method") (eval-string ctx "(area ::circle)") :specific)
(check (string mode " mm other still hierarchy") (eval-string ctx "(area ::square)") :generic)
# removing it must re-expose the hierarchy fallback
(eval-string ctx "(remove-method area ::circle)")
(check (string mode " mm sees removal") (eval-string ctx "(area ::circle)") :generic))
(if (pos? failures)
(do (printf "dispatch-cache: %d failure(s)" failures) (os/exit 1))
(print "dispatch-cache: all cases passed (compile, interpret, aot-core off)"))

33
test/integration/embedded-stdlib-test.janet
View file

@ -1,33 +0,0 @@
# The .clj stdlib (clojure.string, clojure.set, jolt.interop, …) is baked into the
# image at build time, so it loads even when the files aren't on disk. We simulate
# the shipped-binary-elsewhere case by clearing the filesystem source roots, so a
# require can only be satisfied by the embedded copy.
(use ../../src/jolt/api)
(use ../../src/jolt/types)
(def ctx (init-cached))
(ctx-set-current-ns ctx "user")
(put (ctx :env) :source-paths @[]) # no FS roots — embedded fallback only
(var fails 0)
(defn check [label expr expected]
(let [r (protect (eval-string ctx expr))
got (if (r 0) (normalize-pvecs (r 1)) (string "ERR " (r 1)))]
(if (= got expected) (print " ok " label)
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got)))))
(assert (> (length (get (ctx :env) :embedded-sources)) 0) "embedded-sources should be populated")
(check "clojure.string from embedded"
"(do (require (quote [clojure.string :as s])) (s/upper-case \"hi\"))" "HI")
(check "clojure.set from embedded"
"(do (require (quote [clojure.set :as set])) (vec (set/union #{1} #{2})))" [2 1])
(check "clojure.walk from embedded"
"(do (require (quote [clojure.walk :as w])) (w/keywordize-keys {\"a\" 1}))" {:a 1})
(check "jolt.interop from embedded"
"(do (require (quote [jolt.interop :as j])) (j/janet-type 1))" :number)
(if (> fails 0)
(error (string "embedded-stdlib-test: " fails " failing check(s)"))
(print "\nAll embedded-stdlib tests passed!"))

131
test/integration/fallback-zero-test.janet
View file

@ -1,131 +0,0 @@
# Fallback-zero verification (Stage 1 Task 3).
#
# self-host-test.janet checks observable RESULTS but not WHICH path ran — a form
# that silently fell back to the interpreter still "passes" there. This harness
# checks the path: it runs the portable analyzer (jolt.analyzer/analyze, via
# backend/analyze-form) on a corpus of NON-STATEFUL forms and asserts NONE raise
# :jolt/uncompilable — i.e. the self-hosted analyzer actually COMPILED them.
#
# As analyzer↔compiler.janet parity grows (Stage 1), move forms from the
# "intentional fallback" sanity list into the must-compile corpus. The day the
# fallback set equals the frozen intentional stateful set, the Janet bootstrap
# compiler is retireable.
#
# Mechanism: backend/analyze-form throws (a "jolt/uncompilable: …" string) for a
# punted form; (protect …) turns that into [false msg]. [true ir] == compiled.
(import ../../src/jolt/backend :as backend)
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(def ctx (init-cached))
(defn- analyzes? [s]
# true if the form COMPILES end to end (analyzer IR + back end emit), false if
# it punts to the interpreter. Checks emit-ir too, not just analyze-form: letfn
# and (def x) with no init now ANALYZE to IR, but the Janet back end punts them
# at emit time (sequential let* can't express mutual recursion; an unbound var
# is not a compiled value) — so analyze-form alone would miss the real
# compile-vs-interpret decision that compile-and-eval makes.
(def r (protect (backend/emit-ir ctx (backend/analyze-form ctx (parse-string s)))))
(and (r 0) true))
# --- Must compile: pure, non-stateful value production. NONE may punt. ---
(def must-compile
[# set literals (Task 1)
"#{1 2 3}" "#{}" "#{:a :b :c}" "#{(inc 0) 2}" "(conj #{1 2} 3)"
"[#{1 2} {:s #{3}}]" "(let [x 5] #{x (inc x)})"
# other literals
"[1 2 3]" "{:a 1 :b 2}" "{:k (inc 0)}" "[[1] [2 3]]" "42" ":kw" "\"str\""
# control flow + binding
"(+ 1 2)" "(if true 1 2)" "(do 1 2 3)" "(let [a 1 b 2] (+ a b))"
"(fn [x] (* x x))" "(fn ([a] a) ([a b] (+ a b)))"
"(loop [i 0] (if (< i 3) (recur (inc i)) i))"
"(quote (a b c))" "(throw (ex-info \"x\" {}))"
"(try (inc 1) (catch :default e e))"
# def + calls into core
"(def answer 42)" "(map inc [1 2 3])" "(reduce + 0 [1 2 3])"
"(get {:a 1} :a)" "(vec (range 5))"
# set?/disj are plain fns now, not special forms (jolt-g3h)
"(set? #{1 2})" "(disj #{1 2 3} 2)"
# Stage 2 (jolt-eaa): stateful forms moved onto the compile path. (binding only
# compiles over an INTERNED var; the built-in dynamic vars aren't interned yet,
# so it's exercised end-to-end in the state spec instead.)
"(require (quote [clojure.string :as s]))" "(in-ns (quote foo.bar))"
"(ns foo.bar (:require [clojure.string :as s]))"
"(defprotocol P (m [x]))" "(extend-type Long P (m [x] x))"
"(reify P (m [this] 1))" "(var map)"
# Stage 2 tier 5: type/dispatch definitional forms compile too
"(deftype Pt [x y])" "(deftype Sq [s] P (m [this] s))"
"(defrecord Rec [a b])" "(defmulti mf :k)" "(defmethod mf :a [x] x)"
# Stage 2 tier 6: var fns are ordinary invokes now
"(var-get (var map))" "(var? (var map))" "(var-set (var map) map)"
"(alter-var-root (var map) identity)" "(find-var (quote clojure.core/map))"
"(intern (quote user) (quote tier6-sym) 42)"
"(alter-meta! (var map) assoc :k 1)" "(reset-meta! (var map) {})"
# Stage 2 tier 6b: ns-introspection fns are ordinary invokes now
"(find-ns (quote clojure.core))" "(create-ns (quote t6.created))"
"(remove-ns (quote t6.created))" "(count (all-ns))"
"(the-ns (quote clojure.core))" "(ns-interns (quote clojure.core))"
"(ns-aliases (quote user))" "(ns-imports (quote user))"
"(ns-resolve (quote clojure.core) (quote map))" "(resolve (quote map))"
"(refer (quote clojure.string))"
# Stage 2 tier 6c: dispatch-table ops + misc compile as macros/plain invokes
"(prefer-method mf :a :b)" "(remove-method mf :a)" "(remove-all-methods mf)"
# get-method/methods take the multimethod VALUE (Clojure semantics), so the
# arg must resolve — use a real multifn (print-method) rather than the
# never-defined mf the isolated analyzer can't resolve.
"(get-method print-method :default)" "(methods print-method)"
"(satisfies? P 5)" "(instance? String \"x\")" "(locking :x 1)"
"(defonce fz-once 1)" "(read-string \"[1 2]\")"
"(macroexpand-1 (quote (when true 1)))"])
# --- THE FROZEN PUNT SET (Stage 2 complete) ---------------------------------
# These are the ONLY heads that may reach the interpreter, exhaustively:
# defmacro — definitional host seam (the EXPANDERS are compiled;
# see backend/recompile-macros!)
# set! — host var-cell mutation special
# letfn — analyzes to a :letrec IR node now (inc 3g), but the Janet
# back end still punts it at emit: its sequential let* can't
# express the mutual recursion. The Chez back end DOES
# compile it (letrec*). Janet stays interpret until emit-let
# gains a letrec lowering.
# eval — compile-and-run entry (also loader stateful-head?)
# . / new / Foo. / — thin host-interop heads the back end doesn't model
# .method — analyzes to a :host-call IR node now (inc 3h), but the
# Janet back end punts it at emit (no interop model). The
# Chez back end DOES lower it (jolt-host-call). Same shape as
# letfn: compiles on Chez, interprets on Janet.
# .-field — field access stays punted at analyze (form-special?)
# gen-class, monitor-enter, monitor-exit — JVM-compat stubs
# Growing this list is a REGRESSION: a new punt means the compiler lost
# coverage. Shrinking it (e.g. letfn via letrec IR) is progress — move the
# form to must-compile.
(def must-punt
["(defmacro m [x] x)"
"(set! *warn-on-reflection* true)"
"(letfn [(f [n] (g n)) (g [n] (f n))] (f 1))"
"(eval (quote (+ 1 2)))"
# .method analyzes to :host-call now; a resolvable target ("x") makes it punt
# at EMIT (the interop reason), not at analyze (an unresolved target).
"(.toUpperCase \"x\")"
"(.-field obj)"
"(new Foo 1)"
"(Foo. 1)"
"(gen-class :name X)"
"(monitor-enter x)"
"(monitor-exit x)"])
(var fails @[])
(each s must-compile
(unless (analyzes? s) (array/push fails (string "FALLBACK (should compile): " s))))
(each s must-punt
(when (analyzes? s) (array/push fails (string "COMPILED (should punt): " s))))
(printf "fallback-zero: %d must-compile + %d must-punt — %d failures"
(length must-compile) (length must-punt) (length fails))
(when (> (length fails) 0)
(print "\nFailures:")
(each f fails (printf " %s" f))
(os/exit 1))
(print "fallback-zero: OK (analyzer compiled the full non-stateful corpus)")

147
test/integration/features-test.janet
View file

@ -1,147 +0,0 @@
# Feature regression tests: a broad sweep of Clojure features (destructuring,
# multimethods, protocols, laziness, …). Each case asserts (= expected actual)
# evaluated inside Jolt (so comparisons use Jolt's own Clojure-semantics =).
# Run via `jpm test`.
(use ../../src/jolt/api)
(var pass 0)
(def fails @[])
(defn check [label expected actual]
# evaluate (= expected actual) in a fresh ctx; expects boolean true
(def ctx (init-cached))
(def res (protect (eval-string ctx (string "(= " expected " " actual ")"))))
(cond
(not= (res 0) true)
(array/push fails [label "ERROR" (string (res 1))])
(= (res 1) true)
(++ pass)
(let [got (protect (eval-string (init-cached) actual))]
(array/push fails [label "NEQ"
(string "want=" expected " got="
(if (= (got 0) true) (string/format "%q" (got 1)) (string "ERR:" (got 1))))]))))
(def cases
[
### 1. Destructuring
["destr seq" "[10 20 30]" "(let [[a b c] [10 20 30]] [a b c])"]
["destr map :or" "[\"Alice\" 30 \"Unknown\"]"
"(let [{:keys [name age city] :or {city \"Unknown\"}} {:name \"Alice\" :age 30}] [name age city])"]
["destr nested map" "[1.0 2.5]" "(let [{[x y] :coords} {:coords [1.0 2.5]}] [x y])"]
["destr :as" "[1 [1 2 3]]" "(let [[a :as all] [1 2 3]] [a all])"]
["destr & rest" "[1 (quote (2 3))]" "(let [[a & r] [1 2 3]] [a r])"]
["destr :strs" "[1 2]" "(let [{:strs [a b]} {\"a\" 1 \"b\" 2}] [a b])"]
["destr fn-param" "7" "((fn [{:keys [a b]}] (+ a b)) {:a 3 :b 4})"]
### 2. Atoms
["atom swap! inc" "1" "(do (def a (atom 0)) (swap! a inc) @a)"]
["atom reset!" "100" "(do (def a (atom 0)) (reset! a 100) @a)"]
["atom CAS ok" "true" "(do (def a (atom 5)) (compare-and-set! a 5 10))"]
["atom CAS no" "false" "(do (def a (atom 5)) (compare-and-set! a 9 10))"]
["atom thread-first swap!" "213" "(do (def a (atom 100)) (swap! a #(-> % (* 2) (+ 3))) (swap! a #(-> % (* 1) (+ 10))) @a)"]
["atom swap! args" "10" "(do (def a (atom 1)) (swap! a + 2 3 4) @a)"]
["atom swap-vals!" "[1 2]" "(do (def a (atom 1)) (swap-vals! a inc))"]
["atom watch" "[1 2]" "(do (def lg (atom nil)) (def a (atom 1)) (add-watch a :k (fn [k r o n] (reset! lg [o n]))) (swap! a inc) @lg)"]
["atom validator" "5" "(do (def a (atom 1 :validator pos?)) (reset! a 5) @a)"]
### 3. Lazy sequences
["lazy filter inf" "(quote (0 2 4 6 8 10 12 14 16 18))" "(take 10 (filter even? (iterate inc 0)))"]
["lazy take-while sq" "(quote (0 1 4 9 16 25 36 49))" "(take-while #(< % 50) (map #(* % %) (range)))"]
["lazy cycle" "(quote (:a :b :c :a :b :c :a :b :c :a))" "(take 10 (cycle [:a :b :c]))"]
["lazy-seq cons self" "(quote (1 2 4 8 16 32 64 128))"
"(do (defn my-it [f x] (lazy-seq (cons x (my-it f (f x))))) (take 8 (my-it #(* 2 %) 1)))"]
["lazy self-ref fib" "(quote (0 1 1 2 3 5 8 13 21 34))"
"(do (def fib (lazy-cat [0 1] (map + (rest fib) fib))) (take 10 fib))"]
["repeatedly" "(quote (1 1 1))" "(repeatedly 3 (fn [] 1))"]
["range step" "(quote (0 2 4 6 8))" "(range 0 10 2)"]
### 4. Transducers
["xf comp into" "[1 3 5 7 9]" "(into [] (comp (map inc) (filter odd?)) (range 10))"]
["xf sequence" "(quote (1 3 5 7 9))" "(sequence (comp (map inc) (filter odd?)) (range 10))"]
["xf transduce" "25" "(transduce (comp (map inc) (filter odd?)) + 0 (range 10))"]
["xf take" "[0 1 2]" "(into [] (take 3) (range 100))"]
["xf remove" "[1 3 5]" "(into [] (remove even?) [1 2 3 4 5])"]
### 5. Protocols & Records
["record area circle" "78" "(do (defprotocol Sh (ar [t])) (defrecord Ci [r] Sh (ar [_] (int (* 3.14159 r r)))) (int (ar (->Ci 5))))"]
["record field" "5" "(do (defrecord Ci [r]) (:r (->Ci 5)))"]
["record map->" "3" "(do (defrecord P [x y]) (:x (map->P {:x 3 :y 4})))"]
["protocol 2 methods" "[16 \"sq\"]" "(do (defprotocol Sh (ar [t]) (nm [t])) (defrecord Sq [s] Sh (ar [_] (* s s)) (nm [_] \"sq\")) (let [x (->Sq 4)] [(ar x) (nm x)]))"]
["extend-protocol" "6" "(do (defprotocol G (g [x])) (extend-protocol G java.lang.Long (g [x] (inc x))) (g 5))"]
["reify" "42" "(do (defprotocol P (m [_])) (m (reify P (m [_] 42))))"]
["record equality" "true" "(do (defrecord R [a]) (= (->R 1) (->R 1)))"]
### 6. Multimethods
["mm dispatch circle" "\"round\"" "(do (defmulti st :kind) (defmethod st :circle [_] \"round\") (defmethod st :default [_] \"unknown\") (st {:kind :circle}))"]
["mm default" "\"unknown\"" "(do (defmulti st :kind) (defmethod st :circle [_] \"round\") (defmethod st :default [_] \"unknown\") (st {:kind :triangle}))"]
["mm multi-arity" "[1 3]" "(do (defmulti f (fn [& a] (first a))) (defmethod f :x ([_ y] y) ([_ y z] (+ y z))) [(f :x 1) (f :x 1 2)])"]
### 7. Macros
["macro log-call" "6" "(do (defmacro lc [e] `(let [r# ~e] r#)) (lc (* 2 3)))"]
["macro quote arg" "(quote (* 2 3))" "(do (defmacro qa [e] `(quote ~e)) (qa (* 2 3)))"]
["macroexpand-1" "true" "(do (defmacro mm [x] (list 'inc x)) (= '(inc 5) (macroexpand-1 '(mm 5))))"]
["gensym distinct" "false" "(= (gensym) (gensym))"]
["syntax-quote splice" "[1 2 3]" "(let [xs [1 2 3]] `[~@xs])"]
# syntax-quote fully-qualifies resolved core symbols to clojure.core/ (jolt-265).
["syntax-quote unquote" "(quote (clojure.core/+ 1 5))" "(let [x 5] `(+ 1 ~x))"]
### 8. Recursion
["recursion fact" "120" "(do (defn fact [n] (if (<= n 1) 1 (* n (fact (dec n))))) (fact 5))"]
["recursion loop" "120" "(loop [i 5 acc 1] (if (zero? i) acc (recur (dec i) (* acc i))))"]
["mutual recursion" "true" "(letfn [(ev? [n] (if (zero? n) true (od? (dec n)))) (od? [n] (if (zero? n) false (ev? (dec n))))] (ev? 6))"]
["trampoline" ":done" "(do (defn a [n] (if (zero? n) :done (fn [] (a (dec n))))) (trampoline a 8))"]
### 9. Higher-order functions
["partial" "15" "((partial + 5) 10)"]
["comp" "8" "((comp #(* 2 %) inc) 3)"]
["juxt" "[5 6 4]" "((juxt identity inc dec) 5)"]
["every-pred" "true" "((every-pred pos? even?) 2 4 6)"]
["some-fn" "true" "((some-fn even? neg?) 3 4)"]
["fnil" "1" "((fnil inc 0) nil)"]
["complement" "true" "((complement nil?) 1)"]
### 10. Threading macros
["->> pipeline" "75" "(->> (range 20) (filter odd?) (map #(* % 3)) (take 5) (reduce +))"]
["-> sqrt long" "15" "(-> 25 Math/sqrt long (+ 10))"]
["some->" "2" "(some-> {:a {:b 1}} :a :b inc)"]
["some-> nil" "nil" "(some-> {:a nil} :a :b)"]
["cond->" "4" "(cond-> 1 true inc false (* 100) true (* 2))"]
["as->" "20" "(as-> 1 x (inc x) (* x 10))"]
### 11. Exception handling
["ex catch" "\"caught\"" "(try (throw (ex-info \"x\" {})) (catch :default e \"caught\"))"]
["ex-message" "\"broke\"" "(try (throw (ex-info \"broke\" {:code 42})) (catch :default e (ex-message e)))"]
["ex-data" "{:code 42}" "(try (throw (ex-info \"broke\" {:code 42})) (catch :default e (ex-data e)))"]
["try finally" "[:body :fin]" "(do (def lg (atom [])) (try (swap! lg conj :body) (finally (swap! lg conj :fin))) @lg)"]
### 12. For comprehension
["for nested :when" "(quote ([0 1] [0 2] [1 0] [1 2] [2 0] [2 1]))"
"(for [x (range 3) y (range 3) :when (not= x y)] [x y])"]
["for :let" "(quote (1 4 9))" "(for [x [1 2 3] :let [sq (* x x)]] sq)"]
["for :while" "(quote (0 1 2))" "(for [x (range 10) :while (< x 3)] x)"]
### 13b. Persistent lists — O(1) conj-prepend, immutable, value semantics
["list conj prepends" "(quote (0 1 2 3))" "(conj (list 1 2 3) 0)"]
["list conj multi" "(quote (:c :b :a))" "(conj (quote ()) :a :b :c)"]
["list immutable" "true" "(let [l (list 1 2 3) l2 (conj l 9)] (and (= l (quote (1 2 3))) (= l2 (quote (9 1 2 3)))))"]
["list? after conj" "true" "(list? (conj (list 1 2) 0))"]
["list = vector elts" "true" "(= (quote (1 2 3)) [1 2 3])"]
["reduce conj list" "(quote (2 1 0))" "(reduce conj (list) (range 3))"]
["cons onto list" "(quote (0 1 2 3))" "(cons 0 (list 1 2 3))"]
### 14. Janet interop
["interop method" "\"v=41\"" "(. {:value 41 :describe (fn [self] (str \"v=\" (:value self)))} describe)"]
["interop field" "41" "(.-value {:value 41})"]
# vectors are persistent vectors (Janet tables); lists are Janet arrays
["interop janet-type" ":array" "(do (require '[jolt.interop :as j]) (j/janet-type (list 1 2 3)))"]
])
(each [label expected actual] cases (check label expected actual))
(printf "\n=== features-test: %d/%d passed ===" pass (length cases))
(unless (empty? fails)
(print "--- Failures ---")
(each [label kind detail] fails (printf "[%s] %s: %s" kind label detail)))
(when (pos? (length fails))
(error (string (length fails) " feature regression(s)")))
(print "All feature tests passed!")

64
test/integration/inline-sra-test.janet
View file

@ -1,64 +0,0 @@
# Inline + scalar-replacement passes (jolt-87f, Route 1 AOT escape analysis).
# When a unit opts into direct-linking (:inline?, JOLT_DIRECT_LINK=1), the IR
# pipeline inlines small direct-linked fns and then scalar-replaces the now-
# exposed non-escaping map allocations: (:r {:r a ..}) -> a. This pins the
# transform (allocations actually vanish) AND that it stays semantics-preserving.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as reader)
(print "Inline + scalar replacement (jolt-87f)...")
# A ctx with inlining ON (independent of the build-time JOLT_DIRECT_LINK).
(def ctx (api/init-cached {:compile? true}))
(put (ctx :env) :direct-linking? true)
(put (ctx :env) :inline? true)
(api/eval-string ctx "(ns rt)")
(each s ["(defn v3 [r g b] {:r r :g g :b b})"
"(defn scale [l n] {:r (* (:r l) n) :g (* (:g l) n) :b (* (:b l) n)})"
"(defn add [l r] {:r (+ (:r l) (:r r)) :g (+ (:g l) (:g r)) :b (+ (:b l) (:b r))})"
"(defn dot [l r] (+ (+ (* (:r l) (:r r)) (* (:g l) (:g r))) (* (:b l) (:b r))))"
"(defn sub [l r] {:r (- (:r l) (:r r)) :g (- (:g l) (:g r)) :b (- (:b l) (:b r))})"
"(defn reflect [v n] (sub v (scale n (* 2.0 (dot v n)))))"
# self-recursive: must NOT be inlined into callers (its body has a free
# local — the fn-name self-reference — that would dangle when spliced).
"(defn countdown [n] (if (< n 1) :done (countdown (- n 1))))"]
(api/eval-string ctx s))
(defn alloc-count [src]
# struct / build-map literal occurrences in the emitted Janet = surviving map
# allocations (jolt builds a struct, falling back to build-map-literal).
(def code (string/format "%p" (backend/emit-ir ctx (backend/analyze-form ctx (reader/parse-string src)))))
[(length (string/find-all "struct " code))
(length (string/find-all "build-map" code))])
# A vec3 chain whose intermediates never escape collapses to ONE result map.
(let [[s b] (alloc-count "(fn [v n] (reflect v n))")]
(assert (= 1 s) (string "reflect keeps exactly one alloc, got " s " struct"))
(assert (= 1 b) (string "reflect keeps exactly one build-map fallback, got " b)))
# A fully consumed chain (result not returned as a map) allocates NOTHING.
(let [[s b] (alloc-count "(fn [v n] (dot (reflect v n) (reflect v n)))")]
(assert (= 0 s) (string "fully-consumed chain allocates no struct, got " s))
(assert (= 0 b) (string "fully-consumed chain has no build-map fallback, got " b)))
# Loop bodies optimize too (recur is not a blanket escape).
(let [[s _] (alloc-count "(fn [k] (loop [i 0 acc 0.0] (if (< i k) (recur (inc i) (+ acc (dot (v3 1.0 2.0 3.0) (v3 0.1 0.2 0.3)))) acc)))")]
(assert (= 0 s) (string "loop body allocates no struct, got " s)))
# Correctness: inlined results match the obvious computation.
(assert (= 32.0 (api/eval-string ctx "(dot (v3 1.0 2.0 3.0) (v3 4.0 5.0 6.0))")) "dot value")
(assert (= 9.0 (api/eval-string ctx "(:r (add (v3 1.0 0.0 0.0) (scale (v3 4.0 0.0 0.0) 2.0)))")) "add+scale value")
# the self-recursive fn still runs (the closed-body guard kept it un-inlined)
(assert (= :done (api/eval-string ctx "(countdown 5)")) "recursive fn still works")
# A redefinable (^:redef) callee must NOT be inlined — it stays a live var call.
(api/eval-string ctx "(defn ^:redef wobble [x] {:v x})")
(let [[s _] (alloc-count "(fn [] (:v (wobble 1)))")]
# wobble is not inlined, so its map isn't visible to scalar replacement: the
# lookup stays a call, and the (:v ...) result is whatever wobble returns.
(assert (= 7 (do (api/eval-string ctx "(defn ^:redef wobble [x] {:v (+ x 6)})")
(api/eval-string ctx "(:v (wobble 1))")))
"redef callee stays live (redefinition is visible)"))
(print "Inline + scalar replacement passed!")

51
test/integration/ir-passes-test.janet
View file

@ -1,51 +0,0 @@
# IR pass pipeline (jolt-2om, nanopass-lite): jolt.passes/run-passes applies
# pure IR->IR rewrites between the analyzer and the back end. The first pass
# is constant folding — it computes with the ACTUAL jolt fns, so folded
# results match runtime semantics by construction.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as reader)
(print "IR passes (constant folding)...")
(def ctx (api/init-cached {:compile? true}))
(defn ir [src] (backend/analyze-form ctx (reader/parse-string src)))
(defn check-const [src want]
(def n (ir src))
(assert (= :const (n :op)) (string src " folds to a constant"))
(assert (= want (n :val)) (string src " folds to " (string/format "%q" want))))
(check-const "(+ 1 2 3)" 6)
(check-const "(* 2 (+ 3 4))" 14)
(check-const "(quot 7 2)" 3)
(check-const "(mod -7 3)" 2)
(check-const "(if (< 1 2) :yes :no)" :yes)
# dead-branch elimination: the untaken branch never evaluates (it must still
# RESOLVE — unresolved symbols are analysis errors as in Clojure, jolt-2o7.3)
(check-const "(if false (throw (ex-info \"boom\" {})) 2)" 2)
# an unresolvable symbol errors even in a dead branch (analysis precedes folding)
(assert (not ((protect (ir "(if false (this-would-not-resolve) 2)")) 0))
"unresolved symbol errors even in a dead branch")
# non-constants stay calls; folding must be conservative. `xq` is a real var
# (defined here) so it resolves, but its VALUE must not be folded in.
(api/eval-string ctx "(def xq 1)")
(assert (= :invoke ((ir "(+ xq 2)") :op)) "var ref stays a call")
(assert (= :invoke ((ir "(mod xq 0)") :op)) "non-const args stay calls")
# a fold that would THROW is left for runtime
(assert (= :invoke ((ir "(mod 5 0)") :op)) "throwing fold left to runtime")
# and the folded code evaluates identically (3-mode conformance covers the
# broader matrix; this pins a couple end-to-end)
(assert (= 6 (api/eval-string ctx "(+ 1 2 3)")) "folded eval")
(assert (= :yes (api/eval-string ctx "(if (< 1 2) :yes :no)")) "folded if eval")
# Folding reaches into every op's children via map-ir-children (phase 3a) — it is
# now total, so a constant nested in a fn arity / loop / try body folds too
# (const-fold previously passed :try through unfolded). Sound: folding preserves
# runtime results regardless of position, so these eval end-to-end (3-mode
# conformance covers the broader matrix).
(assert (= 3 ((api/eval-string ctx "(fn [x] (+ 1 2))") 0)) "folded fn arity body eval")
(assert (= 10 (api/eval-string ctx "(loop [i 0] (if (< i (* 2 5)) (recur (inc i)) i))")) "folded loop eval")
(assert (= 5 (api/eval-string ctx "(try (+ 2 3) (catch Throwable e 0))")) "folded try eval")
(print "IR passes passed!")

43
test/integration/ir-try-shape-test.janet
View file

@ -1,43 +0,0 @@
# IR shape hygiene for :try nodes (phase 3b, jolt-26dm). analyze-try used to
# assoc :catch-sym/:catch-body/:finally nil-when-absent, which made the node a
# phm (jolt's nil-valued-key map representation) and forced backend densification
# before every :op read. It now adds those keys only when the clause is present
# — same discipline as the arity :rest key — so a try node stays a fast struct.
# The change is behavior-invisible (the back end reads each key nil-safely and
# gates on it), so we also pin that tries still evaluate correctly.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as reader)
(print "IR :try shape...")
(def ctx (api/init-cached {:compile? true}))
(defn try-node [src] (backend/analyze-form ctx (reader/parse-string src)))
(defn check-struct [src]
(def n (try-node src))
(assert (= :try (n :op)) (string src " is a :try node"))
# a struct (nil-free) — NOT a phm; phm nodes carry a :jolt/deftype tag
(assert (struct? n) (string src " analyzes to a struct, not a phm"))
(assert (nil? (get n :jolt/deftype)) (string src " is not a phm")))
# no catch, no finally — neither optional key should appear
(check-struct "(try 1)")
# finally only — :catch-sym/:catch-body must be ABSENT, not nil
(def fin (try-node "(try 1 (finally 2))"))
(assert (struct? fin) "(try .. finally) is a struct")
(assert (nil? (get fin :catch-body)) "no catch-body when there is no catch")
(assert (get fin :finally) "finally present")
# catch only
(def cat (try-node "(try 1 (catch Throwable e 2))"))
(assert (struct? cat) "(try .. catch) is a struct")
(assert (get cat :catch-sym) "catch-sym present")
(assert (nil? (get cat :finally)) "no finally when there is none")
# catch + finally
(check-struct "(try 1 (catch Throwable e 2) (finally 3))")
# behavior unchanged across all shapes
(assert (= 1 (api/eval-string ctx "(try 1)")) "try value")
(assert (= 2 (api/eval-string ctx "(try (throw (ex-info \"x\" {})) (catch Throwable e 2))")) "catch value")
(assert (= 7 (api/eval-string ctx "(let [a (atom 0)] (try (reset! a 7) (finally nil)) @a)")) "finally runs")
(assert (= 2 (api/eval-string ctx "(try (throw (ex-info \"x\" {})) (catch Throwable e 2) (finally 9))")) "catch+finally")
(print "IR :try shape passed!")

54
test/integration/jank-conformance-test.janet
View file

@ -1,54 +0,0 @@
# jank conformance: runs the Clojure-language pass-tests from a local jank
# checkout (https://github.com/jank-lang/jank, MPL-2.0) against Jolt and asserts
# the number that pass stays at/above a baseline. This does NOT vendor jank's
# sources (license differs) — it references ~/src/jank if present and SKIPS
# cleanly when absent, so it is a local/dev regression aid.
#
# Each jank pass-test is an assertion script ending in `:success`. We load it in
# a fresh context and count it as passing when it returns :success.
(use ../../src/jolt/api)
(def jank-dir (string (os/getenv "HOME") "/src/jank/compiler+runtime/test/jank"))
# Baseline: the number of pass-tests Jolt currently handles. Raise this as Jolt
# gains features so regressions (a previously-passing test breaking) are caught.
(def baseline 120)
# Tests that loop forever under Jolt's eager evaluation (skipped to avoid hangs;
# tracked as known gaps — variadic-recur arity selection and var-quote calls).
(def skip-patterns ["/cpp/" "var-quote" "fn/recur/pass-variadic-position"])
(defn- skip? [path]
(var s false)
(each p skip-patterns (when (string/find p path) (set s true)))
s)
(defn- walk [dir acc]
(each e (os/dir dir)
(def p (string dir "/" e))
(case ((os/stat p) :mode)
:directory (walk p acc)
:file (when (and (string/has-suffix? ".jank" p)
(string/find "/pass-" p)
(not (skip? p)))
(array/push acc p))))
acc)
(if (not (os/stat jank-dir))
(print "jank-conformance: ~/src/jank not present — skipped")
(do
(def files (sort (walk jank-dir @[])))
(var pass 0)
(def fails @[])
(each f files
# A pass-test passes when no assertion throws (assert now errors on failure).
(def res (protect (load-string (init-cached) (slurp f))))
(if (= (res 0) true)
(++ pass)
(array/push fails (string/slice f (+ 1 (length jank-dir))))))
(printf "jank-conformance: %d/%d pass-tests pass (baseline %d)" pass (length files) baseline)
(when (< pass baseline)
(print "--- regressions (now failing, were within baseline) ---")
(each rel fails (print " " rel))
(error (string "jank conformance dropped to " pass " (baseline " baseline ")")))
(printf "jank conformance OK (%d known gaps)" (length fails))))

125
test/integration/lazy-infinite-test.janet
View file

@ -1,125 +0,0 @@
# Deadlined infinite-seq conformance harness (Phase 5 Step 0).
#
# Each case is [name expected-clj actual-clj]. The harness spawns a subprocess
# worker (test/support/lazy-eval.janet) that evaluates (= expected actual) and
# prints @@RESULT true/false. Workers run under a wall-clock deadline; a hang
# = a FAIL. This is the safety net that makes it safe to convert transformers
# to lazy — wrong answers hang instead of silently passing.
#
# Pattern mirrors clojure-test-suite-test.janet: os/spawn + ev/with-deadline
# + os/proc-kill on timeout. Never probe infinite cases in-process.
(def per-case-timeout 5)
(defn- run-case [expected actual]
(def proc (os/spawn ["janet" "test/support/lazy-eval.janet" expected actual] :p {:out :pipe}))
(def out (proc :out))
(var data nil)
(def ok
(try
(ev/with-deadline per-case-timeout
(set data (ev/read out 0x10000))
(os/proc-wait proc)
true)
([err] false)))
(when (not ok)
(protect (os/proc-kill proc true))
(protect (ev/with-deadline 2 (os/proc-wait proc))))
(protect (:close out))
(if (and ok data) (string data) nil))
(defn- parse-result [s]
(def prefix-len (length "@@RESULT "))
(if (string/has-prefix? "@@RESULT " s)
(let [val (string/slice s prefix-len (dec (length s)))]
[:ok val])
(if (string/has-prefix? "@@ERROR " s)
(let [msg (string/slice s (length "@@ERROR ") (dec (length s)))]
[:error msg])
nil)))
# ---- Cases from phase-5.md §6.2 ----
# Expected values use Clojure quote syntax so the worker evaluates
# (= (quote ...) actual) with Clojure's = semantics.
(def cases
[
["nth of map inc range" "1001" "(nth (map inc (range)) 1000)"]
["first filter even? drop range" "4" "(first (filter even? (drop 3 (range))))"]
["take 3 remove odd? range" "(quote (0 2 4))" "(take 3 (remove odd? (range)))"]
["take 3 drop-while <5 range" "(quote (5 6 7))" "(take 3 (drop-while (fn [x] (< x 5)) (range)))"]
["take 4 interleave range iterate" "(quote (0 10 1 11))" "(take 4 (interleave (range) (iterate inc 10)))"]
["take 4 reductions + range" "(quote (0 1 3 6))" "(take 4 (reductions + (range)))"]
["take 3 tree-seq infinite" "(quote (0 0 0))" "(take 3 (tree-seq (fn [_] true) (fn [n] [n]) 0))"]
["sequence xform lazy inf" "(quote (1 2 3))" "(take 3 (sequence (map inc) (range)))"]
["sequence comp xform inf" "(quote (2 4 6))" "(take 3 (sequence (comp (filter odd?) (map inc)) (range)))"]
["every? short-circuits on inf" "false" "(every? pos? (range))"]
["not-every? short-circuits on inf" "true" "(not-every? pos? (range))"]
["take 3 partition 2 range" "(quote ((0 1) (2 3) (4 5)))" "(take 3 (partition 2 (range)))"]
["take 3 partition-all 2 range" "(quote ((0 1) (2 3) (4 5)))" "(take 3 (partition-all 2 (range)))"]
["take 3 map-indexed vector range" "(quote ([0 0] [1 1] [2 2]))" "(take 3 (map-indexed vector (range)))"]
["take 3 distinct cycle" "(quote (1 2 3))" "(take 3 (distinct (cycle [1 2 1 3 1])))"]
["take 6 mapcat dup range" "(quote (0 0 1 1 2 2))" "(take 6 (mapcat (fn [x] [x x]) (range)))"]
["first rest lazy" "1" "(let [[a & r] (range)] (first r))"]
["take 3 rest lazy" "(quote (1 2 3))" "(let [[a & r] (range)] (take 3 r))"]
["dedupe inf" "(quote (1 2 1 2 1))" "(take 5 (dedupe (cycle [1 1 2 2])))"]
["take 3 take-nth 2 range" "(quote (0 2 4))" "(take 3 (take-nth 2 (range)))"]
["take 3 interpose :x range" "(quote (0 :x 1))" "(take 3 (interpose :x (range)))"]
["take 3 map vector range iterate" "(quote ([0 100] [1 101] [2 102]))" "(take 3 (map vector (range) (iterate inc 100)))"]
# §6.3 Laziness counter tests — realize exactly the demanded prefix. Under
# Option A `take` is lazy, so the take result must be forced (dorun) to drive
# realization; reading the counter without forcing would (correctly) see 0.
["LAZY map" "3" "(do (def c (atom 0)) (dorun (take 3 (map (fn [x] (swap! c inc) x) (range)))) @c)"]
["LAZY filter" "6" "(do (def c (atom 0)) (dorun (take 3 (filter (fn [x] (swap! c inc) (odd? x)) (range)))) @c)"]
["LAZY remove" "6" "(do (def c (atom 0)) (dorun (take 3 (remove (fn [x] (swap! c inc) (even? x)) (range)))) @c)"]
["LAZY take-while" "6" "(do (def c (atom 0)) (dorun (take-while (fn [x] (swap! c inc) (< x 5)) (range))) @c)"]
["LAZY drop-while" "6" "(do (def c (atom 0)) (dorun (take 3 (drop-while (fn [x] (swap! c inc) (< x 5)) (range)))) @c)"]
["LAZY distinct" "4" "(do (def c (atom 0)) (dorun (take 3 (distinct (map (fn [x] (swap! c inc) x) (cycle [1 2 1 3 1]))))) @c)"]
# 5, was 7: the canonical lazy take-nth (40-lazy, jolt-ded batch 3) realizes
# only the elements the taken outputs and their drops touch.
["LAZY take-nth" "5" "(do (def c (atom 0)) (dorun (take 3 (take-nth 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"]
["LAZY map-indexed" "3" "(do (def c (atom 0)) (dorun (take 3 (map-indexed (fn [i x] (swap! c inc) [i x]) (range)))) @c)"]
["LAZY keep" "6" "(do (def c (atom 0)) (dorun (take 3 (keep (fn [x] (swap! c inc) (if (odd? x) x nil)) (range)))) @c)"]
["LAZY keep-indexed" "6" "(do (def c (atom 0)) (dorun (take 3 (keep-indexed (fn [i x] (swap! c inc) (if (odd? i) x)) (range)))) @c)"]
["LAZY interpose" "2" "(do (def c (atom 0)) (dorun (take 3 (interpose :x (map (fn [x] (swap! c inc) x) (range))))) @c)"]
["LAZY partition" "6" "(do (def c (atom 0)) (dorun (take 3 (partition 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"]
["LAZY partition-all" "6" "(do (def c (atom 0)) (dorun (take 3 (partition-all 2 (map (fn [x] (swap! c inc) x) (range))))) @c)"]
["LAZY mapcat" "3" "(do (def c (atom 0)) (dorun (take 6 (mapcat (fn [x] (swap! c inc) [x x]) (range)))) @c)"]
["LAZY dedupe" "9" "(do (def c (atom 0)) (dorun (take 5 (dedupe (map (fn [x] (swap! c inc) x) (cycle [1 1 2 2]))))) @c)"]
["LAZY repeated inc" "3" "(do (def c (atom 0)) (dorun (take 3 (map (fn [x] (swap! c inc) x) (iterate inc 0)))) @c)"]
# Already-working cases (guard against regression)
["take 5 iterate inc" "(quote (0 1 2 3 4))" "(take 5 (iterate inc 0))"]
["take 3 range" "(quote (0 1 2))" "(take 3 (range))"]
["take 3 repeat" "(quote (7 7 7))" "(take 3 (repeat 7))"]
["take 3 cycle" "(quote (1 2 1))" "(take 3 (cycle [1 2]))"]
["take 3 filter even? range" "(quote (0 2 4))" "(take 3 (filter even? (range)))"]
["take 5 lazily filtered from range" "(quote (1 3 5 7 9))" "(take 5 (filter odd? (range)))"]
])
# ---- Run ----
(var fails @[])
(var timeouts 0)
(var passed 0)
(each [name expected expr] cases
(def out (run-case expected expr))
(cond
(nil? out)
(do (++ timeouts) (array/push fails (string "TIMEOUT: " name)))
(let [res (parse-result out)]
(case (res 0)
:ok (if (= "true" (res 1))
(++ passed)
(array/push fails (string "MISMATCH: " name " — expected " expected)))
:error (array/push fails (string "ERROR: " name " — " (res 1)))
(array/push fails (string "PARSE: " name " — raw: " (string/trim out)))))))
(printf "lazy-infinite: %d cases — %d passed / %d timeouts / %d failures"
(length cases) passed timeouts (length fails))
(when (> (length fails) 0)
(print "\nFailures:")
(each f fails (printf " %s" f)))
(if (or (> (length fails) 0) (> timeouts 0))
(os/exit 1))

91
test/integration/macro-expansion-test.janet
View file

@ -1,91 +0,0 @@
# Compiled macro expansion in EVERY mode (jolt-tzo: the fast macro-expansion
# path that unblocks moving hot fns the 00-syntax expanders depend on).
#
# Macros are ordinary compiled fns in Clojure's model. Compile mode has had
# this since the staged bootstrap (ensure-macros-compiled! recompiles the
# early interpreted expanders once the analyzer is alive); interpret mode —
# the conformance battery's default — used to skip it, so every distinct
# (and ...) / (cond ...) / nested expansion ran an interpreted closure.
# Now interpret-mode init also builds the analyzer once at the end of the
# overlay load and compiles every stashed expander; JOLT_INTERPRET_MACROS=1
# opts back into the pure interpreted oracle.
(use ../../src/jolt/api)
(use ../../src/jolt/types)
(print "compiled macro expansion...")
(os/setenv "JOLT_INTERPRET_MACROS" nil)
(defn- macro-var [ctx nm] (ns-find (ctx-find-ns ctx "clojure.core") nm))
(defn- user-var [ctx nm] (ns-find (ctx-find-ns ctx "user") nm))
(def probes
["(= 3 (and 1 2 3))"
"(= 1 (or nil false 1))"
"(= :b (cond false :a :else :b))"
"(= 4 (when-not nil 4))"
"(= 6 (-> 1 inc (* 3)))"
"(= 15 (->> [1 2] (map inc) (reduce +) (* 3)))"
"(= 2 (if-let [x nil] 1 2))"
"(= [0 1] (vec (for [i (range 2)] i)))"
"(= 5 (case 2 1 :one 2 5 :dflt))"
"(= 10 (loop [i 0 a 0] (if (< i 5) (recur (inc i) (+ a 2)) a)))"])
(defn- run-probes [ctx label]
(each prog probes
(def got (protect (eval-string ctx prog)))
(assert (and (got 0) (= (got 1) true))
(string label " probe failed: " prog " => "
(if (got 0) (string/format "%q" (got 1)) (string (got 1)))))))
# 1. Interpret mode: expanders are COMPILED after init (the new path).
(def ictx (init {}))
(run-probes ictx "interpret")
(each m ["when" "when-not" "and" "or" "cond" "->" "->>" "if-let" "case" "doseq"]
(def v (macro-var ictx m))
(assert v (string m " var exists"))
(assert (get v :macro-compiled)
(string m " expander is compiled in interpret mode")))
# 2. A USER defmacro in an interpret ctx gets a compiled expander too.
(eval-string ictx "(defmacro my-twice [x] `(* 2 ~x))")
(assert (= 10 (eval-string ictx "(my-twice 5)")) "user macro works")
(assert (get (user-var ictx "my-twice") :macro-compiled)
"user macro expander compiled in interpret mode")
# 3. An expander whose body the analyzer can't compile (here: the `eval`
# special form) falls back to the interpreted closure and still works.
(eval-string ictx "(defmacro evalish [x] (eval `(+ ~x 1)))")
(assert (= 3 (eval-string ictx "(evalish 2)")) "uncompilable expander works")
(assert (not (get (user-var ictx "evalish") :macro-compiled))
"uncompilable expander stays interpreted")
# 4. Compile mode unchanged: expanders compiled (pre-existing behavior).
(def cctx (init {:compile? true}))
(run-probes cctx "compile")
(assert (get (macro-var cctx "cond") :macro-compiled) "compile-mode expanders compiled")
# 5. JOLT_INTERPRET_MACROS=1: the pure interpreted oracle — same semantics,
# expanders NOT compiled.
(os/setenv "JOLT_INTERPRET_MACROS" "1")
(def octx (init {}))
(run-probes octx "oracle")
(assert (not (get (macro-var octx "cond") :macro-compiled))
"oracle mode keeps interpreted expanders")
(os/setenv "JOLT_INTERPRET_MACROS" nil)
(print "compiled macro expansion passed!")
# 6. Early overlay DEFNS get the same staged-recompile treatment (jolt-4j3):
# 00-syntax fns (destructure, and the expander-called keys/vals/empty?) load
# interpreted pre-kernel, then compile in the same end-of-init pass.
(each nm ["destructure" "empty?" "keys" "vals"]
(def v (macro-var ictx nm))
(assert v (string nm " var exists"))
(assert (get v :defn-compiled)
(string nm " early defn is compiled (interpret mode)")))
(def cctx2 (init {:compile? true}))
(assert (get (macro-var cctx2 "destructure") :defn-compiled)
"early defn compiled in compile mode too")
(assert (not (get (macro-var octx "destructure") :defn-compiled))
"oracle mode keeps early defns interpreted")

57
test/integration/mutable-deftype-test.janet
View file

@ -1,57 +0,0 @@
# Mutable deftype fields under shapes/direct-link (jolt-c3q).
#
# A deftype field tagged ^:unsynchronized-mutable / ^:volatile-mutable is set! at
# runtime. Immutable records are shape-recs (immutable tuples) where shapes are
# active (direct-link), so set! can't mutate them. A deftype with ANY mutable
# field opts out of the shape-rec layout and uses the mutable table form (which
# set! already mutates and field reads route through), regardless of :shapes?.
# Immutable deftypes/records keep the fast shape-rec.
(use ../../src/jolt/api)
(var failures 0)
(defn- check [label got want]
(unless (= got want)
(++ failures)
(printf "FAIL [%s] got %q want %q" label got want)))
# direct-linking? true => :shapes? on (the mode where immutable records are
# tuples and this used to error "Can't set! field on non-deftype: tuple").
(let [ctx (init {:compile? true :direct-linking? true})]
(eval-string ctx "(deftype Counter [^:unsynchronized-mutable n])")
(eval-string ctx "(def c (->Counter 0))")
(check "read initial mutable field" (eval-string ctx "(.-n c)") 0)
(eval-string ctx "(set! (.-n c) 5)")
(check "read after set!" (eval-string ctx "(.-n c)") 5)
(eval-string ctx "(set! (.-n c) (inc (.-n c)))")
(check "set! using prior value" (eval-string ctx "(.-n c)") 6)
# keyword access reads the same mutated field
(check "keyword access sees mutation" (eval-string ctx "(:n c)") 6))
# Mixed mutable + immutable fields: a method reads both, set! touches the mutable.
(let [ctx (init {:compile? true :direct-linking? true})]
(eval-string ctx "(deftype Cell [label ^:unsynchronized-mutable v] Object (toString [_] (str label \"=\" v)))")
(eval-string ctx "(def cell (->Cell \"x\" 1))")
(check "immutable field reads" (eval-string ctx "(.-label cell)") "x")
(check "custom toString before" (eval-string ctx "(str cell)") "x=1")
(eval-string ctx "(set! (.-v cell) 42)")
(check "mutable field after set!" (eval-string ctx "(.-v cell)") 42)
(check "custom toString after mutation" (eval-string ctx "(str cell)") "x=42")
(check "immutable field unchanged" (eval-string ctx "(.-label cell)") "x"))
# volatile-mutable is treated the same (also a mutable field).
(let [ctx (init {:compile? true :direct-linking? true})]
(eval-string ctx "(deftype Box [^:volatile-mutable x])")
(eval-string ctx "(def b (->Box :a))")
(eval-string ctx "(set! (.-x b) :z)")
(check "volatile-mutable set!" (eval-string ctx "(.-x b)") :z))
# An all-immutable deftype/record is unaffected: still a shape-rec, fast reads.
(let [ctx (init {:compile? true :direct-linking? true})]
(eval-string ctx "(defrecord Pt [x y])")
(check "immutable record reads" (eval-string ctx "(:x (->Pt 3 4))") 3)
(check "immutable record reads y" (eval-string ctx "(:y (->Pt 3 4))") 4))
(if (pos? failures)
(do (printf "mutable-deftype: %d failure(s)" failures) (os/exit 1))
(print "mutable-deftype: all cases passed"))

119
test/integration/namespace-test.janet
View file

@ -1,119 +0,0 @@
(use ../../src/jolt/reader)
(use ../../src/jolt/types)
(use ../../src/jolt/evaluator)
(import ../../src/jolt/api :as api)
# ns/in-ns/require/use are overlay macros + clojure.core fns now (Stage 2 jolt-eaa),
# so these interpreter tests need the full env (init loads the overlay + installs
# the stateful fns), not a bare make-ctx.
(defn- fresh-ctx [] (api/init))
# Helper: parse and eval in a fresh ctx
(defn eval-str [s]
(let [ctx (fresh-ctx)
form (parse-string s)]
(eval-form ctx @{} form)))
(print "1: in-ns...")
(let [ctx (fresh-ctx)]
(def form (parse-string "(in-ns 'my.app)"))
(eval-form ctx @{} form)
(assert (= "my.app" (ctx-current-ns ctx)) "in-ns switches namespace"))
(print " passed")
(print "2: def in different namespace...")
(let [ctx (fresh-ctx)]
(eval-form ctx @{} (parse-string "(in-ns 'my.app)"))
(eval-form ctx @{} (parse-string "(def x 42)"))
(let [ns (ctx-find-ns ctx "my.app")
v (ns-find ns "x")]
(assert (= 42 (var-get v)) "def works in new namespace")))
(print " passed")
(print "3: ns form...")
(let [ctx (fresh-ctx)]
(eval-form ctx @{} (parse-string "(ns my.lib)"))
(assert (= "my.lib" (ctx-current-ns ctx)) "ns sets current namespace"))
(print " passed")
(print "4: ns with require...")
(let [ctx (fresh-ctx)]
# Set up a namespace with some vars
(let [other-ns (ctx-find-ns ctx "other.lib")]
(ns-intern other-ns "f" (fn [x] (inc x))))
# Now ns with require
(eval-form ctx @{} (parse-string "(ns my.app (:require [other.lib :as o]))"))
# current-ns should be my.app
(assert (= "my.app" (ctx-current-ns ctx)) "ns with require sets current namespace")
# Alias should be registered
(let [ns (ctx-find-ns ctx "my.app")
aliased (ns-alias-lookup ns "o")]
(assert (= "other.lib" aliased) "alias o -> other.lib registered")))
(print " passed")
(print "5: require form (standalone)...")
(let [ctx (fresh-ctx)]
# Populate other.lib first — require of an unlocatable ns now throws
# (Clojure's FileNotFoundException), see namespaces-spec.
(let [other-ns (ctx-find-ns ctx "other.lib")]
(ns-intern other-ns "f" (fn [x] x)))
(eval-form ctx @{} (parse-string "(require '[other.lib :as o])"))
(let [ns (ctx-find-ns ctx "user")
aliased (ns-alias-lookup ns "o")]
(assert (= "other.lib" aliased) "standalone require registers alias")))
(print " passed")
(print "6: qualified symbol via alias...")
(let [ctx (fresh-ctx)]
# Set up target ns
(let [target (ctx-find-ns ctx "other.lib")]
(ns-intern target "f" (fn [x] (inc x))))
# Register alias
(let [ns (ctx-find-ns ctx "user")]
(ns-import ns "o" "other.lib"))
# Resolve o/f and call it
(let [form (parse-string "(o/f 41)")
result (eval-form ctx @{} form)]
(assert (= 42 result) "qualified call via alias works")))
(print " passed")
(print "7: require then use alias...")
(let [ctx (fresh-ctx)]
# Set up target ns
(let [target (ctx-find-ns ctx "math.lib")]
(ns-intern target "add" (fn [a b] (+ a b))))
# require + use
(eval-form ctx @{} (parse-string "(require '[math.lib :as m])"))
(let [result (eval-form ctx @{} (parse-string "(m/add 1 2)"))]
(assert (= 3 result) "require + alias + call chain works")))
(print " passed")
(print "8: ns form requires multiple...")
(let [ctx (fresh-ctx)]
(let [ns1 (ctx-find-ns ctx "a.lib")]
(ns-intern ns1 "f" (fn [x] (inc x))))
(let [ns2 (ctx-find-ns ctx "b.lib")]
(ns-intern ns2 "g" (fn [x] (dec x))))
(eval-form ctx @{} (parse-string "(ns user (:require [a.lib :as a] [b.lib :as b]))"))
(assert (= 43 (eval-form ctx @{} (parse-string "(a/f 42)"))) "alias a works")
(assert (= 41 (eval-form ctx @{} (parse-string "(b/g 42)"))) "alias b works"))
(print " passed")
(print "\nAll namespace tests passed!")
# An UNCAUGHT throw inside an interpreted fn body must restore the caller's
# current-ns (the body runs with current-ns rebound to the defining ns; the
# restore is a defer now). Pre-fix, the ctx was left stuck in the defining ns
# and every later alias-qualified lookup failed — the sci-bootstrap and
# clojure.edn "Unable to resolve alias/..." cascades.
(print "ns restored after uncaught throw...")
(let [ctx (fresh-ctx)]
(api/eval-string ctx "(in-ns (quote otherns))")
(api/eval-string ctx "(clojure.core/refer-clojure)")
(api/eval-string ctx "(defn boom [] (throw (ex-info \"x\" {})))")
(api/eval-string ctx "(in-ns (quote user))")
(assert (not ((protect (api/eval-string ctx "(otherns/boom)")) 0)) "boom throws")
(assert (= "user" (api/eval-string ctx "(str *ns*)")) "*ns* restored after uncaught throw")
(api/eval-string ctx "(require (quote [clojure.string :as s9]))")
(assert (= "A" (api/eval-string ctx "(s9/upper-case \"a\")")) "aliases still resolve"))
(print " ok")

109
test/integration/nrepl-test.janet
View file

@ -1,109 +0,0 @@
# Integration test: jolt.nrepl server + client over a real TCP/bencode wire.
#
# The server runs in a subprocess (`jolt nrepl PORT`) so the client (this
# process) isn't affected by the server's accept-loop fiber, which leaves the
# shared ctx's current-ns pointing at jolt.nrepl. The client uses the jolt.nrepl
# Clojure API, exercising both halves of the implementation.
(use ../../src/jolt/api)
(use ../../src/jolt/types)
(def port "17888")
# Watchdog: never let a hang stall CI — bail out after 90s.
(ev/spawn (ev/sleep 90) (eprint "nrepl-test: watchdog fired (possible hang)") (os/exit 1))
# Prefer the built executable (its ctx is baked at build time, ~20ms start);
# source mode pays the full compile-mode init, which on a slow CI runner can
# outrun a short poll window.
(def server-cmd
(if (os/stat "build/jolt")
["build/jolt" "nrepl" port]
["janet" "src/jolt/main.janet" "nrepl" port]))
(print "Starting jolt.nrepl server subprocess on port " port " (" (first server-cmd) ") ...")
(def proc (os/spawn server-cmd :p {:out :pipe :err :pipe}))
# Wait until the server accepts connections (poll up to ~60s — CI headroom).
(var ready false)
(var tries 0)
(while (and (not ready) (< tries 600))
(let [r (protect (net/connect "127.0.0.1" port))]
(if (r 0) (do (:close (r 1)) (set ready true))
(do (ev/sleep 0.1) (++ tries)))))
(unless ready
# Surface the server's stderr so a CI failure is diagnosable.
(eprint "server stderr: " (string (ev/read (proc :err) :all)))
(assert false "nREPL server did not start"))
(def ctx (init-cached))
(ctx-set-current-ns ctx "user")
(load-string ctx "(require '[jolt.nrepl])")
(load-string ctx (string "(def c (jolt.nrepl/connect {:port " port "}))"))
(defn ev [e] (eval-string ctx e))
(var fails 0)
(defn check [label expr expected]
(let [got (ev expr)]
(if (= got expected)
(print " ok " label)
(do (++ fails) (printf " FAIL %s: want %q, got %q" label expected got)))))
# describe advertises ops
(check "describe has ops"
"(boolean (get (first (jolt.nrepl/request c {\"op\" \"describe\"})) \"ops\"))" true)
# clone yields a session id
(ev "(def s (jolt.nrepl/client-clone c))")
(check "clone session is string" "(string? s)" true)
# eval returns a value
(check "eval (+ 1 2)" "(some #(get % \"value\") (jolt.nrepl/client-eval c \"(+ 1 2)\" s))" "3")
# a def's value renders as #'ns/name (pr-str loops on a var's cyclic ns refs)
(check "def renders as #'ns/name"
"(some #(get % \"value\") (jolt.nrepl/client-eval c \"(def yy 21)\" s))" "#'user/yy")
# defs persist across evals in the session
(check "def then use" "(some #(get % \"value\") (jolt.nrepl/client-eval c \"(* yy 2)\" s))" "42")
# stdout is captured and streamed as an out message
(check "println captured as out"
"(some #(get % \"out\") (jolt.nrepl/client-eval c \"(do (println \\\"hi\\\") 9)\" s))" "hi\n")
# the response carries the current ns
(check "ns field reported"
"(some #(get % \"ns\") (jolt.nrepl/client-eval c \"(+ 1 1)\" s))" "user")
# in-ns switches the session ns, and it persists to the next eval
(check "in-ns switches ns"
"(some #(get % \"ns\") (jolt.nrepl/client-eval c \"(in-ns (quote foo.bar))\" s))" "foo.bar")
(check "ns persists across evals"
"(some #(get % \"ns\") (jolt.nrepl/client-eval c \"(+ 2 2)\" s))" "foo.bar")
# explicit :ns on the message overrides
(ev "(jolt.nrepl/request c {\"op\" \"eval\" \"code\" \"(+ 1 1)\" \"session\" s \"ns\" \"user\"})")
# eval error -> eval-error status, and the connection keeps working afterward
(check "eval error status"
"(boolean (some #(let [st (get % \"status\")] (and (sequential? st) (some (fn [x] (= \"eval-error\" x)) st))) (jolt.nrepl/client-eval c \"(/ 1 :z)\" s)))"
true)
(check "still alive after error"
"(some #(get % \"value\") (jolt.nrepl/client-eval c \"(+ 5 5)\" s))" "10")
# multiple forms in one eval -> a value per form (values arrive as strings)
(check "multiple forms"
"(= [\"2\" \"4\"] (mapv #(get % \"value\") (filter #(get % \"value\") (jolt.nrepl/client-eval c \"(+ 1 1) (+ 2 2)\" s))))"
true)
# unknown op -> error/unknown-op/done
(check "unknown op status"
"(let [st (get (first (jolt.nrepl/request c {\"op\" \"nope\"})) \"status\")] (and (some #(= \"unknown-op\" %) st) true))"
true)
# clean up
(ev "(jolt.nrepl/client-close c)")
(os/proc-kill proc true)
(when (os/stat ".nrepl-port") (os/rm ".nrepl-port"))
(if (> fails 0)
(do (eprint "nrepl-test: " fails " failing check(s)") (os/exit 1))
(do (print "\nAll nREPL tests passed!") (os/exit 0)))

77
test/integration/phint-propagation-test.janet
View file

@ -1,77 +0,0 @@
# Declared record param hints propagate THROUGH the whole-program fixpoint
# (jolt-3ko). A ^Record param's field reads type to the field's record type, and
# when such a field-read value is passed to a SHARED helper (no hints, inferred
# from call sites), the helper's params must pick up that record type so its own
# field reads bare-index. Before the fix, ^-hints were applied only at the final
# re-emit (reinfer-def), not during the fixpoint, so a hinted param with no
# callers stayed :any during inference and never propagated to its callees —
# exactly why the ray tracer's vec ops (called with (:origin ray) etc.) stayed
# unproven even under whole-program optimization.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/types :as types)
(print "phint propagation through the fixpoint (jolt-3ko)...")
(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-phint-prop"))
(os/mkdir dir)
(spit (string dir "/pp.clj")
(string
"(ns pp)\n"
"(defrecord Vec3 [r g b])\n"
"(defrecord Ray [^Vec3 origin ^Vec3 direction])\n"
# shared ops, NO hints — must be inferred from the call sites below. A
# `loop` makes them inline-INELIGIBLE so they stay real calls (a small fn
# would be spliced into the caller, where the caller's hint already proves
# it); the point here is propagation to a separate callee's PARAMS.
"(defn dot [a b]\n"
" (loop [i 0 s 0.0]\n"
" (if (< i 1) (recur (inc i) (+ (+ (* (:r a) (:r b)) (* (:g a) (:g b))) (* (:b a) (:b b)))) s)))\n"
"(defn add [a b]\n"
" (loop [i 0 s nil]\n"
" (if (< i 1) (recur (inc i) (->Vec3 (+ (:r a) (:r b)) (+ (:g a) (:g b)) (+ (:b a) (:b b)))) s)))\n"
# callers pass field-read Vec3s from a ^Ray param into the shared ops
"(defn use-dot [^Ray r] (dot (:origin r) (:direction r)))\n"
"(defn use-add [^Ray r] (add (:origin r) (:direction r)))\n"))
(os/setenv "JOLT_DIRECT_LINK" "1")
(os/setenv "JOLT_WHOLE_PROGRAM" "1")
(os/setenv "JOLT_PATH" dir)
(def ctx (api/init {:compile? true}))
(api/eval-string ctx "(require '[pp])")
(def report (backend/infer-program! ctx))
(def pns (types/ctx-find-ns ctx "jolt.passes"))
(def reinfer (types/var-get (types/ns-find pns "reinfer-def")))
(def ppns (types/ctx-find-ns ctx "pp"))
(defn ptmap-for [fname params]
(def pts (get report (string "pp/" fname)))
(def m @{}) (when pts (var i 0) (each p params (put m p (get pts i)) (++ i))) m)
(defn guards [fname params]
(def cell (get (ppns :mappings) fname))
(length (string/find-all ":jolt/type"
(string/format "%p" (backend/emit-ir ctx (reinfer (get cell :infer-ir) (ptmap-for fname params)))))))
(var fails 0)
(defn check [label got expected]
(if (= got expected) (print " ok " label)
(do (++ fails) (printf " FAIL %s: want %p got %p" label expected got))))
# the shared ops' params get the Vec3 record type from the field-read call args,
# so all their field reads bare-index (no :jolt/type guard)
(check "dot params typed Vec3 -> reads bare" (guards "dot" ["a" "b"]) 0)
(check "add params typed Vec3 -> reads bare" (guards "add" ["a" "b"]) 0)
# the hinted callers were already fine (re-emit applies the phint)
(check "use-dot hinted reads bare" (guards "use-dot" ["r"]) 0)
# the report shows the shared ops' params as a Vec3 struct (has :shape / :type)
(def dot-a (get (get report "pp/dot") 0))
(check "dot param a is a struct type" (truthy? (and dot-a (or (get dot-a :shape) (get dot-a :struct)))) true)
# correctness: results are unchanged
(check "dot computes" (api/eval-string ctx "(pp/dot (pp/->Vec3 1 2 3) (pp/->Vec3 4 5 6))") 32)
(check "use-dot computes"
(api/eval-string ctx "(pp/use-dot (pp/->Ray (pp/->Vec3 1 2 3) (pp/->Vec3 4 5 6)))") 32)
(if (> fails 0) (do (printf "phint-propagation: %d FAILED" fails) (os/exit 1))
(print "phint propagation (jolt-3ko) passed!"))

46
test/integration/png-test.janet
View file

@ -1,46 +0,0 @@
# jolt.png: the host PNG encoder (src/jolt/png.janet) + the overlay wrapper
# (src/jolt/jolt/png.clj), reachable as janet.png/* through eval_base's
# module-load-env. Checks the encoder emits a structurally valid PNG (signature,
# IHDR dims, IEND) and that the overlay path writes the same.
(import ../../src/jolt/png :as png)
(import ../../src/jolt/api :as api)
(print "jolt.png encoder + overlay...")
(var failures 0)
(defn check [label ok] (if ok (print " ok: " label) (do (++ failures) (eprintf " FAIL: %s" label))))
(defn- u32 [b o]
(+ (* (get b o) 16777216) (* (get b (+ o 1)) 65536) (* (get b (+ o 2)) 256) (get b (+ o 3))))
# --- host encoder ---
(def w 5)
(def h 3)
(def rgb (buffer/new (* w h 3)))
(for i 0 (* w h 3) (buffer/push-byte rgb (% (* i 7) 256)))
(def out (png/encode w h rgb))
(check "PNG signature" (= (string/slice out 0 8) "\x89PNG\r\n\x1a\n"))
(check "IHDR length is 13" (= 13 (u32 out 8)))
(check "IHDR type" (= "IHDR" (string/slice out 12 16)))
(check "IHDR width" (= w (u32 out 16)))
(check "IHDR height" (= h (u32 out 20)))
(check "8-bit RGB colour type" (and (= 8 (get out 24)) (= 2 (get out 25))))
(check "ends with an IEND chunk" (string/find "IEND" (string out)))
(check "encode rejects a wrong-sized buffer"
(= false (first (protect (png/encode w h (buffer/new 4))))))
# --- overlay (jolt.png from Clojure) writes a valid PNG ---
(def tmp (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-png-overlay-test.png"))
(def ctx (api/init-cached {:compile? true}))
(api/eval-string ctx "(require '[jolt.png :as png])")
(api/eval-string ctx
(string "(let [img (png/image 4 2)]"
" (doseq [_ (range 8)] (png/put! img 10 20 30))"
" (png/write img 4 2 \"" tmp "\"))"))
(def wrote (slurp tmp))
(check "overlay wrote the PNG signature" (= (string/slice wrote 0 8) "\x89PNG\r\n\x1a\n"))
(check "overlay IHDR dims" (and (= 4 (u32 wrote 16)) (= 2 (u32 wrote 20))))
(os/rm tmp)
(if (= 0 failures)
(print "All tests passed.")
(do (eprintf "%d png check(s) failed" failures) (os/exit 1)))

61
test/integration/predicate-fold-test.janet
View file

@ -1,61 +0,0 @@
# Predicate folding from inference (jolt-wcw): when the collection-type
# inference PROVES the argument's type, a type predicate (number?/string?/
# keyword?/nil?/some?/record?) folds to a compile-time boolean constant, which
# the trailing const-fold then propagates — collapsing any `if` it gates to the
# taken branch. Sound: only a provable answer folds, and only when the argument
# is side-effect-free (a local or const), so dropping its evaluation is a no-op.
# Mirrors type-infer-test.janet's harness (count a marker in the emitted IR to
# prove the optimization fired, then evaluate to prove it stayed correct).
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as reader)
(print "Predicate folding (jolt-wcw)...")
(os/setenv "JOLT_DIRECT_LINK" "1")
(def ctx (api/init-cached {:compile? true}))
(api/eval-string ctx "(ns pf)")
(defn code [src]
(string/format "%p" (backend/emit-ir ctx (backend/analyze-form ctx (reader/parse-string src)))))
(defn occurs [src needle] (length (string/find-all needle (code src))))
(defn ev [src] (api/eval-string ctx src))
# --- the predicate call is gone where the type is proven --------------------
(assert (= 0 (occurs "(fn [] (let [x (+ 1 2)] (number? x)))" "number?"))
"number? on proven :num -> folded, call eliminated")
(assert (= 0 (occurs "(fn [] (let [x \"hi\"] (string? x)))" "string?"))
"string? on proven :str -> folded")
(assert (= 0 (occurs "(fn [] (let [x :k] (keyword? x)))" "keyword?"))
"keyword? on proven :kw -> folded")
(assert (= 0 (occurs "(fn [] (let [x (+ 1 2)] (nil? x)))" "nil?"))
"nil? on a provably non-nil value -> folded")
# --- the folded constant collapses an if it gates --------------------------
# the dead branch's literal (200) must be gone after dead-branch removal
(assert (= 0 (occurs "(fn [] (let [x (+ 1 2)] (if (number? x) 100 200)))" "200"))
"true predicate folds the if to its then-branch (dead 200 dropped)")
(assert (= 0 (occurs "(fn [] (let [x (+ 1 2)] (if (string? x) 100 200)))" "100"))
"false predicate folds the if to its else-branch (dead 100 dropped)")
# --- sound fallback: unknown type or impure arg keeps the call -------------
# a param is :any (Phase 0 doesn't type it) -> no fold
(assert (= 1 (occurs "(fn [m] (number? m))" "number?"))
"unknown-type arg keeps the predicate call")
# arg type is proven :num but the arg has side effects (a call) -> must NOT
# drop its evaluation, so the predicate is left in place
(assert (>= (occurs "(fn [g] (number? (+ (g) 1)))" "number?") 1)
"impure arg (even with proven type) keeps the predicate call")
# --- correctness: folded path evaluates to the dispatched path -------------
(assert (= true (ev "((fn [] (let [x (+ 1 2)] (number? x))))")) "number? true value")
(assert (= false (ev "((fn [] (let [x \"hi\"] (number? x))))")) "number? false value")
(assert (= true (ev "((fn [] (let [x :k] (keyword? x))))")) "keyword? true value")
(assert (= false (ev "((fn [] (let [x 5] (nil? x))))")) "nil? false value")
(assert (= true (ev "((fn [] (let [x 5] (some? x))))")) "some? true value")
(assert (= :yes (ev "((fn [] (let [x 5] (if (number? x) :yes :no))))")) "gated if takes proven branch")
(assert (= :no (ev "((fn [] (let [x 5] (if (string? x) :yes :no))))")) "gated if drops false branch")
# impure arg still runs its side effect and returns the right answer
(assert (= 6 (ev "((fn [g] (if (number? (+ (g) 1)) (+ (g) 5) 0)) (fn [] 1))")) "impure-arg predicate stays correct")
(print "Predicate folding (jolt-wcw) passed!")

45
test/integration/record-declared-shape-test.janet
View file

@ -1,45 +0,0 @@
# Records use declared-shape layout with fast field access (jolt-t34), by default
# in a direct-linking unit — no JOLT_SHAPE needed. The key property: a record is
# laid out in DECLARED field order, and field reads bare-index by that order, so
# fields that are NOT alphabetically sorted must still read correctly. This is
# what `sidx` reads off the :shape vector (declared order, not str-sorted).
(use ../../src/jolt/api)
(var failures 0)
(defn- check [label got want]
(unless (= got want)
(++ failures)
(printf "FAIL [%s] got %q want %q" label got want)))
# A direct-linking ctx: records are shape-recs, reads proven/bare-indexed.
(def dl (init {:compile? true :direct-linking? true}))
# --- representation: a record is a shape-rec (tuple), not a table -------------
(check "record is a shape-rec"
(tuple? (eval-string dl "(do (defrecord Sp [x y]) (->Sp 1 2))")) true)
# --- DECLARED-ORDER field access: fields are NOT alphabetically sorted; each
# must read its own value, locally and through a fn boundary. Each case uses a
# DISTINCT record name (redefining a record with new fields is jolt-wf4). -------
(def cases
[["decl-order local" "(do (defrecord Ra [b a c]) (let [r (->Ra 10 20 30)] (= [10 20 30] [(:b r) (:a r) (:c r)])))"]
["decl-order via fn" "(do (defrecord Rb [b a c]) (defn rdb [r] [(:b r) (:a r) (:c r)]) (= [10 20 30] (rdb (->Rb 10 20 30))))"]
["single field z-first" "(do (defrecord Rc [z m a]) (= 7 (:z (->Rc 7 8 9))))"]
["protocol method body" "(do (defprotocol Sh (area [s])) (defrecord Box [w h] Sh (area [b] (* (:w b) (:h b)))) (= 12 (area (->Box 3 4))))"]
["record? true" "(do (defrecord Rd [x y]) (record? (->Rd 1 2)))"]
["record vs map not=" "(do (defrecord Re [x y]) (not (= (->Re 1 2) {:x 1 :y 2})))"]
["assoc keeps type" "(do (defrecord Rf [x y]) (record? (assoc (->Rf 1 2) :x 9)))"]
["pr declared order" "(do (defrecord Rg [b a c]) (= \"#user.Rg{:b 10, :a 20, :c 30}\" (pr-str (->Rg 10 20 30))))"]
# a record shape-rec is a Janet tuple, but a record is NOT a vector/sequential
# in Clojure — else map-destructuring it takes the kwargs coerce path and
# corrupts (reitit router crash, jolt-14k).
["vector? record false" "(do (defrecord Rh [x y]) (not (vector? (->Rh 1 2))))"]
["sequential? record false" "(do (defrecord Ri [x y]) (not (sequential? (->Ri 1 2))))"]
["destructure record :or" "(do (defrecord Rj [a b c d e]) (let [{:keys [a e] :or {a 0}} (->Rj 1 2 3 4 5)] (= 6 (+ a e))))"]])
(each [label prog] cases
(check label (eval-string dl prog) true))
(if (pos? failures)
(do (printf "record-declared-shape: %d failure(s)" failures) (os/exit 1))
(print "record-declared-shape: all cases passed"))

64
test/integration/record-shape-test.janet
View file

@ -1,64 +0,0 @@
# Records as shape-recs (jolt-t34 R3). A user record (defrecord/deftype) under
# JOLT_SHAPE is a shape-rec whose descriptor ALSO carries :type (the type tag),
# laid out in DECLARED field order. These build records directly via the runtime
# (make-record) and assert that every map/record operation treats them the way
# Clojure does — and crucially that type identity is preserved (a record is not
# a plain map, and two records are equal only when their types match).
(use ../../src/jolt/types)
(use ../../src/jolt/core)
(var fails 0)
(defn check [label got want]
(if (deep= got want) (print " ok " label)
(do (++ fails) (printf " FAIL %s: got %j want %j" label got want))))
# (defrecord Point [x y]) instance (->Point 1 2)
(def P (make-record "my.Point" [:x :y] [1 2]))
# --- it IS a shape-rec, and reports its type ---------------------------------
(check "shape-rec?" (shape-rec? P) true)
(check "record-tag" (record-tag P) "my.Point")
(check "map?" (core-map? P) true)
# --- field access in declared order ------------------------------------------
(check "get x" (core-get P :x nil) 1)
(check "get y" (core-get P :y nil) 2)
(check "get miss default" (core-get P :z :d) :d)
(check "count" (core-count P) 2)
(check "contains?" (core-contains? P :x) true)
# --- the virtual :jolt/deftype key keeps every (get obj :jolt/deftype) site
# (record?/dispatch) working without special-casing each one ------------------
(check "virtual deftype" (core-get P :jolt/deftype nil) "my.Point")
# --- assoc preserves the type: in place for a declared field, and grows a
# slot Clojure-style for a new key (the result is still a record) -------------
(def P2 (core-assoc P :x 9))
(check "assoc field tag" (record-tag P2) "my.Point")
(check "assoc field val" (core-get P2 :x nil) 9)
(check "assoc keeps other" (core-get P2 :y nil) 2)
(def P3 (core-assoc P :z 3))
(check "assoc new tag" (record-tag P3) "my.Point")
(check "assoc new val" (core-get P3 :z nil) 3)
(check "assoc new keeps" (core-get P3 :x nil) 1)
# --- dissoc of a declared field demotes to a plain map (Clojure semantics) ----
(def D (core-dissoc P :x))
(check "dissoc demotes" (record-tag D) nil)
(check "dissoc gone" (core-get D :x :gone) :gone)
(check "dissoc keeps" (core-get D :y nil) 2)
# --- equality is TYPE-AWARE: same type + same fields equal; a different type
# or a plain map with the same fields is NOT equal ----------------------------
(check "= same type" (jolt-equal? P (make-record "my.Point" [:x :y] [1 2])) true)
(check "not= diff field" (jolt-equal? P (make-record "my.Point" [:x :y] [1 9])) false)
(check "not= diff type" (jolt-equal? P (make-record "my.Other" [:x :y] [1 2])) false)
(check "not= record vs map" (jolt-equal? P {:x 1 :y 2}) false)
(check "not= map vs record" (jolt-equal? {:x 1 :y 2} P) false)
# --- printing: Clojure record syntax #ns.Type{:k v, ...}, fields in order -----
(check "pr record" (core-pr-str1 P) "#my.Point{:x 1, :y 2}")
(if (> fails 0)
(error (string "record-shape: " fails " failing check(s)"))
(print "\nRecord shape passed!"))

61
test/integration/scalar-replace-record-test.janet
View file

@ -1,61 +0,0 @@
# Scalar-replacement of short-lived RECORD allocations (jolt-15jq). The pass
# already folds the const-key MAP-literal form ((:k {:k a ..}) -> a and drops a
# non-escaping let-bound map); this extends it to record CONSTRUCTORS. A record
# ctor (->Rec a b ..) is a positional struct whose declared field order lives in
# the record-shapes registry, so a field read on a non-escaping ctor result folds
# to the corresponding positional arg and the allocation disappears.
#
# Probe: count occurrences of the ctor var "->V3" in the analyzed IR. Folded =>
# the ctor is gone (0). Mirrors type-infer-test's guard-counting harness.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as reader)
(print "Scalar-replace of records (jolt-15jq)...")
(os/setenv "JOLT_DIRECT_LINK" "1")
(def ctx (api/init-cached {:compile? true}))
(api/eval-string ctx "(ns srr)")
(api/eval-string ctx "(defrecord V3 [r g b])")
(defn ctors [src]
(length (string/find-all "->V3"
(string/format "%p" (backend/analyze-form ctx (reader/parse-string src))))))
(defn ev [src] (api/eval-string ctx src))
# --- direct form: (:field (->V3 a b c)) -> the positional arg ----------------
(assert (= 0 (ctors "(fn [] (:r (->V3 1 2 3)))")) "direct record lookup :r -> arg, ctor gone")
(assert (= 0 (ctors "(fn [] (:g (->V3 1 2 3)))")) "direct record lookup :g -> arg, ctor gone")
(assert (= 0 (ctors "(fn [] (:b (->V3 1 2 3)))")) "direct record lookup :b -> arg, ctor gone")
# pure non-constant args fold too (each discarded sibling is pure)
(assert (= 0 (ctors "(fn [a b] (:r (->V3 (+ a 1) (* b 2) 7)))")) "direct fold with pure arith args")
# --- let form: non-escaping let-bound record, field reads -> args ------------
(assert (= 0 (ctors "(fn [a b c] (let [v (->V3 a b c)] (+ (:r v) (:g v) (:b v))))")) "let-bound record, all field reads folded")
(assert (= 0 (ctors "(fn [a b c] (let [v (->V3 a b c)] (:r v)))")) "let-bound record, single field read folded (siblings discarded, pure)")
# --- sound fallbacks: keep the allocation ------------------------------------
# escaping record (passed to a sink) must NOT be folded
(assert (>= (ctors "(fn [sink a b c] (let [v (->V3 a b c)] (sink v) (:r v)))") 1) "escaping record keeps the allocation")
# returning the record escapes it
(assert (>= (ctors "(fn [a b c] (->V3 a b c))") 1) "returned record keeps the allocation")
# a non-field key read (:jolt/deftype is a virtual key) -> not folded, keep alloc
(assert (>= (ctors "(fn [a b c] (let [v (->V3 a b c)] (:jolt/deftype v)))") 1) ":jolt/deftype lookup keeps the allocation")
# --- correctness: folded path evaluates identically -------------------------
(assert (= 1 (ev "((fn [] (:r (->V3 1 2 3))))")) "direct :r value")
(assert (= 2 (ev "((fn [] (:g (->V3 1 2 3))))")) "direct :g value")
(assert (= 3 (ev "((fn [] (:b (->V3 1 2 3))))")) "direct :b value")
(assert (= 6 (ev "((fn [a b c] (let [v (->V3 a b c)] (+ (:r v) (:g v) (:b v)))) 1 2 3)")) "let-bound sum value")
(assert (= 10 (ev "((fn [a b] (:r (->V3 (+ a 1) (* b 2) 7))) 9 5)")) "arith-arg direct value")
# correctness of the kept-allocation fallbacks
(assert (= 1 (ev "((fn [sink a b c] (let [v (->V3 a b c)] (sink v) (:r v))) (fn [_] nil) 1 2 3)")) "escaping record reads correctly")
(assert (= "srr.V3" (ev "((fn [a b c] (let [v (->V3 a b c)] (:jolt/deftype v))) 1 2 3)")) ":jolt/deftype reads the type tag")
# --- nested records fold compositionally (bottom-up) -------------------------
(api/eval-string ctx "(defrecord Ray [orig dir])")
# (:r (:orig (->Ray (->V3 a b c) d))): inner ctors both fold away
(assert (= 0 (ctors "(fn [a b c d] (:r (:orig (->Ray (->V3 a b c) d))))")) "nested record reads fold both ctors")
(assert (= 7 (ev "((fn [a b c d] (:r (:orig (->Ray (->V3 a b c) d)))) 7 8 9 0)")) "nested record fold value")
(print "Scalar-replace of records passed!")

122
test/integration/sci-bootstrap-test.janet
View file

@ -1,122 +0,0 @@
(use ../../src/jolt/evaluator)
(use ../../src/jolt/types)
(use ../../src/jolt/reader)
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
# SCI is a clj/cljs-targeted library: its .cljc sources select implementation
# via #?(:clj ...) and have no :jolt branches — load it under clj-compat
# features (spec 02-reader S18: feature sets are a property of the loading
# context; the portable default is #{:jolt :default}).
(reader-features-set! ["jolt" "clj" "default"])
(def ctx (init-cached))
# Best-effort loading: SCI's clj-targeted requires (borkdude.graal.locking,
# clojure.tools.reader.*) don't exist on this host; a strict require would fail
# whole ns forms and cascade. See maybe-require-ns.
(put (ctx :env) :lenient-require? true)
(printf "Loading SCI stubs...\n")
(defn load-stubs [ctx filepath]
(var s (slurp filepath))
(var count 0)
(while (> (length (string/trim s)) 0)
(def [form rest] (parse-next s))
(set s rest)
(++ count)
(when (not (nil? form))
(eval-form ctx @{} form)))
(printf " Loaded %d stub forms\n" count))
(load-stubs ctx "src/jolt/clojure/sci/lang_stubs.clj")
(load-stubs ctx "src/jolt/clojure/sci/io_stubs.clj")
(load-stubs ctx "src/jolt/clojure/sci/host_stubs.clj")
# namespaces.cljc copies vars out of Jolt's own clojure.string/set/walk/edn, so
# make sure those are loaded before it runs.
(each lib ["clojure.string" "clojure.set" "clojure.walk" "clojure.edn"]
(protect (eval-form ctx @{} (first (parse-next (string "(require '[" lib "])"))))))
(defn load-file [ctx path]
(var s (slurp path))
(var count 0)
(var ok 0)
(var fail 0)
(var failures @[])
(while (> (length (string/trim s)) 0)
(def [form rest] (parse-next s))
(set s rest)
(++ count)
(if (not (nil? form))
(do
(printf "eval form %d..." count)
(flush)
(if (try
(do (eval-form ctx @{} form) true)
([err fib]
(printf " FAIL: %q\n" err)
(when (os/getenv "SCI_TRACE") (debug/stacktrace fib ""))
(array/push failures {:form-number count :error (string err) :form (string form)})
false))
(do
(printf " OK\n")
(++ ok))
(++ fail)))))
{:ok ok :fail fail :total count :failures failures})
(def sci-base "vendor/sci/src/sci")
(def load-order @[
["impl/macros.cljc" nil]
["impl/protocols.cljc" nil]
["impl/types.cljc" nil]
["impl/unrestrict.cljc" nil]
["impl/vars.cljc" nil]
["lang.cljc" nil]
["impl/utils.cljc" nil]
["ctx_store.cljc" nil]
["impl/deftype.cljc" nil]
["impl/records.cljc" nil]
["impl/core_protocols.cljc" nil]
["impl/hierarchies.cljc" nil]
# pure-Clojure macro/expander modules (loadable from SCI's real source)
["impl/destructure.cljc" nil]
["impl/doseq_macro.cljc" nil]
["impl/for_macro.cljc" nil]
["impl/fns.cljc" nil]
["impl/multimethods.cljc" nil]
["impl/namespaces.cljc" nil]
["core.cljc" nil]
])
(var total-ok 0)
(var total-fail 0)
(var all-failures @[])
(each [file expected-ns] load-order
(def path (string sci-base "/" file))
(printf "\n=== Loading %s ===\n" file)
(def result (load-file ctx path))
(printf " Result: %d ok, %d fail, %d total\n" (result :ok) (result :fail) (result :total))
(+= total-ok (result :ok))
(+= total-fail (result :fail))
(each f (result :failures)
(array/push all-failures {:file file :form-number (f :form-number) :error (f :error) :form (f :form)})))
(printf "\n==============================\n")
(printf "TOTAL: %d ok, %d fail, %d total\n" total-ok total-fail (+ total-ok total-fail))
(printf "==============================\n")
(printf "\ncurrent ns: %s\n" (ctx-current-ns ctx))
(printf "sci.core exists: %q\n" (not (nil? (ctx-find-ns ctx "sci.core"))))
(printf "total namespaces: %d\n" (length (keys ((ctx :env) :namespaces))))
(when (> (length all-failures) 0)
(printf "\n=== FAILURES ===\n")
(each f all-failures
(printf "[%s:%d] %s\n" (f :file) (f :form-number) (f :error))
(printf " form: %s\n" (f :form))))
# Regression guard: every form in the loaded SCI modules must evaluate cleanly.
(assert (= 0 total-fail)
(string total-fail " SCI form(s) failed to load (see FAILURES above)"))
(print "\nAll SCI bootstrap forms loaded successfully.")

101
test/integration/sci-runtime-test.janet
View file

@ -1,101 +0,0 @@
(use ../../src/jolt/evaluator)
(use ../../src/jolt/types)
(use ../../src/jolt/reader)
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
# SCI is a clj/cljs-targeted library: its .cljc sources select implementation
# via #?(:clj ...) and have no :jolt branches — load it under clj-compat
# features (spec 02-reader S18: feature sets are a property of the loading
# context; the portable default is #{:jolt :default}).
(reader-features-set! ["jolt" "clj" "default"])
(defn- load-stubs [ctx filepath]
(var s (slurp filepath))
(while (> (length (string/trim s)) 0)
(def [form rest] (parse-next s))
(set s rest)
(when (not (nil? form))
(protect (eval-form ctx @{} form)))))
(defn- load-file [ctx path]
(var s (slurp path))
(while (> (length (string/trim s)) 0)
(def [form rest] (parse-next s))
(set s rest)
(when (not (nil? form))
# Tolerant: SCI's clojure.core registration maps reference the full
# clojure.core surface (redundant for Jolt's native core); skip forms
# that don't resolve rather than aborting the bootstrap.
(protect (eval-form ctx @{} form)))))
# Run from project root so paths resolve
(def root (if (has-value? (dyn :syspath) 0) (first (dyn :syspath)) "."))
(def ctx (init-cached))
(load-stubs ctx (string root "/src/jolt/clojure/sci/lang_stubs.clj"))
(load-stubs ctx (string root "/src/jolt/clojure/sci/io_stubs.clj"))
(def sci-base (string root "/vendor/sci/src/sci"))
(each file ["impl/macros.cljc" "impl/protocols.cljc" "impl/types.cljc"
"impl/unrestrict.cljc" "impl/vars.cljc" "lang.cljc"
"impl/utils.cljc" "ctx_store.cljc" "impl/deftype.cljc"
"impl/records.cljc" "impl/core_protocols.cljc" "impl/hierarchies.cljc"
"impl/namespaces.cljc" "core.cljc"]
(load-file ctx (string sci-base "/" file)))
# ── Verify sci.lang NS and Type ─────────────────────────────────
(assert (not (nil? (ctx-find-ns ctx "sci.lang")))
"sci.lang namespace exists")
(assert (not (nil? (ctx-find-ns ctx "sci.core")))
"sci.core namespace exists")
# sci.lang has Type constructor
(def sci-lang (ctx-find-ns ctx "sci.lang"))
(def type-var (ns-find sci-lang "Type"))
(assert (not (nil? type-var)) "sci.lang/Type var exists")
(def ->Type (ns-find sci-lang "->Type"))
(assert (not (nil? ->Type)) "sci.lang/->Type constructor exists")
# Instantiate a Type and check field access
(def type-inst ((var-get type-var) {:sci.impl/type-name "user.Foo"}))
(assert (table? type-inst) "Type instance is a table")
(assert (not (nil? (get type-inst :jolt/deftype))) "Type instance has deftype tag")
(assert (= "user.Foo" (get (get type-inst :data) :sci.impl/type-name)) "Type field access via data")
# ── Verify sci.lang/Var ─────────────────────────────────────────
(def var-ctor-var (ns-find sci-lang "Var"))
(assert (not (nil? var-ctor-var)) "sci.lang/Var constructor exists")
(def test-var ((var-get var-ctor-var) 42 'my-var nil nil nil nil nil))
(assert (table? test-var) "Var instance is a table")
(assert (= 42 (get test-var :root)) "Var deref")
# var? check — SCI Var is not a Jolt var but is a table with proper fields
(assert (not (nil? test-var)) "Var instance is not nil")
# ── Verify sci.impl.types/IBox protocol ─────────────────────────
(def types-ns (ctx-find-ns ctx "sci.impl.types"))
(def vars-ns (ctx-find-ns ctx "sci.impl.vars"))
(assert (not (nil? types-ns)) "sci.impl.types namespace exists")
(assert (not (nil? vars-ns)) "sci.impl.vars namespace exists")
(def ibox-getVal (ns-find types-ns "getVal"))
(def ibox-setVal (ns-find types-ns "setVal"))
(assert (not (nil? ibox-getVal)) "sci.impl.types/getVal exists")
(assert (not (nil? ibox-setVal)) "sci.impl.types/setVal exists")
# Test IBox setVal/getVal exist but skip dispatch (SCI protocol machinery not fully booted)
(assert (function? (var-get ibox-setVal)) "sci.impl.types/setVal is callable")
(assert (function? (var-get ibox-getVal)) "sci.impl.types/getVal is callable")
# ── Verify sci.impl.vars/IVar protocol methods exist ─────────────
(def ivar-toSymbol (ns-find vars-ns "toSymbol"))
(def ivar-hasRoot (ns-find vars-ns "hasRoot"))
(assert (not (nil? ivar-toSymbol)) "sci.impl.vars/toSymbol exists")
(assert (not (nil? ivar-hasRoot)) "sci.impl.vars/hasRoot exists")
# ── Verify SCI eval function exists ─────────────────────────────
(def sci-core (ctx-find-ns ctx "sci.core"))
(assert (not (nil? sci-core)) "sci.core namespace exists")
(printf "\nAll SCI runtime tests passed!\n")

96
test/integration/self-host-test.janet
View file

@ -1,96 +0,0 @@
# End-to-end proof of the self-hosting pipeline: a reader form is analyzed by the
# PORTABLE Clojure analyzer (jolt.analyzer, in jolt-core) into host-neutral IR,
# then the Janet back end lowers the IR to a Janet form and evaluates it. No use
# of compiler.janet's analyzer — this is the Clojure-in-Clojure front end.
(import ../../src/jolt/backend :as backend)
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(use ../../src/jolt/types)
(defn ce [ctx s] (normalize-pvecs (backend/compile-and-eval ctx (parse-string s))))
(print "self-host pipeline (Clojure analyzer -> IR -> Janet)...")
(let [ctx (init-cached)]
# primitives + control flow
(assert (= 3 (ce ctx "(+ 1 2)")) "+")
(assert (= 6 (ce ctx "(* 2 3)")) "*")
(assert (= :a (ce ctx "(if true :a :b)")) "if true")
(assert (= :b (ce ctx "(if false :a :b)")) "if false")
(assert (= 10 (ce ctx "(let [x 4 y 6] (+ x y))")) "let")
(assert (= 6 (ce ctx "(do 1 2 6)")) "do")
# literals
(assert (= [2 3 4] (ce ctx "(map inc [1 2 3])")) "vector literal + core fn")
(assert (= 1 (ce ctx "(get {:a 1 :b 2} :a)")) "map literal")
(assert (= 42 (ce ctx "(quote 42)")) "quote literal")
# def + global reference (name-based var resolution)
(ce ctx "(def base 100)")
(assert (= 142 (ce ctx "(+ base 42)")) "def + later ref")
# fn / defn (defn is a macro -> expand -> def of fn*)
(ce ctx "(defn add [a b] (+ a b))")
(assert (= 7 (ce ctx "(add 3 4)")) "defn")
(assert (= 49 (ce ctx "((fn [x] (* x x)) 7)")) "anon fn")
# recursion through the var cell (no recur needed)
(ce ctx "(defn fib [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))")
(assert (= 55 (ce ctx "(fib 10)")) "recursive fib via var")
# multi-arity + variadic
(ce ctx "(defn arity ([a] a) ([a b] (+ a b)) ([a b & more] (apply + a b more)))")
(assert (= 5 (ce ctx "(arity 5)")) "multi-arity 1")
(assert (= 7 (ce ctx "(arity 3 4)")) "multi-arity 2")
(assert (= 15 (ce ctx "(arity 1 2 3 4 5)")) "multi-arity variadic")
# loop / recur
(assert (= 15 (ce ctx "(loop [i 0 acc 0] (if (< i 6) (recur (inc i) (+ acc i)) acc))")) "loop/recur")
# recur directly in a fixed-arity fn
(assert (= 15 (ce ctx "((fn [n acc] (if (zero? n) acc (recur (dec n) (+ acc n)))) 5 0)")) "recur in fn")
# try / catch / finally
(assert (= "caught" (ce ctx "(try (throw 42) (catch Exception e \"caught\"))")) "try/catch")
(assert (= 7 (ce ctx "(try 7 (finally 0))")) "try/finally")
# higher-order + nesting
(assert (= 15 (ce ctx "(reduce + (map inc [0 1 2 3 4]))")) "reduce+map"))
# eval-toplevel routing: :compile? IS the self-hosted pipeline now — the only
# compile path. Forms the analyzer can't handle (stateful / destructuring) fall
# back to the interpreter, with the same observable results.
(print "self-host via eval-toplevel routing...")
(let [ctx (init-cached {:compile? true})]
(defn ev [s] (normalize-pvecs (eval-one ctx (parse-string s))))
(assert (= 3 (ev "(+ 1 2)")) "tl +")
(ev "(defn sq [x] (* x x))") # def via self-host
(assert (= 81 (ev "(sq 9)")) "tl defn")
(ev "(defmacro twice [x] (list (quote do) x x))") # stateful -> interp fallback
(assert (= 5 (ev "(do (twice 1) 5)")) "tl macro fallback")
(assert (= [1 2 3] (ev "(let [{:keys [a b c]} {:a 1 :b 2 :c 3}] [a b c])")) "tl destructuring fallback")
(assert (= 15 (ev "(reduce + (range 6))")) "tl reduce/range")
# Proof the self-hosted pipeline actually ran: only backend/ensure-analyzer
# populates jolt.analyzer. An interpret-only ctx never loads it.
(assert (pos? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings))) "analyzer loaded under :compile?"))
# Interpret mode now loads the analyzer too — for compiled macro expansion
# (ensure-macros-compiled!, every mode). The fully-interpreted oracle is the
# :compile-macros? false ctx, which must never touch the analyzer.
(let [ctx (init-cached {})]
(eval-one ctx (parse-string "(+ 1 2)"))
(assert (pos? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings)))
"analyzer loaded when interpreting (compiled expanders)"))
(let [ctx (init-cached {:compile-macros? false})]
(eval-one ctx (parse-string "(+ 1 2)"))
(assert (zero? (length ((ctx-find-ns ctx "jolt.analyzer") :mappings)))
"analyzer NOT loaded in the interpreted-macro oracle"))
# clojure.core overlay: fns moved from core.janet to jolt-core/clojure/core.clj
# load into clojure.core at init and work the same compiled or interpreted.
(print "clojure.core overlay (Clojure-defined core fns)...")
(each opts [{:compile? true} {}]
(let [ctx (init-cached opts)]
(defn ev [s] (normalize-pvecs (eval-one ctx (parse-string s))))
(assert (= 1 (ev "(ffirst [[1 2] [3 4]])")) "ffirst")
(assert (= [2] (ev "(nfirst [[1 2] [3 4]])")) "nfirst")
(assert (= 2 (ev "(fnext [1 2 3])")) "fnext")
(assert (= [3 4] (ev "(nnext [1 2 3 4])")) "nnext")))
(print "self-host pipeline passed!")

61
test/integration/selmer-test.janet
View file

@ -1,61 +0,0 @@
# Selmer acceptance (jolt-ea7): load the real Selmer template engine from
# ~/src/selmer and render through its full pipeline — the java.time shims
# (DateTimeFormatter/Instant/ZoneId/LocalDateTime), the java.io shims
# (StringReader/StringBuilder + char-array readers), vector :import sharing
# deftype ctors, and :refer :all. SKIPS cleanly if the checkout is absent
# (CI has no ~/src/selmer); the shim surface itself is covered by
# test/spec/host-interop-spec.janet either way.
(import ../../src/jolt/api :as api)
(use ../../src/jolt/reader)
(def selmer-src (string (os/getenv "HOME") "/src/selmer/src"))
(def selmer-res (string (os/getenv "HOME") "/src/selmer/resources"))
(if (nil? (os/stat (string selmer-src "/selmer/parser.clj")))
(print "selmer-test: ~/src/selmer not present, skipping")
(do
(reader-features-set! ["jolt" "clj" "default"])
(def ctx (api/init {:paths [selmer-src selmer-res]}))
(print "loading selmer.parser...")
(api/eval-string ctx "(require (quote [selmer.parser :as sp]))")
(print " ok")
(defn render [tpl ctx-map-src]
(api/eval-string ctx (string "(sp/render " (describe tpl) " " ctx-map-src ")")))
(print "variable + filter...")
(assert (= "Hello WORLD!" (render "Hello {{name|upper}}!" "{:name \"world\"}")))
(print " ok")
(print "date filter (java.time path)...")
(def d (render "{{d|date:yyyy-MM-dd}}" "{:d #inst \"2020-03-05T10:00:00Z\"}"))
(assert (peg/match '(* :d :d :d :d "-" :d :d "-" :d :d -1) d)
(string "date filter renders a yyyy-MM-dd date, got: " d))
(print " ok")
(print "if / for tags...")
(assert (= "YES" (render "{% if ok %}YES{% else %}NO{% endif %}" "{:ok true}")))
(assert (= "NO" (render "{% if ok %}YES{% else %}NO{% endif %}" "{:ok false}")))
(assert (= "1,2,3," (render "{% for x in xs %}{{x}},{% endfor %}" "{:xs [1 2 3]}")))
(print " ok")
(print "nested lookup + escaping...")
(assert (= "7" (render "{{m.a.b}}" "{:m {:a {:b 7}}}")))
(assert (= "&lt;b&gt;&amp;" (render "{{x}}" "{:x \"<b>&\"}")))
(print " ok")
(print "file templates (render-file + cache)...")
(def tpl-dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-selmer-test"))
(os/mkdir tpl-dir)
(spit (string tpl-dir "/t.html") "File says {{x|upper}}")
(api/eval-string ctx (string "(selmer.util/set-custom-resource-path! " (describe (string tpl-dir "/")) ")"))
(assert (= "File says HI"
(api/eval-string ctx "(sp/render-file \"t.html\" {:x \"hi\"})")))
# second render goes through the template cache (last-modified check)
(assert (= "File says AGAIN"
(api/eval-string ctx "(sp/render-file \"t.html\" {:x \"again\"})")))
(print " ok")
(print "selmer-test: all passed")))

64
test/integration/shape-transparency-test.janet
View file

@ -1,64 +0,0 @@
# Shape-record transparency (jolt-t34 Round 1). A shape-rec is the compiler's
# cheap representation for a constant-key map literal — a Janet tuple
# [descriptor v0 v1 ...]. Every map operation must treat it EXACTLY like the
# equivalent struct map, so a shape value is transparent wherever it flows.
# These build shape-recs directly via the runtime (shape-for + tuple) and
# assert each op matches the struct map's behavior.
(use ../../src/jolt/types)
(use ../../src/jolt/core)
(var fails 0)
(defn check [label got want]
(if (deep= got want) (print " ok " label)
(do (++ fails) (printf " FAIL %s: got %j want %j" label got want))))
# {:a 1 :b 2} as a shape-rec and as a struct — they must be indistinguishable
(def SH (shape-for [:a :b]))
(def r (tuple SH 1 2))
(def s {:a 1 :b 2})
# --- access ------------------------------------------------------------------
(check "get hit" (core-get r :a nil) 1)
(check "get hit 2" (core-get r :b nil) 2)
(check "get miss" (core-get r :z :d) :d)
(check "count" (core-count r) 2)
(check "contains? hit" (core-contains? r :a) true)
(check "contains? miss" (core-contains? r :z) false)
(check "map?" (core-map? r) true)
# --- update (returns something that reads back correctly) --------------------
(check "assoc existing" (core-get (core-assoc r :a 9) :a nil) 9)
(check "assoc new key" (core-get (core-assoc r :c 3) :c nil) 3)
(check "assoc keeps others" (core-get (core-assoc r :c 3) :b nil) 2)
(check "dissoc" (core-get (core-dissoc r :a) :a :gone) :gone)
(check "dissoc keeps" (core-get (core-dissoc r :a) :b nil) 2)
# --- enumeration: entries via the central seq normalizer (what keys/vals/seq/
# reduce-kv in the overlay all flow through) — order-independent ---------------
(defn entryset [m] (sorted (map |(string/format "%j" $) (realize-for-iteration m))))
(check "entries match struct" (entryset r) (entryset s))
(check "count of seq" (length (core-seq r)) 2)
(check "first is a 2-entry" (length (core-first r)) 2)
# --- equality: a shape-rec equals the same struct map and vice versa ---------
(check "= shape vs struct" (jolt-equal? r s) true)
(check "= struct vs shape" (jolt-equal? s r) true)
(check "= shape vs shape" (jolt-equal? r (tuple (shape-for [:a :b]) 1 2)) true)
(check "not= diff value" (jolt-equal? r (tuple (shape-for [:a :b]) 1 9)) false)
(check "not= diff shape" (jolt-equal? r (tuple (shape-for [:a :b :c]) 1 2 3)) false)
(check "not= vs vector" (jolt-equal? r [1 2]) false)
# --- IFn: a map is callable as a key lookup ----------------------------------
(check "call as fn" (jolt-call r :a) 1)
(check "call as fn miss default" (jolt-call r :z :d) :d)
# --- nil/false values are present (shape-recs store them positionally) --------
(def rn (tuple (shape-for [:a :b]) nil false))
(check "nil value present" (core-contains? rn :a) true)
(check "nil value get" (core-get rn :a :d) nil)
(check "false value get" (core-get rn :b :d) false)
(check "count with nils" (core-count rn) 2)
(if (> fails 0)
(error (string "shape-transparency: " fails " failing check(s)"))
(print "\nShape transparency passed!"))

63
test/integration/sorted-rbtree-test.janet
View file

@ -1,63 +0,0 @@
# sorted-map / sorted-set are a red-black tree (jolt-0hbr), ported from the
# ClojureScript PersistentTreeMap. assoc/dissoc are O(log n); the old sorted-
# vector rep was O(n) per op (O(n^2) to build — 55s for 2000 entries). This
# drives big shuffled insert/delete sequences (which stress rebalancing) through
# the built binary and checks ordering + a sub-quadratic build time.
(import ../../src/jolt/api :as api)
(print "sorted-map/set red-black tree (jolt-0hbr)...")
(os/setenv "JOLT_DIRECT_LINK" "1")
(def ctx (api/init-cached {:compile? true}))
(defn ev [s] (api/eval-string ctx s))
(var fails 0)
(defn check [label got expected]
(if (= got expected) (print " ok " label)
(do (++ fails) (printf " FAIL %s: want %p got %p" label expected got))))
# --- ordering is maintained through heavy rebalancing -----------------------
(check "shuffled 500 keys come back sorted"
(ev "(= (vec (keys (apply sorted-map (interleave (shuffle (vec (range 500))) (range 500))))) (vec (range 500)))")
true)
(check "sorted-set of shuffled 500 is sorted"
(ev "(= (vec (apply sorted-set (shuffle (vec (range 500))))) (vec (range 500)))")
true)
# --- delete maintains order + correctness (stresses delete rebalancing) ------
(check "dissoc every even key, odds remain in order"
(ev "(let [m (apply sorted-map (interleave (shuffle (vec (range 200))) (range 200)))
m2 (reduce dissoc m (range 0 200 2))]
(= (vec (keys m2)) (vec (range 1 200 2))))")
true)
(check "disj down to empty then rebuild"
(ev "(let [s (apply sorted-set (range 100))
s2 (reduce disj s (shuffle (vec (range 100))))]
(and (= 0 (count s2)) (= [1 2 3] (vec (conj s2 3 1 2 1)))))")
true)
# --- comparator + lookup correctness ----------------------------------------
(check "custom comparator (descending)"
(ev "(= (vec (keys (sorted-map-by > 1 :a 3 :c 2 :b))) [3 2 1])") true)
(check "get/contains go through comparator (1 vs 1.0)"
(ev "(and (contains? (sorted-set 1 2 3) 1.0) (= :a (get (sorted-map 1 :a) 1.0)))") true)
(check "first-inserted key kept on value replace"
(ev "(first (first (assoc (sorted-map 1 :a) 1.0 :b)))") 1)
# --- count + subseq ----------------------------------------------------------
(check "count after mixed ops"
(ev "(count (-> (apply sorted-map (interleave (range 50) (range 50))) (dissoc 10 20 30) (assoc 100 1 101 2)))") 49)
(check "subseq range"
(ev "(= (vec (map first (subseq (apply sorted-map (interleave (range 20) (range 20))) >= 5 < 9))) [5 6 7 8])") true)
# --- complexity: building a big map must be sub-quadratic --------------------
(def t0 (os/clock))
(ev "(count (loop [i 0 m (sorted-map)] (if (< i 5000) (recur (inc i) (assoc m (mod (* i 7919) 10007) i)) m)))")
(def elapsed (- (os/clock) t0))
(printf " 5000 assocs: %.2fs" elapsed)
(if (< elapsed 8.0)
(print " ok sorted assoc is sub-quadratic (< 8s)")
(do (++ fails) (printf " FAIL sorted build too slow (%.1fs) — O(n^2)?" elapsed)))
(if (> fails 0) (do (printf "sorted-rbtree: %d FAILED" fails) (os/exit 1))
(print "sorted-rbtree (jolt-0hbr) passed!"))

63
test/integration/staged-bootstrap-test.janet
View file

@ -1,63 +0,0 @@
# Staged-bootstrap soundness (jolt-vcx, under epic jolt-tzo).
#
# The self-hosted compiler's structural deps — second/peek/subvec/mapv/update —
# now come from the Clojure kernel tier (jolt-core/clojure/core/00-kernel.clj),
# bootstrap-compiled into clojure.core BEFORE the analyzer is built. This pins
# the two properties that make that safe:
#
# 1. Compile mode: the analyzer (which itself calls second/peek/subvec/mapv)
# compiles analyzer-exercising forms correctly — the exact case that broke
# when `second` was a plain overlay fn: (first {:a 1}) / (key (first ...)).
# 2. Bootstrap FIXPOINT: rebuilding the compiler (rebuild-compiler!) against the
# now Clojure-defined core still yields a correct compiler. This is the
# soundness gate for every future fractal turn (S2 -> S3).
(use ../../src/jolt/api)
(import ../../src/jolt/backend :as backend)
(var failures 0)
# Each probe is a jolt boolean expression; compared with jolt's own `=`.
(def probes
["(= 2 (second [1 2 3]))"
"(= nil (second [1]))"
"(= 3 (peek [1 2 3]))"
"(= 1 (peek (list 1 2 3)))"
"(= nil (peek []))"
"(= [2 3] (subvec [1 2 3 4 5] 1 3))"
"(= [3 4 5] (subvec [1 2 3 4 5] 2))"
"(= [2 3 4] (mapv inc [1 2 3]))"
"(= [11 22 33] (mapv + [1 2 3] [10 20 30]))"
"(= {:a 2} (update {:a 1} :a inc))"
"(= {:a 1 :b 1} (update {:a 1} :b (fnil inc 0)))"
# Regression: these run the analyzer's own second/map-pair path in compile mode.
"(= [:a 1] (first {:a 1}))"
"(= :a (key (first {:a 1})))"
"(= 1 (val (first {:a 1})))"
"(= 3 (let [[a b] [1 2]] (+ a b)))"
"(= 3 (loop [i 0 acc 0] (if (< i 3) (recur (inc i) (+ acc i)) acc)))"])
(defn- run-probes [ctx label]
(each prog probes
(def got (protect (eval-string ctx prog)))
(unless (and (got 0) (= (got 1) true))
(++ failures)
(printf "FAIL [%s] %s => %s" label prog
(if (got 0) (string/format "%q" (got 1)) (string "ERR:" (got 1)))))))
# Interpret mode: kernel tier interpreted, no analyzer involved.
(run-probes (init {}) "interpret")
# Compile mode: kernel tier bootstrap-compiled, analyzer built against it.
(def cctx (init {:compile? true}))
(run-probes cctx "compile")
# Fixpoint: rebuild the compiler against the current (Clojure-defined) core and
# re-run. A correct compiler recompiled on the language it just defined stays
# correct.
(backend/rebuild-compiler! cctx)
(run-probes cctx "compile+rebuilt")
(if (pos? failures)
(do (printf "staged-bootstrap: %d failure(s)" failures) (os/exit 1))
(print "staged-bootstrap: all probes passed (interpret, compile, compile+rebuilt)"))

79
test/integration/struct-hint-test.janet
View file

@ -1,79 +0,0 @@
# Type hints driving keyword-lookup specialization (jolt-94n). A local hinted
# ^:struct (a plain struct/record map) or ^Record (a defrecord/deftype) lets a
# constant-keyword lookup skip the :jolt/type guard and emit a bare get
# (~20ns vs ~36ns), the way Clojure type hints let the compiler specialize.
# Covers both (:k m) and (get m :k), hint propagation through inlining, the
# ^Record path, the JOLT_CHECK_HINTS dev aid, and that accurate hints preserve
# results. An inaccurate hint is a programmer error (like a wrong ^String): the
# raw get returns the wrong value, surfaced only under JOLT_CHECK_HINTS.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as reader)
(print "Type hints (jolt-94n)...")
(os/setenv "JOLT_DIRECT_LINK" "1") # inline on, so hint-through-inline is exercised
(def ctx (api/init-cached {:compile? true}))
(api/eval-string ctx "(ns sh)")
(api/eval-string ctx "(defrecord Vec3r [r g b])")
(each s ["(defn v3 [r g b] {:r r :g g :b b})"
"(defn dot [^:struct l ^:struct r] (+ (+ (* (:r l) (:r r)) (* (:g l) (:g r))) (* (:b l) (:b r))))"
"(defn sub [^:struct l ^:struct r] {:r (- (:r l) (:r r)) :g (- (:g l) (:g r)) :b (- (:b l) (:b r))})"
"(defn lensq [^:struct v] (dot v v))"]
(api/eval-string ctx s))
(defn guards [src]
(def code (string/format "%p" (backend/emit-ir ctx (backend/analyze-form ctx (reader/parse-string src)))))
(length (string/find-all ":jolt/type" code)))
# --- guard removal ----------------------------------------------------------
(assert (= 1 (guards "(fn [v] (:r v))")) "unhinted (:r v) keeps the guard")
(assert (= 0 (guards "(fn [^:struct v] (:r v))")) "^:struct (:r v) drops the guard")
(assert (= 0 (guards "(fn [^Vec3r v] (:r v))")) "^Record (:r v) drops the guard")
(assert (= 1 (guards "(fn [^String v] (:r v))")) "^String (not a record) still guards")
(assert (= 0 (guards "(fn [^:struct v] (+ (+ (:r v) (:g v)) (:b v)))")) "all three hinted lookups bare")
(assert (= 0 (guards "(fn [^:struct v] (lensq v))")) "hint survives through an inlined call")
# hints work on let bindings too, not just params (init is a plain local here,
# so the only candidate guard is the hinted (:r v))
(assert (= 0 (guards "(fn [^:struct s] (let [^:struct v s] (:r v)))")) "^:struct on a let binding drops the guard")
(assert (= 1 (guards "(fn [s] (let [v s] (:r v)))")) "unhinted let binding keeps the guard")
# (get m :k) gets the same treatment as (:k m)
(assert (= 1 (guards "(fn [m] (get m :k))")) "unhinted (get m :k) is guarded-inline")
(assert (= 0 (guards "(fn [^:struct m] (get m :k))")) "^:struct (get m :k) drops the guard")
(assert (= 0 (guards "(fn [^Vec3r m] (get m :k 0))")) "^Record (get m :k d) drops the guard")
# a variable (non-constant) key isn't a keyword literal, so the inline doesn't
# fire — it falls through to core-get, which still indexes correctly.
(assert (= 2 (api/eval-string ctx "((fn [m kk] (get m kk)) {:a 2} :a)")) "variable-key get via core-get")
(assert (= 10 (api/eval-string ctx "((fn [m i] (get m i)) [10 20] 0)")) "variable-key get indexes a vector")
# --- correctness (accurate hints preserve results) --------------------------
(assert (= 32 (api/eval-string ctx "(dot (v3 1 2 3) (v3 4 5 6))")) "hinted dot value")
(assert (= 14 (api/eval-string ctx "(lensq (v3 1 2 3))")) "hinted lensq (inline-flow) value")
(assert (= 7 (api/eval-string ctx "(:r (sub (v3 9 8 7) (v3 2 0 0)))")) "hinted sub field")
(api/eval-string ctx "(defn hit [^:struct ray ^:struct c] (lensq (sub (:origin ray) c)))")
(assert (= 48 (api/eval-string ctx "(hit {:origin (v3 5 5 5) :direction (v3 0 0 0)} (v3 1 1 1))"))
"hinted value through nested inline reads correctly")
(assert (= nil (api/eval-string ctx "((fn [^:struct m] (:absent m)) (v3 1 2 3))")) "hinted struct miss -> nil")
(assert (= 9 (api/eval-string ctx "((fn [^:struct m] (get m :absent 9)) (v3 1 2 3))")) "hinted get default")
# field access on a real record instance through a ^Record hint
(api/eval-string ctx "(defn vr-x [^Vec3r v] (:r v))")
(assert (= 5 (api/eval-string ctx "(vr-x (->Vec3r 5 6 7))")) "record field via ^Record hint")
# (get m :k) on assorted reps still matches core-get semantics (unhinted path)
(assert (= 2 (api/eval-string ctx "(get {:a 2} :a)")) "get struct present")
(assert (= nil (api/eval-string ctx "(get {:a 2} :z)")) "get struct miss")
(assert (= 1 (api/eval-string ctx "(get (hash-map :a 1 :x nil) :a)")) "get phm present")
(assert (= nil (api/eval-string ctx "(get (hash-map :a 1 :x nil) :x)")) "get phm nil value")
(assert (= 7 (api/eval-string ctx "(get (sorted-map :a 7) :a)")) "get sorted present")
# --- checked mode: a lying hint throws (separate ctx with the flag on) -------
(os/setenv "JOLT_CHECK_HINTS" "1")
(def cctx (api/init {:compile? true}))
(api/eval-string cctx "(ns ck)")
(api/eval-string cctx "(defn rd [^:struct m] (:a m))")
(assert (= 1 (api/eval-string cctx "(rd {:a 1 :b 2})")) "checked mode: accurate hint still works")
(let [r (protect (api/eval-string cctx "(rd (hash-map :a 1 :x nil))"))]
(assert (not (r 0)) "checked mode: lying ^:struct hint throws")
(assert (string/find "type hint violated" (string (r 1))) "checked-mode error is meaningful"))
(os/setenv "JOLT_CHECK_HINTS" nil)
(print "Type hints passed!")

60
test/integration/suite-worker.janet
View file

@ -1,60 +0,0 @@
# One-file worker for the clojure-test-suite battery. Loads the clojure.test
# shim, evaluates a single suite .cljc file, runs its deftests, and prints
# "pass fail error" to stdout. Used by the discovery pass to find files that
# hang under Jolt's eager evaluation (run under an external timeout).
(use ../../src/jolt/api)
(use ../../src/jolt/reader)
(use ../../src/jolt/evaluator)
(import ../../src/jolt/backend :as selfhost)
(defn- parse-forms [src]
(var s src) (def fs @[]) (var go true)
(while (and go (> (length (string/trim s)) 0))
(def r (protect (parse-next s)))
(if (not (r 0)) (set go false)
(let [p (r 1)] (set s (p 1)) (when (not (nil? (p 0))) (array/push fs (p 0))))))
fs)
# A helper, not a standalone test: it needs a .cljc path argument. When `jpm
# test` runs it with no args, no-op cleanly so it doesn't count as a failure.
(def path (get (dyn :args) 1))
(when path
# JOLT_COMPILE=1 runs the suite through the compile path (hybrid: hot forms
# compile, unsupported forms fall back to the interpreter) so the whole battery
# validates compile-mode correctness against the same baseline.
(def compile? (= "1" (os/getenv "JOLT_COMPILE")))
# JOLT_SELFHOST=1 routes each form through the self-hosted pipeline (the
# portable Clojure analyzer + Janet back end, hybrid with interpreter fallback)
# so the whole battery validates the self-hosted compiler against the baseline.
(def selfhost? (= "1" (os/getenv "JOLT_SELFHOST")))
(def ctx (init-cached (if compile? {:compile? true} {})))
(defn run-form [f]
(cond
selfhost? (selfhost/compile-and-eval ctx f)
compile? (eval-one ctx f)
(eval-form ctx @{} f)))
(each f (parse-forms (slurp "test/support/clojure_test.clj")) (run-form f))
# Pre-load the suite's own clojure.core-test.number-range helper ns if present
# (35 files require it for r/max-int, r/max-double, … — its :default branches are
# plain numeric literals Jolt can read). Its `ns` form sets the namespace; the
# test file's own `ns` form switches back afterwards.
(let [dir (string/slice path 0 (- (length path) (length (last (string/split "/" path)))))
nr (string dir "number_range.cljc")]
(when (os/stat nr)
(each f (parse-forms (slurp nr)) (protect (run-form f)))))
(eval-string ctx "(clojure.test/reset-report!)")
(each form (parse-forms (slurp path)) (protect (run-form form)))
(protect (eval-string ctx "(clojure.test/run-registered)"))
(def p (eval-string ctx "(clojure.test/n-pass)"))
(def f (eval-string ctx "(clojure.test/n-fail)"))
(def e (eval-string ctx "(clojure.test/n-error)"))
# A "dump" 2nd arg (or SUITE_DUMP env) also prints each failure/error message
# (one DUMP line each) for triage.
(when (or (os/getenv "SUITE_DUMP") (= "dump" (get (dyn :args) 2)))
(eval-string ctx "(doseq [m (clojure.test/failures)] (println (str \"DUMP \" m)))"))
# Counts on a sentinel line so parsers find it even if a test body printed to
# stdout (e.g. with-out-str / println-str tests).
(printf "@@COUNTS %d %d %d" (if (number? p) p 0) (if (number? f) f 0) (if (number? e) e 0)))

214
test/integration/systematic-coverage-test.janet
View file

@ -1,214 +0,0 @@
# Systematic coverage tests for Clojure language features
(use ../../src/jolt/api)
(defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s)))
(print "Systematic Coverage Tests")
# --- Type Predicates ---
(print "1: type predicates...")
(let [ctx (init-cached)]
(assert (= true (ct-eval ctx "(integer? 0)")) "integer? 0")
(assert (= true (ct-eval ctx "(integer? 1)")) "integer? 1")
(assert (= true (ct-eval ctx "(integer? -5)")) "integer? negative")
(assert (= false (ct-eval ctx "(integer? 1.5)")) "integer? float")
(assert (= false (ct-eval ctx "(integer? nil)")) "integer? nil")
(assert (= false (ct-eval ctx "(integer? \"abc\")")) "integer? string")
(assert (= true (ct-eval ctx "(boolean? true)")) "boolean? true")
(assert (= true (ct-eval ctx "(boolean? false)")) "boolean? false")
(assert (= false (ct-eval ctx "(boolean? 1)")) "boolean? falsy")
(assert (= false (ct-eval ctx "(boolean? nil)")) "boolean? nil")
(assert (= true (ct-eval ctx "(nil? nil)")) "nil? nil")
(assert (= false (ct-eval ctx "(nil? false)")) "nil? false")
(assert (= false (ct-eval ctx "(nil? 0)")) "nil? 0")
(assert (= false (ct-eval ctx "(nil? [])")) "nil? empty vec")
(assert (= false (ct-eval ctx "(some? nil)")) "some? nil")
(assert (= true (ct-eval ctx "(some? false)")) "some? false")
(assert (= true (ct-eval ctx "(some? 0)")) "some? 0")
(assert (= true (ct-eval ctx "(some? [])")) "some? empty vec")
(assert (= true (ct-eval ctx "(string? \"hello\")")) "string?")
(assert (= false (ct-eval ctx "(string? 42)")) "string? false")
(assert (= true (ct-eval ctx "(string? \"\")")) "string? empty")
(assert (= true (ct-eval ctx "(number? 42)")) "number? int")
(assert (= true (ct-eval ctx "(number? 3.14)")) "number? float")
(assert (= false (ct-eval ctx "(number? \"42\")")) "number? string")
(assert (= true (ct-eval ctx "(fn? inc)")) "fn? builtin")
(assert (= false (ct-eval ctx "(fn? 42)")) "fn? false")
(assert (= true (ct-eval ctx "(keyword? :foo)")) "keyword?")
(assert (= false (ct-eval ctx "(keyword? \"foo\")")) "keyword? false")
(assert (= true (ct-eval ctx "(symbol? 'abc)")) "symbol?")
(assert (= false (ct-eval ctx "(symbol? :abc)")) "symbol? false")
(assert (= true (ct-eval ctx "(map? {:a 1})")) "map?")
(assert (= false (ct-eval ctx "(map? [1 2])")) "map? false")
(assert (= true (ct-eval ctx "(set? #{1 2})")) "set?")
(assert (= false (ct-eval ctx "(set? [1 2])")) "set? false")
(assert (= true (ct-eval ctx "(seq? '(1 2))")) "seq? list")
# vectors are not ISeq in Clojure — (seq? [1 2]) is false
(assert (= false (ct-eval ctx "(seq? [1 2])")) "seq? vector is false")
(assert (= true (ct-eval ctx "(coll? [1 2])")) "coll? vec")
(assert (= true (ct-eval ctx "(coll? '(1 2))")) "coll? list")
(assert (= true (ct-eval ctx "(coll? {})")) "coll? map")
(assert (= true (ct-eval ctx "(true? true)")) "true? true")
(assert (= false (ct-eval ctx "(true? 1)")) "true? 1")
(assert (= true (ct-eval ctx "(false? false)")) "false? false")
(assert (= false (ct-eval ctx "(false? nil)")) "false? nil")
(assert (= true (ct-eval ctx "(identical? 42 42)")) "identical? same value"))
(print " ok")
# --- Number Predicates ---
(print "2: number predicates...")
(let [ctx (init-cached)]
(assert (= true (ct-eval ctx "(zero? 0)")) "zero? 0")
(assert (= false (ct-eval ctx "(zero? 1)")) "zero? 1")
# zero?/pos?/neg? now reject non-numbers (Clojure-strict), like the JVM.
(assert (not ((protect (ct-eval ctx "(zero? nil)")) 0)) "zero? nil throws")
(assert (= true (ct-eval ctx "(pos? 1)")) "pos?")
(assert (= false (ct-eval ctx "(pos? 0)")) "pos? 0")
(assert (= false (ct-eval ctx "(pos? -1)")) "pos? -1")
(assert (= true (ct-eval ctx "(neg? -1)")) "neg?")
(assert (= false (ct-eval ctx "(neg? 0)")) "neg? 0")
(assert (= false (ct-eval ctx "(neg? 1)")) "neg? 1")
(assert (= true (ct-eval ctx "(even? 0)")) "even? 0")
(assert (= true (ct-eval ctx "(even? 2)")) "even? 2")
(assert (= false (ct-eval ctx "(even? 1)")) "even? 1")
(assert (= true (ct-eval ctx "(odd? 1)")) "odd? 1")
(assert (= true (ct-eval ctx "(odd? 3)")) "odd? 3")
(assert (= false (ct-eval ctx "(odd? 2)")) "odd? 2"))
(print " ok")
# --- Math ---
(print "3: math operations...")
(let [ctx (init-cached)]
(assert (= 0 (ct-eval ctx "(+)")) "+ 0 args")
(assert (= 5 (ct-eval ctx "(+ 2 3)")) "+ 2 args")
(assert (= 10 (ct-eval ctx "(+ 1 2 3 4)")) "+ varargs")
(assert (= -5 (ct-eval ctx "(- 5)")) "- unary")
(assert (= 2 (ct-eval ctx "(- 5 3)")) "- binary")
(assert (= 1 (ct-eval ctx "(*)")) "* 0 args")
(assert (= 6 (ct-eval ctx "(* 2 3)")) "*")
(assert (= 0.5 (ct-eval ctx "(/ 2)")) "/ unary reciprocal")
(assert (= 2 (ct-eval ctx "(/ 4 2)")) "/ binary")
(assert (= 2 (ct-eval ctx "(quot 5 2)")) "quot")
(assert (= 1 (ct-eval ctx "(rem 5 2)")) "rem")
(assert (= 1 (ct-eval ctx "(mod 5 2)")) "mod")
(assert (= 43 (ct-eval ctx "(inc 42)")) "inc")
(assert (= 41 (ct-eval ctx "(dec 42)")) "dec")
(assert (= 3 (ct-eval ctx "(max 1 2 3)")) "max")
(assert (= 1 (ct-eval ctx "(min 1 2 3)")) "min")
(assert (= 5 (ct-eval ctx "(abs -5)")) "abs negative")
(assert (= 5 (ct-eval ctx "(abs 5)")) "abs positive")
(assert (= 0 (ct-eval ctx "(abs 0)")) "abs 0")
(assert (= 3.14 (ct-eval ctx "(abs -3.14)")) "abs float")
(assert (= true (ct-eval ctx "(< (rand) 1)")) "rand < 1")
(assert (= true (ct-eval ctx "(number? (rand-int 10))")) "rand-int type"))
(print " ok")
# --- Comparison ---
(print "4: comparison...")
(let [ctx (init-cached)]
(assert (= true (ct-eval ctx "(= 1 1)")) "= same")
(assert (= true (ct-eval ctx "(= 1 1 1)")) "= multi same")
(assert (= false (ct-eval ctx "(= 1 2)")) "= different")
(assert (= true (ct-eval ctx "(not= 1 2)")) "not= different")
(assert (= false (ct-eval ctx "(not= 1 1)")) "not= same")
(assert (= true (ct-eval ctx "(< 1 2)")) "<")
(assert (= false (ct-eval ctx "(< 2 1)")) "< false")
(assert (= true (ct-eval ctx "(> 2 1)")) ">")
(assert (= true (ct-eval ctx "(<= 1 1)")) "<=")
(assert (= true (ct-eval ctx "(>= 2 2)")) ">="))
(print " ok")
# --- Boolean logic ---
(print "5: boolean logic...")
(let [ctx (init-cached)]
(assert (= true (ct-eval ctx "(and)")) "and empty")
(assert (= true (ct-eval ctx "(and true)")) "and true")
(assert (= nil (ct-eval ctx "(and nil)")) "and nil")
(assert (= false (ct-eval ctx "(and false)")) "and false")
(assert (= 3 (ct-eval ctx "(and 1 2 3)")) "and last")
(assert (= nil (ct-eval ctx "(and 1 nil 3)")) "and short-circuit")
(assert (= nil (ct-eval ctx "(or)")) "or empty")
(assert (= true (ct-eval ctx "(or true)")) "or true")
(assert (= nil (ct-eval ctx "(or nil)")) "or nil")
(assert (= false (ct-eval ctx "(or false)")) "or false")
(assert (= 1 (ct-eval ctx "(or nil false 1 2)")) "or first truthy")
(assert (= false (ct-eval ctx "(or nil false)")) "or all falsy")
(assert (= false (ct-eval ctx "(not true)")) "not true")
(assert (= true (ct-eval ctx "(not nil)")) "not nil")
(assert (= true (ct-eval ctx "(not false)")) "not false"))
(print " ok")
# --- Collections ---
(print "6: collections...")
(let [ctx (init-cached)]
(assert (= true (ct-eval ctx "(empty? nil)")) "empty? nil")
(assert (= true (ct-eval ctx "(empty? [])")) "empty? []")
(assert (= true (ct-eval ctx "(empty? ())")) "empty? ()")
(assert (= true (ct-eval ctx "(empty? {})")) "empty? {}")
(assert (= true (ct-eval ctx "(empty? #{})")) "empty? #{}")
(assert (= true (ct-eval ctx "(empty? \"\")")) "empty? empty string")
(assert (= false (ct-eval ctx "(empty? [1])")) "empty? non-empty")
(assert (= true (ct-eval ctx "(every? even? [2 4 6])")) "every? true")
(assert (= false (ct-eval ctx "(every? even? [2 3 4])")) "every? false")
(assert (= 3 (ct-eval ctx "(count [1 2 3])")) "count vector")
(assert (= 2 (ct-eval ctx "(count {:a 1 :b 2})")) "count map")
(assert (= 3 (ct-eval ctx "(count #{1 2 3})")) "count set")
(assert (= 3 (ct-eval ctx "(count \"abc\")")) "count string"))
(print " ok")
# --- Sequence Operations ---
(print "7: sequence operations...")
(let [ctx (init-cached)]
(assert (= 1 (ct-eval ctx "(first [1 2 3])")) "first")
(assert (= nil (ct-eval ctx "(first [])")) "first empty")
(assert (= nil (ct-eval ctx "(first nil)")) "first nil")
(assert (= :a (ct-eval ctx "(nth [:a :b :c] 0)")) "nth 0")
(assert (= :c (ct-eval ctx "(nth [:a :b :c] 2)")) "nth 2")
(assert (= :d (ct-eval ctx "(nth [:a :b :c] 3 :d)")) "nth default")
(assert (= nil (ct-eval ctx "(seq [])")) "seq empty -> nil")
(assert (= nil (ct-eval ctx "(seq nil)")) "seq nil -> nil")
(assert (= true (ct-eval ctx "(= [2 3 4] (map inc [1 2 3]))")) "map")
(assert (= true (ct-eval ctx "(= [2 4] (filter even? [1 2 3 4]))")) "filter")
(assert (= 6 (ct-eval ctx "(reduce + [1 2 3])")) "reduce")
(assert (= 10 (ct-eval ctx "(reduce + 4 [1 2 3])")) "reduce init")
(assert (= true (ct-eval ctx "(= [1 2] (take 2 [1 2 3 4]))")) "take")
(assert (= true (ct-eval ctx "(= [3 4] (drop 2 [1 2 3 4]))")) "drop")
(assert (= true (ct-eval ctx "(= [3 2 1] (reverse [1 2 3]))")) "reverse")
(assert (= true (ct-eval ctx "(= 3 (count (distinct [1 1 2 2 3 3])))")) "distinct"))
(print " ok")
# --- Collections: conj, assoc, dissoc, get ---
(print "8: collection mutation...")
(let [ctx (init-cached)]
(assert (= true (ct-eval ctx "(= [1 2 3] (conj [1 2] 3))")) "conj vector")
(assert (= true (ct-eval ctx "(= (quote (0 1 2)) (conj (quote (1 2)) 0))")) "conj list prepend")
(assert (= true (ct-eval ctx "(= {:a 1 :b 2} (assoc {:a 1} :b 2))")) "assoc")
(assert (= true (ct-eval ctx "(= {:a 1} (dissoc {:a 1 :b 2} :b))")) "dissoc")
(assert (= 1 (ct-eval ctx "(get {:a 1} :a)")) "get")
(assert (= nil (ct-eval ctx "(get {:a 1} :z)")) "get missing")
(assert (= :d (ct-eval ctx "(get {:a 1} :z :d)")) "get default")
(assert (= true (ct-eval ctx "(contains? {:a 1} :a)")) "contains? map")
(assert (= false (ct-eval ctx "(contains? {:a 1} :z)")) "contains? missing")
(assert (= true (ct-eval ctx "(contains? [5 6 7] 1)")) "contains? vector")
(assert (= false (ct-eval ctx "(contains? [5 6 7] 3)")) "contains? vector oob"))
(print " ok")
# --- Higher-order functions ---
(print "9: higher-order functions...")
(let [ctx (init-cached)]
(assert (= 3 (ct-eval ctx "((comp inc inc) 1)")) "comp")
(assert (= 42 (ct-eval ctx "(identity 42)")) "identity")
(assert (= 99 (ct-eval ctx "((constantly 99) :anything)")) "constantly")
(assert (= true (ct-eval ctx "(= 10 ((partial + 3 7)))")) "partial")
(assert (= true (ct-eval ctx "((every-pred even? pos?) 4)")) "every-pred true")
(assert (= false (ct-eval ctx "((every-pred even? pos?) -4)")) "every-pred false")
(assert (= false (ct-eval ctx "((complement even?) 2)")) "complement"))
(print " ok")
# --- Destructuring ---
(print "10: destructuring...")
(let [ctx (init-cached)]
(assert (= 1 (ct-eval ctx "(let [[x] [1 2 3]] x)")) "seq destructure first")
(assert (= 2 (ct-eval ctx "(let [[_ y] [1 2 3]] y)")) "seq destructure second"))
(print " ok")
(print "\nAll Systematic Coverage tests passed!")

137
test/integration/type-check-test.janet
View file

@ -1,137 +0,0 @@
# Success-type checking (RFC 0006, jolt-y3b). The structural inference of
# RFC 0005, reused as a loose checker: flag a core-fn call ONLY when an argument
# is PROVABLY the wrong type (concrete and in the op's throwing error domain).
# Ambiguous cases (:any, unions, :truthy) are accepted — no false positives.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/types :as types)
(import ../../src/jolt/reader :as reader)
(print "Success-type checking (jolt-y3b)...")
(os/setenv "JOLT_DIRECT_LINK" "1")
(reader/track-positions! true) # record form positions (jolt-fqy)
(def ctx (api/init {:compile? true}))
(def pns (types/ctx-find-ns ctx "jolt.passes"))
(def check (types/var-get (types/ns-find pns "check-form")))
# diagnostics (a Janet tuple of diag structs) for a source form
(defn diags [src]
(api/normalize-pvecs (check (backend/analyze-form ctx (reader/parse-string src)))))
(defn nd [src] (length (diags src)))
# strict mode (jolt-zo1): also report provably-wrong calls to user fns
(defn nds [src]
(length (api/normalize-pvecs
(check (backend/analyze-form ctx (reader/parse-string src)) true))))
# --- provably wrong: REPORTED ------------------------------------------------
(assert (= 1 (nd "(inc \"x\")")) "inc on a string")
(assert (= 1 (nd "(+ 1 \"x\")")) "+ with a string arg")
(assert (= 1 (nd "(count :foo)")) "count of a keyword")
(assert (= 1 (nd "(count 5)")) "count of a number")
(assert (= 1 (nd "(first 42)")) "first of a number")
(assert (= 1 (nd "(nth :k 0)")) "nth of a keyword")
(assert (= 1 (nd "(let [n \"x\"] (inc n))")) "inc on a let-bound string")
(assert (= 1 (nd "(inc (count :k))")) "inner count of keyword reported (inc of :num is fine)")
# --- ambiguous / lenient: ACCEPTED (no false positive) -----------------------
(assert (= 0 (nd "(:k 5)")) "keyword lookup on a number returns nil, not an error")
(assert (= 0 (nd "(get 5 :k)")) "get on a number returns nil, not an error")
(assert (= 0 (nd "(fn [x] (inc x))")) "inc on an unknown (:any) param accepted")
(assert (= 0 (nd "(fn [c] (inc (if c 1 \"x\")))")) "inc on a {:num | :str} branch -> :any, accepted")
(assert (= 0 (nd "(count \"ab\")")) "count of a string is fine")
(assert (= 0 (nd "(count [1 2 3])")) "count of a vector is fine")
(assert (= 0 (nd "(first [1 2 3])")) "first of a vector is fine")
(assert (= 0 (nd "(inc (count [1 2 3]))")) "count of vector + inc of :num both fine")
(assert (= 0 (nd "(inc (first [1 2 3]))")) "first of vector -> :num, inc fine")
# --- calling a non-function (jolt-wwy): :num and :str are not callable --------
(assert (= 1 (nd "(5 1)")) "calling a number is reported")
(assert (= 1 (nd "(\"hi\" 0)")) "calling a string is reported")
(assert (= 1 (nd "((+ 1 2) :k)")) "calling an arithmetic result (a :num) is reported")
(assert (= 1 (nd "(let [n 5] (n 1))")) "calling a let-bound number is reported")
(assert (= 1 (nd "(let [s \"x\"] (s 0))")) "calling a let-bound string is reported")
# (a var holding a number, e.g. (def nn 5) (nn 1), is caught in direct-link
# mode via vtype-box; the standalone checker has no var value types)
# callable values: keyword/map/vector/set as IFn — NOT reported
(assert (= 0 (nd "(:k {:k 1})")) "keyword call is fine")
(assert (= 0 (nd "({:a 1} :a)")) "map call is fine")
(assert (= 0 (nd "([10 20] 1)")) "vector call is fine")
(assert (= 0 (nd "(#{1 2} 1)")) "set call is fine")
(assert (= 0 (nd "(fn [c] ((if c 1 :k) 0))")) "union {:num | :kw} callee accepted (:kw is callable)")
(assert (= 0 (nd "(fn [f] (f 1))")) "calling an unknown (:any) param accepted")
(assert (= 1 (nd "(fn [c] ((if c 1 \"x\") 0))")) "union {:num | :str} callee — both non-callable — reported")
# --- bounded unions (jolt-pz5): report only when EVERY member is in the error
# domain; accept when any member is valid. Differing branches used to collapse
# to :any (accepted); now they form {:union #{...}} and are checked per-member.
(assert (= 1 (nd "(fn [c] (inc (if c \"a\" :k)))"))
"inc of {:str | :kw} — every member non-number — reported")
(assert (= 0 (nd "(fn [c] (inc (if c 1 \"x\")))"))
"inc of {:num | :str} — :num is fine — still accepted")
(assert (= 1 (nd "(fn [c] (count (if c :k 5)))"))
"count of {:kw | :num} — both non-seqable — reported")
(assert (= 0 (nd "(fn [c] (count (if c :k \"ab\")))"))
"count of {:kw | :str} — :str is seqable — accepted")
(assert (= 1 (nd "(fn [c] (inc (if c \"a\" (if c :k :j))))"))
"inc of nested all-non-number union reported")
(assert (= 0 (nd "(fn [c] (inc (if c \"a\" (if c :k 1))))"))
"inc of union with a buried :num member accepted")
# a union is opaque to structural specialization — it keeps the dynamic guard,
# exactly like :any, so a keyword lookup over it is never mis-specialized.
(assert (= 0 (nd "(fn [c] (:r (if c {:r 1} {:g 2})))"))
"keyword lookup over a struct union is accepted (no false positive)")
# --- user-function error domains (jolt-zo1), opt-in strict mode --------------
# A call passing a provably-wrong type to a user fn whose body requires
# otherwise is reported ONLY in strict mode; the default level never fires on
# user fns (closed-world soundness boundary).
(assert (= 0 (nd "(do (defn ufa [x] (+ x 1)) (ufa \"s\"))"))
"user-fn wrong call NOT reported at the default level")
(assert (= 1 (nds "(do (defn ufa [x] (+ x 1)) (ufa \"s\"))"))
"strict: arithmetic fn called with a string is reported")
(assert (= 0 (nds "(do (defn ufb [x] (+ x 1)) (ufb 5))"))
"strict: same fn called with a number is accepted")
(assert (= 0 (nds "(do (defn ufc [x] (:k x)) (ufc \"s\"))"))
"strict: a body that uses the param leniently is not reported")
# cross-form: a def registered by an earlier check is visible to a later call
(nds "(defn ufd [x] (count x))")
(assert (= 1 (nds "(ufd 42)"))
"strict: cross-form call to a seq-only fn with a number is reported")
(assert (= 0 (nds "(do (defn ^:redef ufe [x] (+ x 1)) (ufe \"s\"))"))
"strict: a ^:redef fn is not a stable requirement, not reported")
(assert (= 1 (nds "(do (defn ufrec [x] (ufrec (+ x 1))) (ufrec \"s\"))"))
"strict: self-recursion terminates (cycle guard) and the (+ x 1) on a string is reported once")
# wrong arity to a user fn (jolt-wwy), strict mode: the registered fixed arity
# makes a mismatched call provably throw, regardless of argument types
(assert (= 1 (nds "(do (defn uar [x y] (+ x y)) (uar 1))"))
"strict: 2-arg fn called with 1 arg is reported")
(assert (= 1 (nds "(do (defn uar2 [x] x) (uar2 1 2 3))"))
"strict: 1-arg fn called with 3 args is reported")
(assert (= 0 (nds "(do (defn uar3 [x y] (+ x y)) (uar3 1 2))"))
"strict: correct arity accepted")
(assert (= 0 (nd "(do (defn uar4 [x y] (+ x y)) (uar4 1))"))
"default level does NOT report user-fn arity (closed-world, opt-in)")
(assert (= 0 (nds "(do (defn ^:redef uar5 [x y] (+ x y)) (uar5 1))"))
"strict: ^:redef fn arity not checked (could be redefined)")
# --- the diagnostic carries op + type + a message ----------------------------
(def one (in (diags "(inc \"x\")") 0))
(assert (= "inc" (get one :op)) "diagnostic names the op")
(assert (string/find "number" (get one :msg)) "message says a number is required")
# --- the diagnostic carries the offending form's source offset (jolt-fqy) -----
(assert (= 0 (get one :pos)) "diagnostic carries :pos (offset 0 for a single form)")
(def nested (in (diags "(do 1 2 (inc :k))") 0))
(assert (= 8 (get nested :pos))
"the inner (inc :k) form is positioned at its own offset, not the do's")
# --- end-to-end: strictness drives compilation (decoupled from :inline?) -----
# error mode aborts a provably-wrong form's compilation; a correct form compiles.
(os/setenv "JOLT_TYPE_CHECK" "error")
(assert (not (first (protect (api/eval-string ctx "(count :nope)"))))
"error mode aborts a provably-wrong form")
(assert (first (protect (api/eval-string ctx "(count [1 2 3])")))
"error mode accepts a correct form")
(os/setenv "JOLT_TYPE_CHECK" "off")
(print "Success-type checking passed!")

55
test/integration/type-infer-phase1-test.janet
View file

@ -1,55 +0,0 @@
# Inter-procedural collection-type inference, Phase 1 (jolt-767): closed-world.
# A whole-unit fixpoint propagates collection types through the call graph — a
# fn's param types become the lub of its in-unit call-site arg types — so a
# param that always receives a struct map gets typed and its lookups specialize,
# with no hint. Fns whose var escapes as a value keep :any params (their callers
# aren't all visible). Sound under source distribution + whole-program compile.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/types :as types)
(import ../../src/jolt/reader :as reader)
(print "Type inference Phase 1 (jolt-767)...")
(os/setenv "JOLT_DIRECT_LINK" "1")
(def ctx (api/init-cached {:compile? true}))
(api/eval-string ctx "(ns p1)")
# closed-world unit. mk is small (inlined away). rd is RECURSIVE, so it survives
# inlining and is called via its var — exactly the shape (big/recursive fn with
# escaping-from-the-caller params) that inter-procedural inference targets. Its
# param v flows from mk's struct-map literal (after mk inlines into drv).
(each s ["(defn mk [a b] {:r a :g b})"
"(defn rd [v n] (if (< n 1) (:r v) (rd v (dec n))))"
"(defn drv [] (rd (mk 1 2) 3))"
# esc's var is used as a VALUE (passed to mapv) -> params must stay :any
"(defn esc [w] (:r w))"
"(defn use-esc [xs] (mapv esc xs))"]
(api/eval-string ctx s))
(def report (backend/infer-unit! ctx "p1"))
# --- the fixpoint computed the right param types -----------------------------
# rd's param v flows from mk's struct result (mk inlines to a struct literal in
# drv) and stays struct across the recursive self-call -> a {:struct ...} type
(defn struct-type? [t] (truthy? (get t :struct)))
(assert (struct-type? (in (get report "p1/rd") 0)) (string "rd param v: " (in (get report "p1/rd") 0)))
# esc escaped (passed to mapv) -> param stays unknown (:any / nil), NOT struct
(assert (not (struct-type? (in (get report "p1/esc") 0))) "escaping fn param not inferred struct")
# --- the seeded re-inference drops the guard for a struct param --------------
# (on a FRESH analysis, since infer-unit! re-stashes the already-specialized body)
(def pns (types/ctx-find-ns ctx "jolt.passes"))
(def reinfer (types/ns-find pns "reinfer-def"))
(def rd-def (backend/analyze-form ctx (reader/parse-string "(defn rdx [v n] (if (< n 1) (:r v) (rdx v (dec n))))")))
(defn guards-seeded [ptmap]
(length (string/find-all ":jolt/type" (string/format "%p" (backend/emit-ir ctx ((types/var-get reinfer) rd-def ptmap))))))
(assert (= 0 (guards-seeded @{"v" {:struct {}}})) "struct param -> bare lookup")
(assert (= 1 (guards-seeded @{})) "no param type -> guard kept")
# --- correctness: recompiled unit still computes the same --------------------
(assert (= 1 (api/eval-string ctx "(p1/drv)")) "drv correct after recompile")
(assert (= 7 (api/eval-string ctx "(p1/rd {:r 7 :g 8} 0)")) "rd correct on a struct")
(assert (= nil (api/eval-string ctx "(p1/rd (hash-map :r nil) 0)")) "rd correct on a phm (key present, nil)")
(assert (deep= [1 1] (api/normalize-pvecs (api/eval-string ctx "(p1/use-esc [{:r 1} {:r 1}])"))) "escaping fn still correct")
(print "Type inference Phase 1 passed!")

24
test/integration/type-infer-phase2-test.janet
View file

@ -1,24 +0,0 @@
# Vector op specialization, Phase 2 (jolt-d6u): a value the inference proved to
# be a vector ({:vec ...}) gets count -> pv-count (skip core-count's dispatch)
# and 3-arg nth -> pv-nth. 2-arg nth is NOT specialized: it errors on
# out-of-bounds where pv-nth returns nil.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/types :as types)
(import ../../src/jolt/reader :as reader)
(print "Type inference Phase 2 (vector ops)...")
(os/setenv "JOLT_DIRECT_LINK" "1")
(def ctx (api/init-cached {:compile? true}))
(api/eval-string ctx "(ns p2)")
(def reinfer (types/var-get (types/ns-find (types/ctx-find-ns ctx "jolt.passes") "reinfer-def")))
(defn estr [src ptmap]
(string/format "%p" (backend/emit-ir ctx (reinfer (backend/analyze-form ctx (reader/parse-string src)) ptmap))))
(assert (string/find "pv-count" (estr "(defn f [v] (count v))" @{"v" {:vec :any}})) "count on vector -> pv-count")
(assert (not (string/find "pv-count" (estr "(defn f [v] (count v))" @{}))) "count on unknown not specialized")
(assert (string/find "pv-nth" (estr "(defn f [v i] (nth v i 0))" @{"v" {:vec :any}})) "3-arg nth on vector -> pv-nth")
(assert (not (string/find "pv-nth" (estr "(defn f [v i] (nth v i))" @{"v" {:vec :any}}))) "2-arg nth NOT specialized")
# correctness
(assert (= 3 (api/eval-string ctx "(count [1 2 3])")) "count value")
(assert (= 2 (api/eval-string ctx "(nth [1 2 3] 1 9)")) "nth 3-arg in-bounds")
(assert (= 9 (api/eval-string ctx "(nth [1 2 3] 5 9)")) "nth 3-arg default")
(print "Type inference Phase 2 passed!")

41
test/integration/type-infer-phase3-test.janet
View file

@ -1,41 +0,0 @@
# Collection-element types + HOF awareness, Phase 3 (jolt-d6u). A vector carries
# its element type ({:vec ELEM}); a reduce/map/filter closure over it gets that
# element type on its element param. So a lookup inside a reduce closure over a
# vector-of-structs specializes — no hint — WHEN the element type is provable.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/types :as types)
(import ../../src/jolt/reader :as reader)
(print "Type inference Phase 3 (jolt-d6u)...")
(os/setenv "JOLT_DIRECT_LINK" "1")
(def ctx (api/init-cached {:compile? true}))
(api/eval-string ctx "(ns p3)")
(def pns (types/ctx-find-ns ctx "jolt.passes"))
(def reinfer (types/var-get (types/ns-find pns "reinfer-def")))
# helper: analyze a defn, reinfer with seeded param types, count guards
(defn guards [src ptmap]
(def d (backend/analyze-form ctx (reader/parse-string src)))
(length (string/find-all ":jolt/type" (string/format "%p" (backend/emit-ir ctx (reinfer d ptmap))))))
# a reduce closure's element param gets the vector's element type
(def red "(defn f [coll] (reduce (fn [acc h] (+ acc (:r h))) 0 coll))")
(assert (= 0 (guards red @{"coll" {:vec {:struct {}}}})) "reduce element typed -> bare lookup in closure")
(assert (= 1 (guards red @{"coll" {:vec :any}})) "reduce over vector of unknown -> guard kept")
(assert (= 1 (guards red @{})) "untyped coll -> guard kept")
# mapv over a vector-of-structs types the closure element too
(def mp "(defn g [coll] (mapv (fn [h] (:r h)) coll))")
(assert (= 0 (guards mp @{"coll" {:vec {:struct {}}}})) "mapv element typed -> bare lookup")
(assert (= 1 (guards mp @{"coll" {:vec :any}})) "mapv over unknown element -> guard")
# element type is DERIVED, not just seeded: a vector literal of structs, reduced
(def derived "(defn h2 [] (reduce (fn [acc x] (+ acc (:r x))) 0 [{:r 1 :g 2} {:r 3 :g 4}]))")
(assert (= 0 (guards derived @{})) "vector literal of structs -> element struct -> bare lookup")
# correctness: the specialized closures compute the same
(assert (= 4 (api/eval-string ctx "((fn [coll] (reduce (fn [acc h] (+ acc (:r h))) 0 coll)) [{:r 1} {:r 3}])")) "reduce value")
(assert (= 4 (api/eval-string ctx "(reduce (fn [acc x] (+ acc (:r x))) 0 [{:r 1 :g 2} {:r 3 :g 4}])")) "derived value")
(print "Type inference Phase 3 passed!")

54
test/integration/type-infer-test.janet
View file

@ -1,54 +0,0 @@
# Static collection-type inference, Phase 0 (jolt-6sr): intra-procedural.
# The pass infers an expression's collection type from literals/arithmetic and
# flows it through let bindings and if-joins. Where a keyword-lookup subject is
# PROVEN to be a plain struct map it auto-drops the :jolt/type guard (the
# inference output is the same ^:struct channel as a manual hint); where the
# type is unknown it stays :any and keeps the dynamic guard (sound fallback).
#
# Note: Route 1 scalar-replacement already eliminates NON-escaping let-bound
# maps outright, so these cases force the map to ESCAPE (pass it to `sink`) to
# isolate what inference adds — typing a map that survives and is then looked up.
(import ../../src/jolt/api :as api)
(import ../../src/jolt/backend :as backend)
(import ../../src/jolt/reader :as reader)
(print "Type inference Phase 0 (jolt-6sr)...")
(os/setenv "JOLT_DIRECT_LINK" "1")
(def ctx (api/init-cached {:compile? true}))
(api/eval-string ctx "(ns ti)")
(defn guards [src]
(length (string/find-all ":jolt/type"
(string/format "%p" (backend/emit-ir ctx (backend/analyze-form ctx (reader/parse-string src)))))))
(defn ev [src] (api/eval-string ctx src))
# --- guard auto-removal where the type is proven, no hint -------------------
# escaping struct-map literal (scalar keys, truthy values) is proven struct
(assert (= 0 (guards "(fn [sink] (let [v {:r 1 :g 2 :b 3}] (sink v) (:r v)))")) "inferred struct-map literal -> bare lookup")
# arithmetic values are provably non-nil/non-false -> still a struct
(assert (= 0 (guards "(fn [sink a b] (let [v {:r (+ a 1) :g (* b 2) :b 7}] (sink v) (:r v)))")) "arithmetic-valued map inferred struct")
# the inferred type flows through a rebinding
(assert (= 0 (guards "(fn [sink] (let [v {:r 1 :g 2} w v] (sink w) (:r w)))")) "inferred type flows through a rebinding")
# both if-branches struct -> join is struct
(assert (= 0 (guards "(fn [sink c] (let [v (if c {:a 1} {:a 2})] (sink v) (:a v)))")) "if-join of two struct literals stays struct")
# --- sound fallback to the guard where the type is NOT proven ---------------
# a param is unknown (Phase 1 handles params) -> guard kept, exactly as today
(assert (= 1 (guards "(fn [m] (:r m))")) "unknown param keeps the guard")
# a value that could be nil/false makes the literal maybe-phm -> :any -> guard
(assert (= 1 (guards "(fn [sink x] (let [v {:r x}] (sink v) (:r v)))")) "maybe-nil value -> not proven struct -> guard")
# join of a struct and a phm is :any -> guard
(assert (>= (guards "(fn [sink c] (let [v (if c {:a 1} (hash-map :a nil))] (sink v) (:a v)))") 1) "struct/phm join -> :any -> guard")
# --- correctness: every shape evaluates to the same as the guarded path -----
(def snk "(fn [_] nil)")
(assert (= 1 (ev (string "((fn [sink] (let [v {:r 1 :g 2 :b 3}] (sink v) (:r v))) " snk ")"))) "struct literal value")
(assert (= 6 (ev (string "((fn [sink a] (let [v {:r (+ a 1)}] (sink v) (:r v))) " snk " 5)"))) "arithmetic-valued struct")
(assert (= 2 (ev (string "((fn [sink] (let [v {:r 1 :g 2} w v] (sink w) (:g w))) " snk ")"))) "flowed type value")
(assert (= 1 (ev (string "((fn [sink c] (let [v (if c {:a 1} {:a 2})] (sink v) (:a v))) " snk " true)"))) "if-join value")
(assert (= nil (ev (string "((fn [sink x] (let [v {:r x}] (sink v) (:r v))) " snk " nil)"))) "maybe-nil map reads correctly (nil)")
(assert (= nil (ev (string "((fn [sink c] (let [v (if c {:a 1} (hash-map :a nil))] (sink v) (:a v))) " snk " false)"))) "phm branch reads nil correctly")
(assert (= 1 (ev (string "((fn [sink c] (let [v (if c {:a 1} (hash-map :a nil))] (sink v) (:a v))) " snk " true)"))) "struct branch reads correctly")
(print "Type inference Phase 0 passed!")

86
test/integration/uberscript-dce-test.janet
View file

@ -1,86 +0,0 @@
# Dead-code elimination in `jolt uberscript` (jolt-atg): a bundle is closed-
# world (everything it needs is inlined, nothing is required later), so a user
# `defn` that is unreachable from the entry point's reference graph can be
# dropped. Sound + conservative: only plain defn/defn- are prunable; a defn is
# kept if its (bare or ns-qualified) name appears anywhere in a kept form, the
# closure iterates to a fixpoint, and any use of dynamic resolution
# (resolve/eval/...) keeps everything. Drives the BUILT binary (uberscript is a
# CLI command); skips cleanly if build/jolt is absent.
(def jolt "build/jolt")
(defn- write-app [dir files]
(os/mkdir dir)
(each [name body] (partition 2 files) (spit (string dir "/" name) body)))
(defn- uber [dir main-ns]
(def out (string dir "/out.clj"))
(def jbin (string (os/cwd) "/" jolt))
(os/execute ["sh" "-c" (string "JOLT_PATH=" dir " " jbin " uberscript " out " -m " main-ns " 2>/dev/null")] :p)
(slurp out))
(defn- run-bundle [dir]
(def out2 (string dir "/run.txt"))
(def jbin (string (os/cwd) "/" jolt))
(os/execute ["sh" "-c" (string jbin " " dir "/out.clj > " out2 " 2>&1")] :p)
(string/trimr (slurp out2)))
(defn- has? [s needle] (not (nil? (string/find needle s))))
(if (not (os/stat jolt))
(print "uberscript-dce: SKIP (no build/jolt — run from source)")
(do
# --- basic: an unreachable defn is dropped; reachable ones survive --------
(def d1 (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dce1"))
(write-app d1
["lib.clj" (string "(ns lib)\n"
"(defn used-helper [x] (* x 2))\n"
"(defn dead-never-called [x] (+ x 99999))\n"
"(defn also-used [x] (used-helper (inc x)))\n")
"app.clj" (string "(ns app (:require [lib]))\n"
"(defn -main [& _] (println \"result\" (lib/also-used 10)))\n")])
(def b1 (uber d1 "app"))
(assert (not (has? b1 "dead-never-called")) "unreachable defn dropped from bundle")
(assert (has? b1 "used-helper") "transitively-reached defn kept")
(assert (has? b1 "also-used") "directly-reached defn kept")
(assert (= "result 22" (run-bundle d1)) "pruned bundle runs identically")
# --- soundness: a fn reached ONLY through a macro template is kept --------
(def d2 (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dce2"))
(write-app d2
["mlib.clj" (string "(ns mlib)\n"
"(defn via-macro [x] (* x 3))\n"
"(defmacro tri [n] (list 'mlib/via-macro n))\n")
"app2.clj" (string "(ns app2 (:require [mlib]))\n"
"(defn -main [& _] (println \"m\" (mlib/tri 7)))\n")])
(def b2 (uber d2 "app2"))
(assert (has? b2 "via-macro") "fn used only via a macro template is kept")
(assert (= "m 21" (run-bundle d2)) "macro-reached bundle runs identically")
# --- soundness: dynamic resolution disables DCE (keeps everything) --------
(def d3 (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dce3"))
(write-app d3
["dlib.clj" (string "(ns dlib)\n"
"(defn looks-dead [x] (* x 5))\n")
"app3.clj" (string "(ns app3 (:require [dlib]))\n"
"(defn -main [& _]\n"
" (println \"d\" ((deref (resolve 'dlib/looks-dead)) 4)))\n")])
(def b3 (uber d3 "app3"))
(assert (has? b3 "looks-dead") "resolve in bundle disables DCE (keeps all defns)")
(assert (= "d 20" (run-bundle d3)) "resolve bundle runs identically")
# --- soundness: a fn reached only through a defmethod body is kept --------
(def d4 (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-dce4"))
(write-app d4
["mmlib.clj" (string "(ns mmlib)\n"
"(defmulti shape-area :kind)\n"
"(defn rect-helper [w h] (* w h))\n"
"(defmethod shape-area :rect [s] (rect-helper (:w s) (:h s)))\n"
"(defn really-dead [x] (+ x 1))\n")
"app4.clj" (string "(ns app4 (:require [mmlib]))\n"
"(defn -main [& _] (println \"area\" (mmlib/shape-area {:kind :rect :w 3 :h 4})))\n")])
(def b4 (uber d4 "app4"))
(assert (has? b4 "rect-helper") "fn reached only via a defmethod body is kept")
(assert (not (has? b4 "really-dead")) "truly-unreachable fn dropped alongside live multimethod code")
(assert (= "area 12" (run-bundle d4)) "multimethod bundle runs identically")
(print "uberscript-dce: all cases passed")))

51
test/integration/uberscript-test.janet
View file

@ -1,51 +0,0 @@
# `jolt uberscript` bundles a namespace and everything it requires into one .clj
# that runs on a plain jolt with no JOLT_PATH / deps. Runs from source.
(defn- run [env-jolt-path & args]
(if env-jolt-path (os/setenv "JOLT_PATH" env-jolt-path) (os/setenv "JOLT_PATH" nil))
(def p (os/spawn ["janet" "src/jolt/main.janet" ;args] :p {:out :pipe :err :pipe}))
(def out (:read (p :out) :all))
(os/proc-wait p)
(string (or out "")))
(defn- mkdirs [p]
(var acc nil)
(each seg (filter |(not= "" $) (string/split "/" p))
(set acc (if (nil? acc) (if (string/has-prefix? "/" p) (string "/" seg) seg) (string acc "/" seg)))
(unless (os/stat acc) (os/mkdir acc))))
(defn- rmrf [p]
(when (os/stat p)
(if (= :directory (os/stat p :mode))
(do (each e (os/dir p) (rmrf (string p "/" e))) (os/rmdir p))
(os/rm p))))
(def base (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-uber-" (os/time)))
(rmrf base)
(mkdirs (string base "/proj/src/app"))
(mkdirs (string base "/lib/src/greet"))
(spit (string base "/lib/src/greet/core.clj")
"(ns greet.core)\n(defn hello [n] (str \"Hello, \" n \"!\"))\n")
(spit (string base "/proj/src/app/core.clj")
"(ns app.core (:require [greet.core :as g]))\n(defn -main [& args] (println (g/hello (or (first args) \"world\"))))\n")
(var fails 0)
(defn check [label got pred]
(if (pred got) (print " ok " label)
(do (++ fails) (printf " FAIL %s: got %q" label got))))
(defn- has [s] (fn [x] (string/find s x)))
(def roots (string base "/proj/src:" base "/lib/src"))
(def out (string base "/out.clj"))
# build the uberscript with the dep roots on JOLT_PATH
(run roots "uberscript" out "-m" "app.core")
(check "uberscript written" (if (os/stat out) "yes" "no") (has "yes"))
(check "bundles the dep ns" (slurp out) (has "(ns greet.core)"))
# run it standalone: no JOLT_PATH, so it only works if the dep was inlined
(check "runs standalone" (run nil out "Bob") (has "Hello, Bob!"))
(rmrf base)
(if (> fails 0)
(error (string "uberscript-test: " fails " failing check(s)"))
(print "\nAll uberscript tests passed!"))

51
test/integration/whole-program-test.janet
View file

@ -1,51 +0,0 @@
# Whole-program (Stalin) mode (jolt-t34, opt-in JOLT_WHOLE_PROGRAM): one closed-
# world inference fixpoint over ALL user namespaces, so param types propagate
# across ns boundaries (a non-inlined fn's record params get proven from its
# callers in another unit). This must be SOUND — same results as the per-ns
# pass — which is what this test guards, by running a cross-namespace record
# program both ways through the built binary and comparing output. Skips cleanly
# if build/jolt is absent (source-only test run).
(def jolt "build/jolt")
(defn- run [env-extra]
(def dir (string (or (os/getenv "TMPDIR") "/tmp") "/jolt-wp-test"))
(os/mkdir dir)
(spit (string dir "/wputil.clj")
(string "(ns wputil)\n"
"(defrecord V [x y z])\n"
# const-link targets (jolt-rvt): a data def and a ^:redef fn are
# indirect (cell deref) per-ns but embedded as constants under
# whole-program. Soundness => both modes must give the same answer.
"(def scale 2.0)\n"
"(defn ^:redef bump [x] (+ x 1.0))\n"
# recursive => never inlined; params proven only whole-program
"(defn dot [a b n]\n"
" (if (<= n 0) 0.0\n"
" (+ (* (:x a) (:x b)) (* (:y a) (:y b)) (* (:z a) (:z b)) (bump (* scale (dot a b (dec n)))))))\n"))
(spit (string dir "/wpmain.clj")
(string "(ns wpmain (:require [wputil :as v]))\n"
"(defn -main []\n"
" (loop [i 0 acc 0.0]\n"
" (if (< i 1000)\n"
" (let [a (v/->V (double i) 2.0 3.0) b (v/->V 1.0 (double i) 0.5)]\n"
" (recur (inc i) (+ acc (v/dot a b 2))))\n"
" (println \"sum\" acc))))\n"))
(def out (string dir "/out.txt"))
(def jbin (string (os/cwd) "/" jolt))
(def cmd (string env-extra "JOLT_DIRECT_LINK=1 JOLT_PATH=" dir " " jbin
" -m wpmain > " out " 2>&1"))
(os/execute ["sh" "-c" cmd] :p)
(string/trimr (slurp out)))
(if (not (os/stat jolt))
(print "whole-program: SKIP (no build/jolt — run from source)")
# -m now auto-enables whole-program under direct-linking, so the per-ns
# baseline must explicitly opt out to exercise the per-namespace path.
(let [per-ns (run "JOLT_NO_WHOLE_PROGRAM=1 ")
whole (run "JOLT_WHOLE_PROGRAM=1 ")]
(printf " per-ns: %s" per-ns)
(printf " whole-program: %s" whole)
(if (and (= per-ns whole) (string/has-prefix? "sum" per-ns))
(print "whole-program: results match — sound")
(do (printf "whole-program: MISMATCH per-ns=%q whole=%q" per-ns whole)
(os/exit 1)))))

29
test/spec/clojure-interop-fixes-spec.janet
View file

@ -1,29 +0,0 @@
# Specification: Clojure-compat fixes that landed with HTTP-client support
# (jolt-lang/http-client). All are general language behaviours, exercised here
# across interpret + compile modes by the harness.
(use ../support/harness)
(defspec "interop-fixes / deprecated #^ metadata reader"
["#^ type hint on a param" "\"x\""
"(do (defn f1 [#^String s] s) (f1 \"x\"))"]
["#^\"[B\" array hint" "[1 2]"
"(do (defn f2 [#^\"[B\" b] b) (f2 [1 2]))"]
["#^ is equivalent to ^" "true"
"(= (meta (with-meta [] {:tag (quote String)})) {:tag (quote String)})"])
(defspec "interop-fixes / (str pattern) yields raw source"
["str of a regex" "\"abc\"" "(str #\"abc\")"]
["compose patterns via str" "true"
"(boolean (re-matches (re-pattern (str #\"<\" \"(.*)\" \">\")) \"<hi>\"))"])
(defspec "interop-fixes / into onto a map"
["merges map items" "true" "(= {:a 1 :b 2} (into {} [{:a 1} {:b 2}]))"]
["accepts [k v] pairs" "true" "(= {:a 1} (into {} [[:a 1]]))"]
["map item onto empty {}" "true" "(= {:x 1} (into {} (list {:x 1})))"]
["conj a map onto {}" "true" "(= {:a 1} (conj {} {:a 1}))"])
(defspec "interop-fixes / a var is callable as its value"
["call a var directly" "42"
"(do (def vf (fn [x] (inc x))) ((var vf) 41))"]
["var bound as a client fn" "\"ok\""
"(do (def base (fn [_] \"ok\")) (def mw (fn [client] (fn [req] (client req)))) ((mw (var base)) {}))"])

Some files were not shown because too many files have changed in this diff Show more