test-runner: extract harness kit + migrate Kernel (7 files, 84 LoC saved)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
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.
This commit is contained in:
@@ -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)))
|
||||
|
||||
Reference in New Issue
Block a user