test: ~11x faster gate — ctx snapshot/fork + parallel suite battery

The gate spent almost all its time rebuilding identical contexts: init is
~50 ms interpreted / ~900 ms compiled (tier loading, analyzer build, macro
recompilation), and both the conformance harness and the spec harness built a
fresh ctx PER CASE — 269 cases x 3 modes for conformance alone (~285 s), and
~1500 spec cases (~90 s). The suite battery additionally ran its 234 worker
subprocesses sequentially (~100 s incl. 5 x 6 s timeout files).

- api: snapshot/fork — marshal a fully-built ctx once (reverse-lookup dicts
  from root-env, built at module load before any ctx exists), unmarshal cheap
  fully-isolated deep copies (~2 ms). A fork shares nothing mutable with its
  siblings, so per-case isolation is preserved exactly.
- conformance: one init per mode + fork per case (self-host pre-builds the
  analyzer before snapshotting). 285 s -> 5 s, same 269x3 results.
- spec harness: jeval/run-spec/expect-throws fork from one lazy module-level
  snapshot. Spec sweep ~90 s -> 9 s, all pass.
- clojure-test-suite: run the per-file worker subprocesses through a
  token-channel worker pool (default 4, JOLT_SUITE_WORKERS to override,
  capped at 8). 17.5 s with counts identical to the sequential run
  (4046/520/116, 5 timeouts).

Full gate wall-clock: ~8 min -> 43 s, everything green (conformance 269x3,
fallback-zero, fixpoint, self-host, sci, staged, suite >= 4034/67, all
specs+unit).
This commit is contained in:
Yogthos 2026-06-10 09:11:58 -04:00
parent 3e9fe8d0fb
commit 920fafe032
4 changed files with 76 additions and 11 deletions

View file

@ -147,6 +147,34 @@
(load-core-overlay! ctx) (load-core-overlay! ctx)
ctx)) ctx))
# --- Context snapshot/fork (cheap isolated copies) --------------------------
#
# init is expensive (~50 ms interpreted, ~900 ms compiled: tier loading, analyzer
# build, macro recompilation). For workloads that need MANY isolated contexts —
# the test harnesses build a fresh ctx per case — snapshot a fully-built ctx once
# and fork cheap deep copies (~2 ms) from it via Janet marshal/unmarshal. A fork
# shares nothing mutable with the original: defs, protocol extensions, hierarchy
# changes, atom states in one fork are invisible to the others.
#
# The reverse-lookup dicts must be built from root-env (cfunctions and abstract
# values from the Janet runtime marshal by reference through them) BEFORE any ctx
# values exist in scope — module load time here, so user code can't leak into it.
(def- image-load-dict (env-lookup root-env))
(def- image-make-dict (invert image-load-dict))
(defn snapshot
"Marshal a fully-built context into a buffer that fork can cheaply clone.
Build the ctx (init), customize it if needed, then snapshot once."
[ctx]
(marshal ctx image-make-dict))
(defn fork
"A fresh, fully-isolated deep copy of a snapshotted context (~2 ms, vs
re-running init). (fork (snapshot ctx)) behaves exactly like ctx did at
snapshot time; mutations to a fork never affect the original or other forks."
[snap]
(unmarshal snap image-load-dict))
(defn eval-one (defn eval-one
"Evaluate a single already-parsed form. Routing (compile when :compile? is set, "Evaluate a single already-parsed form. Routing (compile when :compile? is set,
stateful forms interpret, interpreter fallback for forms the compiler can't stateful forms interpret, interpreter fallback for forms the compiler can't

View file

@ -108,14 +108,33 @@
(var timeouts 0) (var timeouts 0)
(def worst @[]) (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 (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 rel (string/slice path (+ 1 (length suite-dir))))
(when progress? (eprintf " %s" rel) (eflush))
(def out (run-file path))
(def counts (and out (parse-counts out))) (def counts (and out (parse-counts out)))
(when progress?
(eprintf " %s%s" rel (cond (nil? out) " TIMEOUT" (nil? counts) " (no counts)" ""))
(eflush))
(cond (cond
(nil? out) (do (++ timeouts) (when progress? (eprint " TIMEOUT"))) (nil? out) (++ timeouts)
(nil? counts) (when progress? (eprint " (no counts)")) (nil? counts) nil
(let [[pn fn* en] counts] (let [[pn fn* en] counts]
(++ ran-files) (++ ran-files)
(+= total-pass pn) (+= total-pass pn)

View file

@ -384,9 +384,16 @@
(def init-opts (if selfhost? {} mode)) (def init-opts (if selfhost? {} mode))
(defn ev [ctx prog] (defn ev [ctx prog]
(if selfhost? (selfhost/compile-and-eval ctx (parse-string prog)) (eval-string 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 init-opts))
(when selfhost? (selfhost/compile-and-eval base (parse-string "1")))
(def snap (snapshot base))
(def fails @[]) (def fails @[])
(each [name expected actual] cases (each [name expected actual] cases
(def ctx (init init-opts)) (def ctx (fork snap))
(def prog (string "(= " expected " " actual ")")) (def prog (string "(= " expected " " actual ")"))
(def res (protect (ev ctx prog))) (def res (protect (ev ctx prog)))
(cond (cond
@ -394,7 +401,7 @@
(array/push fails [name "ERROR" (string (res 1))]) (array/push fails [name "ERROR" (string (res 1))])
(= (res 1) true) (= (res 1) true)
nil nil
(let [got (protect (ev (init init-opts) actual))] (let [got (protect (ev (fork snap) actual))]
(array/push fails [name "MISMATCH" (array/push fails [name "MISMATCH"
(string "want=" expected (string "want=" expected
" got=" (if (= (got 0) true) (string/format "%q" (got 1)) (string "ERR:" (got 1))))])))) " got=" (if (= (got 0) true) (string/format "%q" (got 1)) (string "ERR:" (got 1))))]))))

View file

@ -22,14 +22,25 @@
(use ../../src/jolt/api) (use ../../src/jolt/api)
# Every case still gets a fully-isolated context, but via api/fork (~2 ms deep
# copy of a snapshotted ctx) instead of a fresh init (~50 ms) — the same
# behavior, ~25x faster across the ~1500 spec cases. Built lazily so harness
# importers that never eval (or that only use run-spec) pay it once at most.
(var- base-snap nil)
(defn fresh-ctx
"A fresh, fully-isolated interpret-mode context (cheap fork of one shared init)."
[]
(when (nil? base-snap) (set base-snap (snapshot (init))))
(fork base-snap))
(defn jeval (defn jeval
"Evaluate a Clojure source string in a fresh context, normalizing persistent "Evaluate a Clojure source string in a fresh context, normalizing persistent
vectors/lists to Janet tuples so results compare with `deep=`/tuple literals." vectors/lists to Janet tuples so results compare with `deep=`/tuple literals."
[s] [s]
(normalize-pvecs (eval-string (init) s))) (normalize-pvecs (eval-string (fresh-ctx) s)))
(defn- show [s] (defn- show [s]
(let [r (protect (eval-string (init) s))] (let [r (protect (eval-string (fresh-ctx) s))]
(if (= (r 0) true) (if (= (r 0) true)
(string/format "%q" (normalize-pvecs (r 1))) (string/format "%q" (normalize-pvecs (r 1)))
(string "<error: " (r 1) ">")))) (string "<error: " (r 1) ">"))))
@ -44,11 +55,11 @@
(def expected (in case 1)) (def expected (in case 1))
(def actual (in case 2)) (def actual (in case 2))
(if (= expected :throws) (if (= expected :throws)
(let [r (protect (eval-string (init) actual))] (let [r (protect (eval-string (fresh-ctx) actual))]
(if (= (r 0) false) (if (= (r 0) false)
(++ pass) (++ pass)
(array/push fails [label "expected an error, got a value"]))) (array/push fails [label "expected an error, got a value"])))
(let [r (protect (eval-string (init) (string "(= " expected " " actual ")")))] (let [r (protect (eval-string (fresh-ctx) (string "(= " expected " " actual ")")))]
(cond (cond
(not= (r 0) true) (array/push fails [label (string "errored: " (r 1))]) (not= (r 0) true) (array/push fails [label (string "errored: " (r 1))])
(= (r 1) true) (++ pass) (= (r 1) true) (++ pass)
@ -79,5 +90,5 @@
(defn expect-throws (defn expect-throws
"Assert that evaluating Clojure `s` raises an error." "Assert that evaluating Clojure `s` raises an error."
[s] [s]
(let [r (protect (eval-string (init) s))] (let [r (protect (eval-string (fresh-ctx) s))]
(assert (= (r 0) false) (string "expected an error for: " s)))) (assert (= (r 0) false) (string "expected an error for: " s))))