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.
147 lines
6.4 KiB
Plaintext
147 lines
6.4 KiB
Plaintext
;; lib/kernel/tests/parse.sx — exercises lib/kernel/parser.sx.
|
|
|
|
(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)
|
|
(knl-test "num: zero" (kernel-parse "0") 0)
|
|
(knl-test "num: negative integer" (kernel-parse "-7") -7)
|
|
(knl-test "num: positive sign" (kernel-parse "+5") 5)
|
|
(knl-test "num: float" (kernel-parse "3.14") 3.14)
|
|
(knl-test "num: negative float" (kernel-parse "-2.5") -2.5)
|
|
(knl-test "num: leading dot" (kernel-parse ".5") 0.5)
|
|
(knl-test "num: exponent" (kernel-parse "1e3") 1000)
|
|
(knl-test "num: exponent with sign" (kernel-parse "2.5e-1") 0.25)
|
|
(knl-test "num: capital E exponent" (kernel-parse "1E2") 100)
|
|
|
|
;; ── atoms: booleans ───────────────────────────────────────────────
|
|
(knl-test "bool: true" (kernel-parse "#t") true)
|
|
(knl-test "bool: false" (kernel-parse "#f") false)
|
|
|
|
;; ── atoms: empty list (Kernel nil) ────────────────────────────────
|
|
(knl-test "nil: ()" (kernel-parse "()") (list))
|
|
(knl-test "nil: (= () (list))" (= (kernel-parse "()") (list)) true)
|
|
|
|
;; ── atoms: symbols ────────────────────────────────────────────────
|
|
(knl-test "sym: word" (kernel-parse "foo") "foo")
|
|
(knl-test "sym: hyphenated" (kernel-parse "foo-bar") "foo-bar")
|
|
(knl-test "sym: dollar-bang" (kernel-parse "$define!") "$define!")
|
|
(knl-test "sym: question" (kernel-parse "null?") "null?")
|
|
(knl-test "sym: lt-eq" (kernel-parse "<=") "<=")
|
|
(knl-test "sym: bare plus" (kernel-parse "+") "+")
|
|
(knl-test "sym: bare minus" (kernel-parse "-") "-")
|
|
(knl-test "sym: plus-letter" (kernel-parse "+a") "+a")
|
|
(knl-test "sym: arrow" (kernel-parse "->") "->")
|
|
(knl-test "sym: dot-prefixed" (kernel-parse ".foo") ".foo")
|
|
|
|
;; ── atoms: strings ────────────────────────────────────────────────
|
|
(knl-test "str: empty" (kernel-string-value (kernel-parse "\"\"")) "")
|
|
(knl-test
|
|
"str: hello"
|
|
(kernel-string-value (kernel-parse "\"hello\""))
|
|
"hello")
|
|
(knl-test "str: predicate" (kernel-string? (kernel-parse "\"x\"")) true)
|
|
(knl-test "str: not symbol" (kernel-string? (kernel-parse "x")) false)
|
|
(knl-test
|
|
"str: escape newline"
|
|
(kernel-string-value (kernel-parse "\"a\\nb\""))
|
|
"a\nb")
|
|
(knl-test
|
|
"str: escape tab"
|
|
(kernel-string-value (kernel-parse "\"a\\tb\""))
|
|
"a\tb")
|
|
(knl-test
|
|
"str: escape quote"
|
|
(kernel-string-value (kernel-parse "\"a\\\"b\""))
|
|
"a\"b")
|
|
(knl-test
|
|
"str: escape backslash"
|
|
(kernel-string-value (kernel-parse "\"a\\\\b\""))
|
|
"a\\b")
|
|
|
|
;; ── lists ─────────────────────────────────────────────────────────
|
|
(knl-test "list: flat" (kernel-parse "(a b c)") (list "a" "b" "c"))
|
|
(knl-test
|
|
"list: nested"
|
|
(kernel-parse "(a (b c) d)")
|
|
(list "a" (list "b" "c") "d"))
|
|
(knl-test
|
|
"list: deeply nested"
|
|
(kernel-parse "(((x)))")
|
|
(list (list (list "x"))))
|
|
(knl-test
|
|
"list: mixed atoms"
|
|
(kernel-parse "(1 #t foo)")
|
|
(list 1 true "foo"))
|
|
(knl-test
|
|
"list: empty inside"
|
|
(kernel-parse "(a () b)")
|
|
(list "a" (list) "b"))
|
|
|
|
;; ── whitespace + comments ─────────────────────────────────────────
|
|
(knl-test "ws: leading" (kernel-parse " 42") 42)
|
|
(knl-test "ws: trailing" (kernel-parse "42 ") 42)
|
|
(knl-test "ws: tabs/newlines" (kernel-parse "\n\t 42 \n") 42)
|
|
(knl-test "comment: line" (kernel-parse "; nope\n42") 42)
|
|
(knl-test "comment: trailing" (kernel-parse "42 ; tail") 42)
|
|
(knl-test
|
|
"comment: inside list"
|
|
(kernel-parse "(a ; mid\n b)")
|
|
(list "a" "b"))
|
|
|
|
;; ── parse-all ─────────────────────────────────────────────────────
|
|
(knl-test "all: empty input" (kernel-parse-all "") (list))
|
|
(knl-test "all: only whitespace" (kernel-parse-all " ") (list))
|
|
(knl-test "all: only comment" (kernel-parse-all "; nope") (list))
|
|
(knl-test
|
|
"all: three forms"
|
|
(kernel-parse-all "1 2 3")
|
|
(list 1 2 3))
|
|
(knl-test
|
|
"all: mixed"
|
|
(kernel-parse-all "($if #t 1 2) foo")
|
|
(list (list "$if" true 1 2) "foo"))
|
|
|
|
;; ── classic Kernel programs (smoke) ───────────────────────────────
|
|
(knl-test
|
|
"klisp: vau form"
|
|
(kernel-parse "($vau (x e) e (eval x e))")
|
|
(list "$vau" (list "x" "e") "e" (list "eval" "x" "e")))
|
|
(knl-test
|
|
"klisp: define lambda"
|
|
(kernel-parse "($define! sq ($lambda (x) (* x x)))")
|
|
(list "$define!" "sq" (list "$lambda" (list "x") (list "*" "x" "x"))))
|
|
|
|
;; ── round-trip identity for primitive symbols ─────────────────────
|
|
(knl-test "identity: $vau" (kernel-parse "$vau") "$vau")
|
|
(knl-test "identity: $lambda" (kernel-parse "$lambda") "$lambda")
|
|
(knl-test "identity: wrap" (kernel-parse "wrap") "wrap")
|
|
(knl-test "identity: unwrap" (kernel-parse "unwrap") "unwrap")
|
|
|
|
;; ── reader macros ─────────────────────────────────────────────────
|
|
(knl-test "reader: 'foo → ($quote foo)"
|
|
(kernel-parse "'foo") (list "$quote" "foo"))
|
|
(knl-test "reader: '(a b c)"
|
|
(kernel-parse "'(a b c)") (list "$quote" (list "a" "b" "c")))
|
|
(knl-test "reader: nested quotes"
|
|
(kernel-parse "''x")
|
|
(list "$quote" (list "$quote" "x")))
|
|
(knl-test "reader: ` quasiquote"
|
|
(kernel-parse "`x") (list "$quasiquote" "x"))
|
|
(knl-test "reader: , unquote"
|
|
(kernel-parse ",x") (list "$unquote" "x"))
|
|
(knl-test "reader: ,@ unquote-splicing"
|
|
(kernel-parse ",@x") (list "$unquote-splicing" "x"))
|
|
(knl-test "reader: quasi-mix"
|
|
(kernel-parse "`(a ,b ,@c)")
|
|
(list "$quasiquote"
|
|
(list "a"
|
|
(list "$unquote" "b")
|
|
(list "$unquote-splicing" "c"))))
|
|
(knl-test "reader: quote separates from neighbouring atom"
|
|
(kernel-parse "(a 'b c)")
|
|
(list "a" (list "$quote" "b") "c"))
|
|
|
|
(define knl-tests-run! (fn () (refl-test-report knl-suite)))
|