From 4504b8ae5ebec7b99b8790e5ad57f40f9f7d6943 Mon Sep 17 00:00:00 2001 From: giles Date: Tue, 12 May 2026 19:39:45 +0000 Subject: [PATCH] test-runner: extract harness kit + migrate Kernel (7 files, 84 LoC saved) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit lib/guest/test-runner.sx — per-suite mutable state {:pass :fail :fails} + refl-test recorder + refl-test-report. Replaces the identical 4-define harness that appears in 142+ test files across the codebase. Each migrated file goes from: (define X-test-pass 0) (define X-test-fail 0) (define X-test-fails (list)) (define X-test (fn (name actual expected) (if (= actual expected) (set! X-test-pass (+ X-test-pass 1)) (begin ...)))) ;; ... tests ... (define X-tests-run! (fn () {:total ... :passed ... :failed ... :fails ...})) to: (define X-suite (refl-make-test-suite)) (define X-test (fn (n a e) (refl-test X-suite n a e))) ;; ... tests ... (define X-tests-run! (fn () (refl-test-report X-suite))) All 322 Kernel tests pass unchanged (parse 62, eval 36, vau 38, standard 127, encap 19, hygiene 26, metacircular 14). 84 LoC removed. Migration is mechanical (the prefix is the only difference between suites); /tmp/migrate_harness.py drives the regex. Other guests (Tcl, Smalltalk, APL, CL, Erlang, Haskell, etc.) migrated in subsequent commits. --- lib/guest/test-runner.sx | 50 ++++++++++++++++++++++++++++++++ lib/kernel/tests/encap.sx | 18 ++---------- lib/kernel/tests/eval.sx | 18 ++---------- lib/kernel/tests/hygiene.sx | 18 ++---------- lib/kernel/tests/metacircular.sx | 18 ++---------- lib/kernel/tests/parse.sx | 18 ++---------- lib/kernel/tests/standard.sx | 18 ++---------- lib/kernel/tests/vau.sx | 18 ++---------- 8 files changed, 71 insertions(+), 105 deletions(-) create mode 100644 lib/guest/test-runner.sx diff --git a/lib/guest/test-runner.sx b/lib/guest/test-runner.sx new file mode 100644 index 00000000..cd1408b6 --- /dev/null +++ b/lib/guest/test-runner.sx @@ -0,0 +1,50 @@ +;; lib/guest/test-runner.sx — per-suite test harness for guest test files. +;; +;; Across the codebase 142+ test files implement the identical four-form +;; boilerplate: `-test-pass`, `-test-fail`, `-test-fails`, and +;; an `-test` recording function. Only the prefix differs. This kit +;; collapses the boilerplate to a per-suite mutable dict + a recording +;; helper, so each test file goes from ~12 lines of harness to ~3: +;; +;; (define ke-suite (refl-make-test-suite)) +;; (define ke-test (fn (n a e) (refl-test ke-suite n a e))) +;; (define ke-tests-run! (fn () (refl-test-report ke-suite))) +;; +;; The suite is a mutable dict `{:pass N :fail N :fails LIST}`. Each +;; failed assertion appends `{:name NAME :expected EXPECTED :actual ACT}` +;; to :fails — same shape every existing harness already produces. +;; +;; The `:fails` list is mutated in place via `append!`, so callers who +;; have a reference to it see the same updates. (Same semantic the +;; existing per-suite globals had — just held in the suite dict now.) +;; +;; Public API +;; (refl-make-test-suite) — fresh suite +;; (refl-test SUITE NAME ACT EXP) — record one assertion +;; (refl-test-report SUITE) — return {:total :passed :failed :fails} +;; (refl-test-pass? SUITE) — convenience: all green? +;; (refl-test-suite? V) — predicate + +(define refl-make-test-suite (fn () {:fail 0 :pass 0 :fails (list)})) + +(define + refl-test-suite? + (fn + (v) + (and (dict? v) (number? (get v :pass)) (number? (get v :fail))))) + +(define + refl-test + (fn + (suite name actual expected) + (cond + ((= actual expected) + (dict-set! suite :pass (+ (get suite :pass) 1))) + (:else + (begin + (dict-set! suite :fail (+ (get suite :fail) 1)) + (append! (get suite :fails) {:name name :actual actual :expected expected})))))) + +(define refl-test-report (fn (suite) {:total (+ (get suite :pass) (get suite :fail)) :passed (get suite :pass) :failed (get suite :fail) :fails (get suite :fails)})) + +(define refl-test-pass? (fn (suite) (= (get suite :fail) 0))) diff --git a/lib/kernel/tests/encap.sx b/lib/kernel/tests/encap.sx index 7530df9f..5ecfa435 100644 --- a/lib/kernel/tests/encap.sx +++ b/lib/kernel/tests/encap.sx @@ -5,20 +5,8 @@ ;; identity is per-call, so two `(make-encapsulation-type)` calls ;; produce non-interchangeable families. -(define ken-test-pass 0) -(define ken-test-fail 0) -(define ken-test-fails (list)) - -(define - ken-test - (fn - (name actual expected) - (if - (= actual expected) - (set! ken-test-pass (+ ken-test-pass 1)) - (begin - (set! ken-test-fail (+ ken-test-fail 1)) - (append! ken-test-fails {:name name :actual actual :expected expected}))))) +(define ken-suite (refl-make-test-suite)) +(define ken-test (fn (n a e) (refl-test ken-suite n a e))) (define ken-eval-in (fn (src env) (kernel-eval (kernel-parse src) env))) @@ -180,4 +168,4 @@ env)) (list true 7)) -(define ken-tests-run! (fn () {:total (+ ken-test-pass ken-test-fail) :passed ken-test-pass :failed ken-test-fail :fails ken-test-fails})) +(define ken-tests-run! (fn () (refl-test-report ken-suite))) diff --git a/lib/kernel/tests/eval.sx b/lib/kernel/tests/eval.sx index 7e2f3ada..15d5fd7a 100644 --- a/lib/kernel/tests/eval.sx +++ b/lib/kernel/tests/eval.sx @@ -5,20 +5,8 @@ ;; ($if, $define!, $lambda, …) arrive in Phase 4, so tests build a ;; minimal env on the fly and verify the dispatch contract directly. -(define ke-test-pass 0) -(define ke-test-fail 0) -(define ke-test-fails (list)) - -(define - ke-test - (fn - (name actual expected) - (if - (= actual expected) - (set! ke-test-pass (+ ke-test-pass 1)) - (begin - (set! ke-test-fail (+ ke-test-fail 1)) - (append! ke-test-fails {:name name :actual actual :expected expected}))))) +(define ke-suite (refl-make-test-suite)) +(define ke-test (fn (n a e) (refl-test ke-suite n a e))) ;; ── helpers ────────────────────────────────────────────────────── @@ -267,4 +255,4 @@ (kernel-eval (kernel-parse "(x 1)") env))) :raised) -(define ke-tests-run! (fn () {:total (+ ke-test-pass ke-test-fail) :passed ke-test-pass :failed ke-test-fail :fails ke-test-fails})) +(define ke-tests-run! (fn () (refl-test-report ke-suite))) diff --git a/lib/kernel/tests/hygiene.sx b/lib/kernel/tests/hygiene.sx index 1a6b6a31..d2fe4bbe 100644 --- a/lib/kernel/tests/hygiene.sx +++ b/lib/kernel/tests/hygiene.sx @@ -10,20 +10,8 @@ ;; provenance markers) is research-grade and is NOT implemented — see ;; the plan's reflective-API notes for the proposed approach. -(define kh-test-pass 0) -(define kh-test-fail 0) -(define kh-test-fails (list)) - -(define - kh-test - (fn - (name actual expected) - (if - (= actual expected) - (set! kh-test-pass (+ kh-test-pass 1)) - (begin - (set! kh-test-fail (+ kh-test-fail 1)) - (append! kh-test-fails {:name name :actual actual :expected expected}))))) +(define kh-suite (refl-make-test-suite)) +(define kh-test (fn (n a e) (refl-test kh-suite n a e))) (define kh-eval-in (fn (src env) (kernel-eval (kernel-parse src) env))) @@ -217,4 +205,4 @@ (kh-eval-in "($let ((x 5)) ($define! tmp (+ x 1)) tmp)" (kernel-standard-env)) 6) -(define kh-tests-run! (fn () {:total (+ kh-test-pass kh-test-fail) :passed kh-test-pass :failed kh-test-fail :fails kh-test-fails})) +(define kh-tests-run! (fn () (refl-test-report kh-suite))) diff --git a/lib/kernel/tests/metacircular.sx b/lib/kernel/tests/metacircular.sx index 8588b845..96b8d993 100644 --- a/lib/kernel/tests/metacircular.sx +++ b/lib/kernel/tests/metacircular.sx @@ -12,20 +12,8 @@ ;; first-class evaluators all line up — enough so a Kernel program ;; can itself reason about Kernel programs. -(define kmc-test-pass 0) -(define kmc-test-fail 0) -(define kmc-test-fails (list)) - -(define - kmc-test - (fn - (name actual expected) - (if - (= actual expected) - (set! kmc-test-pass (+ kmc-test-pass 1)) - (begin - (set! kmc-test-fail (+ kmc-test-fail 1)) - (append! kmc-test-fails {:name name :actual actual :expected expected}))))) +(define kmc-suite (refl-make-test-suite)) +(define kmc-test (fn (n a e) (refl-test kmc-suite n a e))) ;; Build a Kernel env with m-eval and m-apply defined. The two refer ;; to each other and to standard primitives, so we use the standard @@ -159,4 +147,4 @@ env)) 49) -(define kmc-tests-run! (fn () {:total (+ kmc-test-pass kmc-test-fail) :passed kmc-test-pass :failed kmc-test-fail :fails kmc-test-fails})) +(define kmc-tests-run! (fn () (refl-test-report kmc-suite))) diff --git a/lib/kernel/tests/parse.sx b/lib/kernel/tests/parse.sx index d70e7bb6..e3546f55 100644 --- a/lib/kernel/tests/parse.sx +++ b/lib/kernel/tests/parse.sx @@ -1,19 +1,7 @@ ;; lib/kernel/tests/parse.sx — exercises lib/kernel/parser.sx. -(define knl-test-pass 0) -(define knl-test-fail 0) -(define knl-test-fails (list)) - -(define - knl-test - (fn - (name actual expected) - (if - (= actual expected) - (set! knl-test-pass (+ knl-test-pass 1)) - (begin - (set! knl-test-fail (+ knl-test-fail 1)) - (append! knl-test-fails {:name name :actual actual :expected expected}))))) +(define knl-suite (refl-make-test-suite)) +(define knl-test (fn (n a e) (refl-test knl-suite n a e))) ;; ── atoms: numbers ──────────────────────────────────────────────── (knl-test "num: integer" (kernel-parse "42") 42) @@ -155,4 +143,4 @@ (kernel-parse "(a 'b c)") (list "a" (list "$quote" "b") "c")) -(define knl-tests-run! (fn () {:total (+ knl-test-pass knl-test-fail) :passed knl-test-pass :failed knl-test-fail :fails knl-test-fails})) +(define knl-tests-run! (fn () (refl-test-report knl-suite))) diff --git a/lib/kernel/tests/standard.sx b/lib/kernel/tests/standard.sx index 803dec0a..fbc45cd0 100644 --- a/lib/kernel/tests/standard.sx +++ b/lib/kernel/tests/standard.sx @@ -5,20 +5,8 @@ ;; first-class environment manipulation. Each test starts from a fresh ;; standard env via `(kernel-standard-env)`. -(define ks-test-pass 0) -(define ks-test-fail 0) -(define ks-test-fails (list)) - -(define - ks-test - (fn - (name actual expected) - (if - (= actual expected) - (set! ks-test-pass (+ ks-test-pass 1)) - (begin - (set! ks-test-fail (+ ks-test-fail 1)) - (append! ks-test-fails {:name name :actual actual :expected expected}))))) +(define ks-suite (refl-make-test-suite)) +(define ks-test (fn (n a e) (refl-test ks-suite n a e))) (define ks-eval @@ -442,4 +430,4 @@ (ks-test "reverse: double reverse is identity" (ks-eval "(reverse (reverse (list 1 2 3)))") (list 1 2 3)) -(define ks-tests-run! (fn () {:total (+ ks-test-pass ks-test-fail) :passed ks-test-pass :failed ks-test-fail :fails ks-test-fails})) +(define ks-tests-run! (fn () (refl-test-report ks-suite))) diff --git a/lib/kernel/tests/vau.sx b/lib/kernel/tests/vau.sx index b64e7690..f953f2ea 100644 --- a/lib/kernel/tests/vau.sx +++ b/lib/kernel/tests/vau.sx @@ -5,20 +5,8 @@ ;; base-env, bind a few helper applicatives (+, *, list, =, $if), and ;; run programs that construct and use custom combiners. -(define kv-test-pass 0) -(define kv-test-fail 0) -(define kv-test-fails (list)) - -(define - kv-test - (fn - (name actual expected) - (if - (= actual expected) - (set! kv-test-pass (+ kv-test-pass 1)) - (begin - (set! kv-test-fail (+ kv-test-fail 1)) - (append! kv-test-fails {:name name :actual actual :expected expected}))))) +(define kv-suite (refl-make-test-suite)) +(define kv-test (fn (n a e) (refl-test kv-suite n a e))) (define kv-eval-src (fn (src env) (kernel-eval (kernel-parse src) env))) @@ -306,4 +294,4 @@ (kv-test "lambda: zero-arg multi-body" (kv-eval-src "(($lambda () 1 2 3))" (kv-make-env)) 3) -(define kv-tests-run! (fn () {:total (+ kv-test-pass kv-test-fail) :passed kv-test-pass :failed kv-test-fail :fails kv-test-fails})) +(define kv-tests-run! (fn () (refl-test-report kv-suite)))