Merge lib/guest/test-runner into architecture: test-runner.sx + Kernel migration (POC)

This commit is contained in:
2026-05-14 20:18:03 +00:00
9 changed files with 154 additions and 105 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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