giles
4504b8ae5e
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.
51 lines
2.1 KiB
Plaintext
51 lines
2.1 KiB
Plaintext
;; 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: `<X>-test-pass`, `<X>-test-fail`, `<X>-test-fails`, and
|
|
;; an `<X>-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)))
|