Hojun-Cho
90dc6369c9
peel-ok/sizelint-ok/primsize-ok annotations lose their tools; sites keep the WHY in plain words. Citations of retired carriers move to their fixture or @test successors (949_errtype_compare -> r949_*, 900_stdlib -> library owners).
415 lines
16 KiB
Plaintext
415 lines
16 KiB
Plaintext
// lisp_test — in-process test driver for the tiny Lisp.
|
|
//
|
|
// Drives eval_str on a sequence of source snippets and
|
|
// inspects the returned `*value` (kind + payload). `ww test
|
|
// lisp_test.ww` builds + execs this; exit 0 means every probe
|
|
// passed, non-zero means at least one failed (with `FAIL <name>`
|
|
// on stderr).
|
|
//
|
|
// We exercise the same wwstage cgen edges as lisp.ww itself, so a
|
|
// regression in cross-module type / field access shows up here:
|
|
// - `*value` field reads (.kind / .ival / .fval / .sid)
|
|
// - `(*value | rterror)` returns crossing the
|
|
// use-boundary
|
|
// - module-qualified enum constants (`valkind.INT`) in
|
|
// `==` comparisons and `case let _: rterror =>` arms.
|
|
|
|
package lisp;
|
|
|
|
import os;
|
|
import fmt;
|
|
import strconv;
|
|
import strings;
|
|
import lispcore;
|
|
|
|
let nfail: i32 = 0;
|
|
let ntotal: i32 = 0;
|
|
|
|
// ---- result printers --------------------------------------------------
|
|
|
|
fn pname(name: str) void = {
|
|
os.write(1, name.ptr, name.len: u64);
|
|
};
|
|
|
|
fn ok(name: str) void = {
|
|
os.write(1, "ok ".ptr, 5u64);
|
|
pname(name);
|
|
os.write(1, "\n".ptr, 1u64);
|
|
};
|
|
|
|
fn fail(name: str, why: str) void = {
|
|
os.write(2, "FAIL ".ptr, 5u64);
|
|
os.write(2, name.ptr, name.len: u64);
|
|
os.write(2, ": ".ptr, 2u64);
|
|
os.write(2, why.ptr, why.len: u64);
|
|
os.write(2, "\n".ptr, 1u64);
|
|
nfail += 1;
|
|
};
|
|
|
|
fn faili(name: str, why: str, got: i64) void = {
|
|
os.write(2, "FAIL ".ptr, 5u64);
|
|
os.write(2, name.ptr, name.len: u64);
|
|
os.write(2, ": ".ptr, 2u64);
|
|
os.write(2, why.ptr, why.len: u64);
|
|
os.write(2, " got=".ptr, 5u64);
|
|
let s: str = strconv.i64tos(got, strconv.base.DEC);
|
|
os.write(2, s.ptr, s.len: u64);
|
|
os.write(2, "\n".ptr, 1u64);
|
|
nfail += 1;
|
|
};
|
|
|
|
// ---- assertion helpers ------------------------------------------------
|
|
//
|
|
// Each `check_*` evaluates `input` against the supplied env, then
|
|
// verifies the result. We always bind the result to a local *value
|
|
// before doing field access — the wwstage cgen drops the trailing
|
|
// field load on chained `xs[0].kind`-style reads.
|
|
|
|
fn check_int(name: str, input: str, expected: i64, ep: **env) void = {
|
|
ntotal += 1;
|
|
let r = eval_str(input, ep);
|
|
match (r) {
|
|
case let v: *value => {
|
|
let p: *value = v;
|
|
if (p.kind != valkind.INT) {
|
|
fail(name, "kind != INT");
|
|
return;
|
|
};
|
|
if (p.ival != expected) {
|
|
faili(name, "wrong i64", p.ival);
|
|
return;
|
|
};
|
|
ok(name);
|
|
};
|
|
case let _e: rterror => fail(name, "rterror");
|
|
};
|
|
};
|
|
|
|
fn check_bool(name: str, input: str, expected: bool, ep: **env) void = {
|
|
ntotal += 1;
|
|
let r = eval_str(input, ep);
|
|
match (r) {
|
|
case let v: *value => {
|
|
let p: *value = v;
|
|
if (p.kind != valkind.BOOL) {
|
|
fail(name, "kind != BOOL");
|
|
return;
|
|
};
|
|
let want: i32 = 0;
|
|
if (expected) { want = 1; };
|
|
if (p.bval != want) {
|
|
faili(name, "wrong bool", p.bval: i64);
|
|
return;
|
|
};
|
|
ok(name);
|
|
};
|
|
case let _e: rterror => fail(name, "rterror");
|
|
};
|
|
};
|
|
|
|
fn check_kind(name: str, input: str, want: valkind, ep: **env) void = {
|
|
ntotal += 1;
|
|
let r = eval_str(input, ep);
|
|
match (r) {
|
|
case let v: *value => {
|
|
let p: *value = v;
|
|
if (p.kind != want) {
|
|
faili(name, "wrong kind", p.kind as i32: i64);
|
|
return;
|
|
};
|
|
ok(name);
|
|
};
|
|
case let _e: rterror => fail(name, "rterror");
|
|
};
|
|
};
|
|
|
|
// Float — bit-equal comparison through the `fbuf` route lispcore uses
|
|
// elsewhere. f64 hand-routing avoids the cgen's mis-lowering of f64
|
|
// reads from struct fields.
|
|
let chkfbuf: f64 = 0.0;
|
|
|
|
fn fapprox(a: f64, b: f64) bool = {
|
|
// Tolerance 1e-6 — enough for "is the answer right?" without
|
|
// pulling in a real float compare.
|
|
let d: f64 = a - b;
|
|
if (d < 0.0) { d = -d; };
|
|
return d < 0.000001;
|
|
};
|
|
|
|
fn check_float(name: str, input: str, expected: f64, ep: **env) void = {
|
|
ntotal += 1;
|
|
let r = eval_str(input, ep);
|
|
match (r) {
|
|
case let v: *value => {
|
|
let p: *value = v;
|
|
if (p.kind != valkind.FLOAT) {
|
|
fail(name, "kind != FLOAT");
|
|
return;
|
|
};
|
|
// Cross-module *f64-via-pointer-deref read of v.fval.
|
|
let raw: *u8 = p: *u8;
|
|
let fp: *f64 = (raw + 16u64): *f64;
|
|
let got: f64 = *fp;
|
|
if (!fapprox(got, expected)) {
|
|
fail(name, "wrong float");
|
|
return;
|
|
};
|
|
ok(name);
|
|
};
|
|
case let _e: rterror => fail(name, "rterror");
|
|
};
|
|
};
|
|
|
|
fn check_err(name: str, input: str, ep: **env) void = {
|
|
ntotal += 1;
|
|
let r = eval_str(input, ep);
|
|
match (r) {
|
|
case let _v: *value => fail(name, "expected rterror, got value");
|
|
case let _e: rterror => ok(name);
|
|
};
|
|
};
|
|
|
|
// check_str — assert kind==STR and byte-wise equal to `want`. Covers
|
|
// the str-ownership story: vstr/promote_v copy bytes into the arena
|
|
// so the value survives the REPL's buf reuse.
|
|
fn check_str(name: str, input: str, want: str, ep: **env) void = {
|
|
ntotal += 1;
|
|
let r = eval_str(input, ep);
|
|
match (r) {
|
|
case let v: *value => {
|
|
let p: *value = v;
|
|
if (p.kind != valkind.STR) {
|
|
fail(name, "kind != STR");
|
|
return;
|
|
};
|
|
let got: str = p.text;
|
|
if (got.len != want.len) {
|
|
faili(name, "wrong len", got.len: i64);
|
|
return;
|
|
};
|
|
let i: i32 = 0;
|
|
for (i < got.len) {
|
|
if (got[i] != want[i]) {
|
|
faili(name, "byte mismatch at", i: i64);
|
|
return;
|
|
};
|
|
i += 1;
|
|
};
|
|
ok(name);
|
|
};
|
|
case let _e: rterror => fail(name, "rterror");
|
|
};
|
|
};
|
|
|
|
// strconv.f64tos probes. Library-owned strconv tests cover formatting;
|
|
// these rows retain the application-level consumer expectations here.
|
|
fn check_f64tos(name: str, v: f64, want: str) void = {
|
|
ntotal += 1;
|
|
let s: str = strconv.f64tos(v);
|
|
if (s.len != want.len) {
|
|
faili(name, "wrong len", s.len: i64);
|
|
return;
|
|
};
|
|
let i: i32 = 0;
|
|
for (i < s.len) {
|
|
if (s.ptr[i] != want[i]) {
|
|
faili(name, "byte mismatch at", i: i64);
|
|
return;
|
|
};
|
|
i += 1;
|
|
};
|
|
ok(name);
|
|
};
|
|
|
|
// run an expression for its effect (e.g. `(define ...)`); ignore the
|
|
// returned nil. Test passes iff there's no runtime error.
|
|
fn run(name: str, input: str, ep: **env) void = {
|
|
ntotal += 1;
|
|
let r = eval_str(input, ep);
|
|
match (r) {
|
|
case let _v: *value => ok(name);
|
|
case let _e: rterror => fail(name, "rterror during run");
|
|
};
|
|
};
|
|
|
|
// ---- entry ------------------------------------------------------------
|
|
|
|
export fn main() i32 = {
|
|
// Shared env across the whole suite. `define`s leak between
|
|
// probes so later tests can reference `fact`, `square`, etc.
|
|
let e: *env = nil;
|
|
let ep: **env = &e;
|
|
initsyms();
|
|
bind_builtins(ep);
|
|
|
|
// ---- atoms + simple arithmetic ----
|
|
check_int ("int-literal", "42", 42i64, ep);
|
|
check_int ("add", "(+ 1 2 3 4 5)", 15i64, ep);
|
|
check_int ("sub", "(- 100 25 25)", 50i64, ep);
|
|
check_int ("mul", "(* 6 7)", 42i64, ep);
|
|
check_int ("div", "(/ 100 5)", 20i64, ep);
|
|
check_int ("div-3way", "(/ 1000 10 5)", 20i64, ep);
|
|
check_int ("mod", "(mod 17 5)", 2i64, ep);
|
|
check_int ("neg", "(- 7)", -7i64, ep);
|
|
check_int ("nested", "(+ (* 2 3) (* 4 5))", 26i64, ep);
|
|
|
|
// ---- comparisons ----
|
|
check_bool ("eq-true", "(= 5 5)", true, ep);
|
|
check_bool ("eq-false", "(= 5 6)", false, ep);
|
|
check_bool ("lt-chained", "(< 1 2 3 4)", true, ep);
|
|
check_bool ("lt-fail", "(< 1 2 2)", false, ep);
|
|
check_bool ("gt", "(> 5 3 1)", true, ep);
|
|
check_bool ("le", "(<= 3 3 4)", true, ep);
|
|
|
|
// ---- conditionals + truthy ----
|
|
check_int ("if-then", "(if #t 1 2)", 1i64, ep);
|
|
check_int ("if-else", "(if #f 1 2)", 2i64, ep);
|
|
check_int ("if-truthy-int", "(if 0 1 2)", 1i64, ep);
|
|
check_bool ("not-false", "(not #f)", true, ep);
|
|
|
|
// ---- lists ----
|
|
check_kind ("quote-list-cons", "'(1 2 3)", valkind.CONS, ep);
|
|
check_kind ("empty-list-nil", "'()", valkind.NIL, ep);
|
|
check_kind ("cons-cell", "(cons 1 2)", valkind.CONS, ep);
|
|
check_int ("car", "(car '(11 22 33))", 11i64, ep);
|
|
check_int ("car-of-list", "(car (list 7 8))", 7i64, ep);
|
|
check_int ("len-cdr", "(car (cdr '(1 2 3)))",2i64, ep);
|
|
check_bool ("null?-empty", "(null? '())", true, ep);
|
|
check_bool ("null?-pair", "(null? '(1))", false, ep);
|
|
check_bool ("pair?-cons", "(pair? '(a))", true, ep);
|
|
check_bool ("pair?-atom", "(pair? 'a)", false, ep);
|
|
|
|
// ---- predicates ----
|
|
check_bool ("number?-int", "(number? 42)", true, ep);
|
|
check_bool ("number?-float", "(number? 3.14)", true, ep);
|
|
check_bool ("number?-sym", "(number? 'foo)", false, ep);
|
|
check_bool ("symbol?-sym", "(symbol? 'foo)", true, ep);
|
|
check_bool ("symbol?-int", "(symbol? 1)", false, ep);
|
|
check_bool ("eq?-sym", "(eq? 'a 'a)", true, ep);
|
|
check_bool ("eq?-int", "(eq? 7 7)", true, ep);
|
|
check_bool ("eq?-mixed", "(eq? 'a 1)", false, ep);
|
|
|
|
// ---- define + lookup + set! ----
|
|
run ("def-x", "(define x 100)", ep);
|
|
check_int ("ref-x", "x", 100i64, ep);
|
|
run ("set-x", "(set! x 7)", ep);
|
|
check_int ("ref-x-set", "x", 7i64, ep);
|
|
|
|
// ---- lambdas + recursion ----
|
|
run ("def-sq", "(define sq (lambda (n) (* n n)))", ep);
|
|
check_int ("call-sq", "(sq 9)", 81i64, ep);
|
|
run ("def-fact", "(define fact (lambda (n) (if (<= n 1) 1 (* n (fact (- n 1))))))", ep);
|
|
check_int ("fact-5", "(fact 5)", 120i64, ep);
|
|
check_int ("fact-10", "(fact 10)", 3628800i64, ep);
|
|
run ("def-fib", "(define fib (lambda (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))))", ep);
|
|
check_int ("fib-10", "(fib 10)", 55i64, ep);
|
|
check_int ("fib-15", "(fib 15)", 610i64, ep);
|
|
run ("def-gcd", "(define gcd (lambda (a b) (if (= b 0) a (gcd b (mod a b)))))", ep);
|
|
check_int ("gcd", "(gcd 60 48)", 12i64, ep);
|
|
|
|
// ---- higher-order ----
|
|
run ("def-map", "(define mp (lambda (f l) (if (null? l) '() (cons (f (car l)) (mp f (cdr l))))))", ep);
|
|
run ("def-inc", "(define inc (lambda (n) (+ n 1)))", ep);
|
|
check_kind ("map-yields-list", "(mp inc '(1 2 3))", valkind.CONS, ep);
|
|
check_int ("map-car", "(car (mp inc '(1 2 3)))", 2i64, ep);
|
|
|
|
// ---- let + begin ----
|
|
check_int ("let-product", "(let ((a 3) (b 4)) (* a b))", 12i64, ep);
|
|
check_int ("begin-last", "(begin 1 2 (+ 10 20))", 30i64, ep);
|
|
|
|
// ---- tail-call optimization ----
|
|
// 30k iterations is well past the pre-TCO segfault threshold
|
|
// (~25k) but still completes inside the test budget. Each probe
|
|
// exercises a different tail position: lambda body via if,
|
|
// lambda body via begin, and lambda body via let.
|
|
run ("def-spin", "(define spin (lambda (n a) (if (= n 0) a (spin (- n 1) (+ a 1)))))", ep);
|
|
check_int ("tco-if", "(spin 30000 0)", 30000i64, ep);
|
|
run ("def-bspin", "(define bspin (lambda (n a) (if (= n 0) a (begin a (bspin (- n 1) (+ a 1))))))", ep);
|
|
check_int ("tco-begin", "(bspin 30000 0)", 30000i64, ep);
|
|
run ("def-lspin", "(define lspin (lambda (n a) (if (= n 0) a (let ((m (- n 1))) (lspin m (+ a 1))))))", ep);
|
|
check_int ("tco-let", "(lspin 30000 0)", 30000i64, ep);
|
|
|
|
// ---- floats ----
|
|
check_float("float-add", "(+ 1.5 2.5)", 4.0, ep);
|
|
check_float("float-mul", "(* 0.5 0.5)", 0.25, ep);
|
|
check_float("float-div", "(/ 22.0 7.0)", 3.142857, ep);
|
|
check_float("float-promote", "(+ 1 2.5)", 3.5, ep);
|
|
check_bool ("float-cmp", "(< 1.0 2.0)", true, ep);
|
|
|
|
// ---- strconv.f64tos ----
|
|
// Direct probes against the new strconv entry. The lisp printer
|
|
// delegates to this, so any regression here surfaces in `(println
|
|
// 1.5)` style output too. See lib/strconv/strconv.ww for the
|
|
// documented subset (no NaN/Inf/sci, ≥9.22e18 → "huge").
|
|
check_f64tos("f64tos-int", 1.0, "1");
|
|
check_f64tos("f64tos-half", 1.5, "1.5");
|
|
check_f64tos("f64tos-pi", 3.14, "3.14");
|
|
check_f64tos("f64tos-tenth", 0.1, "0.1");
|
|
check_f64tos("f64tos-neg", -2.5, "-2.5");
|
|
check_f64tos("f64tos-zero", 0.0, "0");
|
|
check_f64tos("f64tos-hundred", 100.0, "100");
|
|
check_f64tos("f64tos-leadzero", 0.05, "0.05");
|
|
check_f64tos("f64tos-roundup", 0.9999996, "1");
|
|
check_f64tos("f64tos-trim", 123.450000, "123.45");
|
|
check_f64tos("f64tos-huge", 9.5e18, "huge");
|
|
|
|
// ---- runtime errors ----
|
|
check_err ("err-unbound", "this-symbol-isnt-bound", ep);
|
|
check_err ("err-car-not-pair", "(car 1)", ep);
|
|
check_err ("err-div-zero", "(/ 5 0)", ep);
|
|
check_err ("err-bad-arg", "(+ 'a 'b)", ep);
|
|
|
|
// ---- strings (vstr/promote_v deep-copy) ----
|
|
// Pre-fix, top-level (define s "..") then later use printed
|
|
// garbage because vstr borrowed the lexer's input buffer and
|
|
// the REPL shifted it between forms. vstr now owns its bytes,
|
|
// promote_v copies them into perm. Each probe runs eval_str on
|
|
// its own input, so any borrow back into a dead source slice
|
|
// would surface here as a byte mismatch.
|
|
check_str ("str-literal", "\"hello\"", "hello", ep);
|
|
run ("def-s1", "(define s1 \"first\")", ep);
|
|
run ("def-s2", "(define s2 \"second\")", ep);
|
|
run ("def-s3", "(define s3 \"third\")", ep);
|
|
check_str ("str-s1-survives", "s1", "first", ep);
|
|
check_str ("str-s2-survives", "s2", "second", ep);
|
|
check_str ("str-s3-survives", "s3", "third", ep);
|
|
// String embedded in a lambda body — the lambda's body cell
|
|
// holds a STR sub-cell that has to be promoted too.
|
|
run ("def-getstr", "(define getstr (lambda () \"inside\"))", ep);
|
|
check_str ("str-from-lambda", "(getstr)", "inside", ep);
|
|
|
|
// ---- dotted-pair literals ----
|
|
// '(1 . 2) used to lex `.` as a 1-byte SYM, producing a
|
|
// 3-element proper list. Now: lexer emits tkind.DOT inside a
|
|
// list and the parser splices it as the cdr.
|
|
check_kind ("dot-pair-kind", "'(1 . 2)", valkind.CONS, ep);
|
|
check_int ("dot-pair-car", "(car '(1 . 2))", 1i64, ep);
|
|
check_int ("dot-pair-cdr", "(cdr '(1 . 2))", 2i64, ep);
|
|
check_bool ("dot-pair-not-pair-cdr", "(pair? (cdr '(1 . 2)))", false, ep);
|
|
// Walk `(1 2 . 3)` → car=1, cadr=2, cddr=3 (the dotted tail).
|
|
check_int ("dot-tail-car", "(car '(1 2 . 3))", 1i64, ep);
|
|
check_int ("dot-tail-cadr", "(car (cdr '(1 2 . 3)))", 2i64, ep);
|
|
check_int ("dot-tail-cddr", "(cdr (cdr '(1 2 . 3)))", 3i64, ep);
|
|
check_err ("dot-leading", "'(. 2)", ep);
|
|
check_err ("dot-trailing", "'(1 . 2 3)", ep);
|
|
|
|
// ---- summary ----
|
|
if (nfail == 0) {
|
|
os.write(1, "\nlisp_test: ".ptr, 12u64);
|
|
let ts: str = strconv.i64tos(ntotal: i64, strconv.base.DEC);
|
|
os.write(1, ts.ptr, ts.len: u64);
|
|
os.write(1, "/".ptr, 1u64);
|
|
os.write(1, ts.ptr, ts.len: u64);
|
|
os.write(1, " pass\n".ptr, 6u64);
|
|
return 0;
|
|
};
|
|
os.write(2, "\nlisp_test: ".ptr, 12u64);
|
|
let fs: str = strconv.i64tos(nfail: i64, strconv.base.DEC);
|
|
os.write(2, fs.ptr, fs.len: u64);
|
|
os.write(2, " of ".ptr, 4u64);
|
|
let ts: str = strconv.i64tos(ntotal: i64, strconv.base.DEC);
|
|
os.write(2, ts.ptr, ts.len: u64);
|
|
os.write(2, " failed\n".ptr, 8u64);
|
|
return 1;
|
|
};
|