/* * test.c — Unit + integration tests for the C Scheme interpreter */ #include "lumbda.h" #include "jit.h" static int tests_run = 0; static int tests_passed = 0; static int tests_failed = 0; #define TEST(name) \ static void test_##name(void); \ static void run_test_##name(void) { \ tests_run++; \ TRY(ctx) { \ test_##name(); \ tests_passed++; \ printf(" PASS: %s\n", #name); \ } CATCH { \ tests_failed++; \ printf(" FAIL: %s — %s\n", #name, ctx.message); \ } ENDTRY; \ } \ static void test_##name(void) #define ASSERT(cond, msg) \ do { if (!(cond)) lisp_error("assertion failed: %s", msg); } while(0) #define ASSERT_EQ_INT(a, b) \ do { int64_t _a = (a), _b = (b); \ if (_a != _b) lisp_error("expected %lld, got %lld", (long long)_b, (long long)_a); \ } while(0) #define ASSERT_EQ_STR(a, b) \ do { if (strcmp(a, b) != 0) lisp_error("expected \"%s\", got \"%s\"", b, a); } while(0) /* Helper: evaluate source and return result */ static Env *fresh_env(void) { Env *g = make_global_env(); int count; Value *exprs = read_all(PRELUDE, &count, false); for (int i = 0; i < count; i++) leval(exprs[i], g); ul_free(exprs); return g; } static Value run(const char *src) { Env *g = fresh_env(); int count; Value *exprs = read_all(src, &count, false); Value result = VAL_VOID; for (int i = 0; i < count; i++) result = leval(exprs[i], g); ul_free(exprs); return result; } static char *run_show(const char *src) { return show(run(src), false); } /* ═══════════════════════════════════════════════════════════════════════════ * Unit tests — Types * ═══════════════════════════════════════════════════════════════════════════ */ TEST(nan_boxing_int) { Value v = VAL_INT(42); ASSERT(IS_INT(v), "should be int"); ASSERT_EQ_INT(as_int(v), 42); v = VAL_INT(-100); ASSERT_EQ_INT(as_int(v), -100); v = VAL_INT(0); ASSERT_EQ_INT(as_int(v), 0); } TEST(nan_boxing_double) { Value v = make_double(3.14); ASSERT(IS_DOUBLE(v), "should be double"); double d = as_double(v); ASSERT(fabs(d - 3.14) < 1e-10, "should be 3.14"); } TEST(nan_boxing_special) { ASSERT(IS_NIL(VAL_NIL), "NIL"); ASSERT(IS_VOID(VAL_VOID), "VOID"); ASSERT(IS_TRUE(VAL_TRUE), "TRUE"); ASSERT(IS_FALSE(VAL_FALSE), "FALSE"); ASSERT(IS_EOF(VAL_EOF), "EOF"); ASSERT(IS_TRUTHY(VAL_TRUE), "TRUE is truthy"); ASSERT(!IS_TRUTHY(VAL_FALSE), "FALSE is not truthy"); ASSERT(IS_TRUTHY(VAL_NIL), "NIL is truthy (Scheme semantics)"); } TEST(symbol_interning) { Value s1 = intern("foo"); Value s2 = intern("foo"); Value s3 = intern("bar"); ASSERT(s1 == s2, "same symbol should be identical"); ASSERT(s1 != s3, "different symbols should differ"); ASSERT_EQ_STR(sym_name(s1), "foo"); } TEST(pair_creation) { Value p = cons(VAL_INT(1), cons(VAL_INT(2), VAL_NIL)); ASSERT(IS_PAIR(p), "should be pair"); ASSERT_EQ_INT(as_int(CAR(p)), 1); ASSERT_EQ_INT(as_int(CADR(p)), 2); ASSERT(IS_NIL(CDDR(p)), "should end with NIL"); } TEST(string_creation) { Value s = make_string_from_cstr("hello"); ASSERT(IS_STRING(s), "should be string"); ASSERT_EQ_INT(AS_STRING(s)->len, 5); ASSERT_EQ_STR(AS_STRING(s)->data, "hello"); } TEST(vector_creation) { Value v = make_vector(3, VAL_INT(0)); ASSERT(IS_VECTOR(v), "should be vector"); ASSERT_EQ_INT(AS_VECTOR(v)->len, 3); AS_VECTOR(v)->data[1] = VAL_INT(42); ASSERT_EQ_INT(as_int(AS_VECTOR(v)->data[1]), 42); } TEST(rational_creation) { Value r = rational_normalize(6, 4); ASSERT(IS_RATIONAL(r), "6/4 should be rational 3/2"); ASSERT_EQ_INT(AS_RATIONAL(r)->num, 3); ASSERT_EQ_INT(AS_RATIONAL(r)->den, 2); Value r2 = rational_normalize(4, 2); ASSERT(IS_INT(r2), "4/2 should normalize to int 2"); ASSERT_EQ_INT(as_int(r2), 2); } TEST(bignum_basic) { /* (expt 2 48) — first value past fixnum cap → bignum. */ char *got = run_show("(expt 2 48)"); ASSERT_EQ_STR(got, "281474976710656"); ul_free(got); /* (expt 2 256) — 78-digit hex world. */ got = run_show("(expt 2 256)"); ASSERT_EQ_STR(got, "115792089237316195423570985008687907853269984665640564039457584007913129639936"); ul_free(got); /* secp256k1 prime — full triple-subtract. */ got = run_show("(- (expt 2 256) (expt 2 32) 977)"); ASSERT_EQ_STR(got, "115792089237316195423570985008687907853269984665640564039457584007908834671663"); ul_free(got); /* Demotion back to fixnum when result fits. */ got = run_show("(- (expt 2 64) (expt 2 64))"); ASSERT_EQ_STR(got, "0"); ul_free(got); } TEST(bignum_arith) { /* Modular arithmetic across 78-digit operands. */ char *got = run_show( "(define p (- (expt 2 256) (expt 2 32) 977))" "(modulo (- 0 1) p)"); /* p - 1 */ ASSERT_EQ_STR(got, "115792089237316195423570985008687907853269984665640564039457584007908834671662"); ul_free(got); /* quotient + remainder identity for bignum scale. */ got = run_show( "(define p (- (expt 2 256) (expt 2 32) 977))" "(let* ((a (* p 7)) (q (quotient a p)) (r (remainder a p)))" " (list q r))"); ASSERT_EQ_STR(got, "(7 0)"); ul_free(got); /* Predicate roundtrip. */ got = run_show("(list (integer? (expt 2 100)) (exact? (expt 2 100)) (odd? (- (expt 2 100) 1)))"); ASSERT_EQ_STR(got, "(#t #t #t)"); ul_free(got); } TEST(environment) { Env *g = make_env(NULL); g->global = g; Value sym = intern("x"); env_define(g, sym, VAL_INT(42)); ASSERT_EQ_INT(as_int(env_lookup(g, sym)), 42); Env *c = make_env(g); ASSERT_EQ_INT(as_int(env_lookup(c, sym)), 42); env_define(c, sym, VAL_INT(99)); ASSERT_EQ_INT(as_int(env_lookup(c, sym)), 99); ASSERT_EQ_INT(as_int(env_lookup(g, sym)), 42); } /* ═══════════════════════════════════════════════════════════════════════════ * Unit tests — Reader * ═══════════════════════════════════════════════════════════════════════════ */ TEST(read_integer) { Value v = run("42"); ASSERT_EQ_INT(as_int(v), 42); } TEST(read_float) { Value v = run("3.14"); ASSERT(IS_DOUBLE(v), "should be double"); } TEST(read_string) { Value v = run("\"hello\""); ASSERT(IS_STRING(v), "should be string"); ASSERT_EQ_STR(AS_STRING(v)->data, "hello"); } TEST(read_boolean) { ASSERT(IS_TRUE(run("#t")), "#t"); ASSERT(IS_FALSE(run("#f")), "#f"); } TEST(read_list) { char *s = run_show("'(1 2 3)"); ASSERT_EQ_STR(s, "(1 2 3)"); ul_free(s); } TEST(read_vector) { char *s = run_show("#(1 2 3)"); ASSERT_EQ_STR(s, "#(1 2 3)"); ul_free(s); } TEST(read_char) { Value v = run("#\\space"); ASSERT(IS_CHAR(v), "should be char"); ASSERT_EQ_INT(AS_CHAR(v), ' '); } TEST(read_rational) { Value v = run("1/3"); ASSERT(IS_RATIONAL(v), "should be rational"); ASSERT_EQ_INT(AS_RATIONAL(v)->num, 1); ASSERT_EQ_INT(AS_RATIONAL(v)->den, 3); } /* ═══════════════════════════════════════════════════════════════════════════ * Unit tests — Evaluator * ═══════════════════════════════════════════════════════════════════════════ */ TEST(eval_arithmetic) { ASSERT_EQ_INT(as_int(run("(+ 1 2)")), 3); ASSERT_EQ_INT(as_int(run("(- 10 3)")), 7); ASSERT_EQ_INT(as_int(run("(* 4 5)")), 20); ASSERT_EQ_INT(as_int(run("(+ 1 2 3 4 5)")), 15); } TEST(eval_comparison) { ASSERT(IS_TRUE(run("(= 3 3)")), "3 = 3"); ASSERT(IS_FALSE(run("(= 3 4)")), "3 != 4"); ASSERT(IS_TRUE(run("(< 1 2)")), "1 < 2"); ASSERT(IS_TRUE(run("(> 5 3)")), "5 > 3"); } TEST(eval_if) { ASSERT_EQ_INT(as_int(run("(if #t 1 2)")), 1); ASSERT_EQ_INT(as_int(run("(if #f 1 2)")), 2); } TEST(eval_cond) { ASSERT_EQ_INT(as_int(run("(cond (#f 1) (#t 2) (else 3))")), 2); ASSERT_EQ_INT(as_int(run("(cond (else 42))")), 42); } TEST(eval_and_or) { ASSERT(IS_TRUE(run("(and #t #t)")), "and true"); ASSERT(IS_FALSE(run("(and #t #f)")), "and false"); ASSERT(IS_TRUE(run("(or #f #t)")), "or true"); ASSERT(IS_FALSE(run("(or #f #f)")), "or false"); } TEST(eval_define) { ASSERT_EQ_INT(as_int(run("(define x 42) x")), 42); } TEST(eval_lambda) { ASSERT_EQ_INT(as_int(run("((lambda (x) (+ x 1)) 41)")), 42); } TEST(eval_define_function) { ASSERT_EQ_INT(as_int(run("(define (f x) (+ x 1)) (f 41)")), 42); } TEST(eval_let) { ASSERT_EQ_INT(as_int(run("(let ((x 10) (y 20)) (+ x y))")), 30); } TEST(eval_let_star) { ASSERT_EQ_INT(as_int(run("(let* ((x 10) (y (* x 2))) (+ x y))")), 30); } TEST(eval_named_let) { char *s = run_show("(let loop ((n 5) (acc 1)) (if (= n 0) acc (loop (- n 1) (* acc n))))"); ASSERT_EQ_STR(s, "120"); ul_free(s); } TEST(eval_letrec) { ASSERT_EQ_INT(as_int(run( "(letrec ((f (lambda (n) (if (= n 0) 1 (* n (f (- n 1))))))) (f 5))" )), 120); } TEST(eval_begin) { ASSERT_EQ_INT(as_int(run("(begin 1 2 3)")), 3); } TEST(eval_quote) { char *s = run_show("'(1 2 3)"); ASSERT_EQ_STR(s, "(1 2 3)"); ul_free(s); } TEST(eval_quasiquote) { char *s = run_show("(let ((x 42)) `(a ,x b))"); ASSERT_EQ_STR(s, "(a 42 b)"); ul_free(s); } TEST(eval_list_ops) { ASSERT_EQ_INT(as_int(run("(car '(1 2 3))")), 1); char *s = run_show("(cdr '(1 2 3))"); ASSERT_EQ_STR(s, "(2 3)"); ul_free(s); ASSERT_EQ_INT(as_int(run("(length '(1 2 3))")), 3); } TEST(eval_map) { char *s = run_show("(map (lambda (x) (* x x)) '(1 2 3 4))"); ASSERT_EQ_STR(s, "(1 4 9 16)"); ul_free(s); } TEST(eval_filter) { char *s = run_show("(filter (lambda (x) (> x 2)) '(1 2 3 4 5))"); ASSERT_EQ_STR(s, "(3 4 5)"); ul_free(s); } TEST(eval_string_ops) { ASSERT_EQ_INT(as_int(run("(string-length \"hello\")")), 5); char *s = run_show("(string-append \"hello\" \" \" \"world\")"); ASSERT_EQ_STR(s, "\"hello world\""); ul_free(s); } TEST(eval_vector_ops) { ASSERT_EQ_INT(as_int(run("(vector-ref #(10 20 30) 1)")), 20); ASSERT_EQ_INT(as_int(run("(vector-length #(1 2 3))")), 3); } TEST(eval_rational_arithmetic) { char *s = run_show("(+ 1/3 1/6)"); ASSERT_EQ_STR(s, "1/2"); ul_free(s); s = run_show("(* 2/3 3/4)"); ASSERT_EQ_STR(s, "1/2"); ul_free(s); } TEST(eval_do) { char *s = run_show( "(do ((i 0 (+ i 1)) (acc 0 (+ acc i)))" " ((= i 5) acc))"); ASSERT_EQ_STR(s, "10"); ul_free(s); } TEST(eval_set) { ASSERT_EQ_INT(as_int(run("(define x 1) (set! x 42) x")), 42); } TEST(eval_closures) { ASSERT_EQ_INT(as_int(run( "(define (make-adder n) (lambda (x) (+ n x)))" "(define add5 (make-adder 5))" "(add5 37)" )), 42); } TEST(eval_recursion) { ASSERT_EQ_INT(as_int(run( "(define (fact n) (if (= n 0) 1 (* n (fact (- n 1)))))" "(fact 10)" )), 3628800); } TEST(eval_tail_call) { /* This would stack-overflow without TCO */ char *s = run_show( "(define (loop n)" " (if (= n 0) 'done (loop (- n 1))))" "(loop 100000)"); ASSERT_EQ_STR(s, "done"); ul_free(s); } TEST(eval_macro) { ASSERT_EQ_INT(as_int(run( "(define-macro (my-add a b) `(+ ,a ,b))" "(my-add 20 22)" )), 42); } TEST(eval_case) { ASSERT_EQ_INT(as_int(run( "(case 2" " ((1) 10)" " ((2 3) 20)" " (else 30))" )), 20); } TEST(eval_when_unless) { ASSERT_EQ_INT(as_int(run("(when #t 42)")), 42); ASSERT(IS_VOID(run("(when #f 42)")), "when false should be void"); ASSERT_EQ_INT(as_int(run("(unless #f 42)")), 42); } TEST(eval_hash_table) { ASSERT_EQ_INT(as_int(run( "(define ht (make-hash-table))" "(hash-table-set! ht 'x 42)" "(hash-table-ref ht 'x)" )), 42); } TEST(eval_guard) { char *s = run_show( "(guard (e (#t (error-object-message e)))" " (error \"test error\"))"); ASSERT_EQ_STR(s, "\"test error\""); ul_free(s); } TEST(eval_define_record_type) { char *s = run_show( "(define-record-type point (make-point x y) point? (x point-x) (y point-y))" "(define p (make-point 3 4))" "(list (point-x p) (point-y p))"); ASSERT_EQ_STR(s, "(3 4)"); ul_free(s); } TEST(eval_module) { char *s = run_show( "(module math (export square)" " (define (square x) (* x x)))" "(import math)" "(square 7)"); ASSERT_EQ_STR(s, "49"); ul_free(s); } TEST(eval_string_port) { char *s = run_show( "(define p (open-input-string \"hello\"))" "(define c (read-char p))" "c"); ASSERT_EQ_STR(s, "#\\h"); ul_free(s); } TEST(eval_fold) { ASSERT_EQ_INT(as_int(run("(fold-left (lambda (x acc) (+ x acc)) 0 '(1 2 3 4 5))")), 15); } /* ═══════════════════════════════════════════════════════════════════════════ * Integration tests — matching fibonacci.lsp output * ═══════════════════════════════════════════════════════════════════════════ */ TEST(fibonacci_iterative) { char *s = run_show( "(define (fib-iter n)" " (let loop ((a 0) (b 1) (i 0))" " (if (= i n) a (loop b (+ a b) (+ i 1)))))" "(fib-iter 30)"); ASSERT_EQ_STR(s, "832040"); ul_free(s); } TEST(fibonacci_recursive) { char *s = run_show( "(define (fib-rec n)" " (if (<= n 1) n (+ (fib-rec (- n 1)) (fib-rec (- n 2)))))" "(fib-rec 20)"); ASSERT_EQ_STR(s, "6765"); ul_free(s); } TEST(fibonacci_map) { char *s = run_show( "(define (fib-iter n)" " (let loop ((a 0) (b 1) (i 0))" " (if (= i n) a (loop b (+ a b) (+ i 1)))))" "(map fib-iter (iota 15))"); ASSERT_EQ_STR(s, "(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377)"); ul_free(s); } /* ═══════════════════════════════════════════════════════════════════════════ * VM / bytecode tests * ═══════════════════════════════════════════════════════════════════════════ */ TEST(vm_basic) { /* Run with auto-compile enabled */ Env *g = fresh_env(); g_auto_compile = true; int count; Value *exprs = read_all("(define (add a b) (+ a b)) (add 20 22)", &count, false); Value result = VAL_VOID; for (int i = 0; i < count; i++) result = leval(exprs[i], g); ASSERT_EQ_INT(as_int(result), 42); g_auto_compile = false; ul_free(exprs); } TEST(vm_fibonacci) { Env *g = fresh_env(); g_auto_compile = true; int count; Value *exprs = read_all( "(define (fib-iter n)" " (let loop ((a 0) (b 1) (i 0))" " (if (= i n) a (loop b (+ a b) (+ i 1)))))" "(fib-iter 30)", &count, false); Value result = VAL_VOID; for (int i = 0; i < count; i++) result = leval(exprs[i], g); ASSERT_EQ_INT(as_int(result), 832040); g_auto_compile = false; ul_free(exprs); } TEST(vm_tail_call) { Env *g = fresh_env(); g_auto_compile = true; int count; Value *exprs = read_all( "(define (loop n) (if (= n 0) 'done (loop (- n 1))))" "(loop 100000)", &count, false); Value result = VAL_VOID; for (int i = 0; i < count; i++) result = leval(exprs[i], g); char *s = show(result, false); ASSERT_EQ_STR(s, "done"); ul_free(s); g_auto_compile = false; ul_free(exprs); } /* ═══════════════════════════════════════════════════════════════════════════ * JIT tests — verify JIT-compiled functions match interpreter results * ═══════════════════════════════════════════════════════════════════════════ */ /* Helper: run code with JIT enabled */ static Value run_jit(const char *src) { Env *g = fresh_env(); g_jit_enabled = true; int count; Value *exprs = read_all(src, &count, false); Value result = VAL_VOID; for (int i = 0; i < count; i++) result = leval(exprs[i], g); g_jit_enabled = false; ul_free(exprs); return result; } TEST(jit_arithmetic) { /* Basic arithmetic under JIT */ ASSERT_EQ_INT(as_int(run_jit( "(define (add a b) (+ a b)) (add 20 22)")), 42); ASSERT_EQ_INT(as_int(run_jit( "(define (sub a b) (- a b)) (sub 50 8)")), 42); ASSERT_EQ_INT(as_int(run_jit( "(define (mul a b) (* a b)) (mul 6 7)")), 42); ASSERT_EQ_INT(as_int(run_jit( "(define (tri-add a b c) (+ a b c)) (tri-add 10 20 12)")), 42); } TEST(jit_comparison) { ASSERT(IS_TRUE(run_jit( "(define (eq a b) (= a b)) (eq 5 5)")), "jit = true"); ASSERT(IS_FALSE(run_jit( "(define (eq a b) (= a b)) (eq 5 6)")), "jit = false"); ASSERT(IS_TRUE(run_jit( "(define (lt a b) (< a b)) (lt 3 5)")), "jit <"); ASSERT(IS_TRUE(run_jit( "(define (gt a b) (> a b)) (gt 5 3)")), "jit >"); ASSERT(IS_TRUE(run_jit( "(define (le a b) (<= a b)) (le 3 3)")), "jit <="); ASSERT(IS_TRUE(run_jit( "(define (ge a b) (>= a b)) (ge 5 5)")), "jit >="); } TEST(jit_if_branching) { ASSERT_EQ_INT(as_int(run_jit( "(define (f x) (if (= x 0) 1 2)) (f 0)")), 1); ASSERT_EQ_INT(as_int(run_jit( "(define (f x) (if (= x 0) 1 2)) (f 5)")), 2); } TEST(jit_cond) { ASSERT_EQ_INT(as_int(run_jit( "(define (f x) (cond ((= x 1) 10) ((= x 2) 20) (else 30))) (f 2)")), 20); } TEST(jit_not_zero) { ASSERT(IS_TRUE(run_jit( "(define (f x) (not x)) (f #f)")), "jit not"); ASSERT(IS_TRUE(run_jit( "(define (f x) (zero? x)) (f 0)")), "jit zero?"); ASSERT(IS_FALSE(run_jit( "(define (f x) (zero? x)) (f 5)")), "jit zero? false"); } TEST(jit_self_recursion) { /* Factorial via JIT self-recursion */ ASSERT_EQ_INT(as_int(run_jit( "(define (fact n) (if (= n 0) 1 (* n (fact (- n 1)))))" "(fact 10)" )), 3628800); } TEST(jit_tco) { /* Tail-call optimization: count down from 100k without stack overflow */ char *s = show(run_jit( "(define (loop n) (if (= n 0) 42 (loop (- n 1))))" "(loop 100000)"), false); ASSERT_EQ_STR(s, "42"); ul_free(s); } TEST(jit_and_or) { /* and: short-circuit, returns last truthy or first falsy */ ASSERT_EQ_INT(as_int(run_jit( "(define (f a b) (and a b)) (f 1 2)")), 2); ASSERT(IS_FALSE(run_jit( "(define (f a b) (and a b)) (f 1 #f)")), "and short-circuit"); /* or: short-circuit, returns first truthy or last falsy */ ASSERT_EQ_INT(as_int(run_jit( "(define (f a b) (or a b)) (f #f 3)")), 3); ASSERT_EQ_INT(as_int(run_jit( "(define (f a b) (or a b)) (f 1 2)")), 1); ASSERT(IS_FALSE(run_jit( "(define (f a b) (or a b)) (f #f #f)")), "or all false"); } TEST(jit_let) { ASSERT_EQ_INT(as_int(run_jit( "(define (f a b) (let ((x (+ a 1)) (y (+ b 2))) (+ x y)))" "(f 10 20)")), 33); } TEST(jit_let_star) { ASSERT_EQ_INT(as_int(run_jit( "(define (f a) (let* ((x (+ a 1)) (y (* x 2))) y))" "(f 5)")), 12); } TEST(jit_named_let) { /* Named let compiles to native loop with jmp back */ ASSERT_EQ_INT(as_int(run_jit( "(define (fib n)" " (let loop ((a 0) (b 1) (i 0))" " (if (= i n) a (loop b (+ a b) (+ i 1)))))" "(fib 30)")), 832040); } TEST(jit_named_let_factorial) { ASSERT_EQ_INT(as_int(run_jit( "(define (fact n)" " (let loop ((i n) (acc 1))" " (if (= i 0) acc (loop (- i 1) (* acc i)))))" "(fact 10)")), 3628800); } TEST(jit_car_cdr) { ASSERT_EQ_INT(as_int(run_jit( "(define (my-car p) (car p)) (my-car '(42 2 3))")), 42); char *s = show(run_jit( "(define (my-cdr p) (cdr p)) (my-cdr '(1 2 3))"), false); ASSERT_EQ_STR(s, "(2 3)"); ul_free(s); } TEST(jit_cons) { char *s = show(run_jit( "(define (f a b) (cons a b)) (f 1 2)"), false); ASSERT_EQ_STR(s, "(1 . 2)"); ul_free(s); } TEST(jit_null_pair) { ASSERT(IS_TRUE(run_jit( "(define (f x) (null? x)) (f '())")), "jit null? true"); ASSERT(IS_FALSE(run_jit( "(define (f x) (null? x)) (f '(1))")), "jit null? false"); ASSERT(IS_TRUE(run_jit( "(define (f x) (pair? x)) (f '(1 2))")), "jit pair? true"); ASSERT(IS_FALSE(run_jit( "(define (f x) (pair? x)) (f 42)")), "jit pair? false"); } TEST(jit_ackermann) { /* ack(3,4) = 125 — the benchmark function */ ASSERT_EQ_INT(as_int(run_jit( "(define (ack m n)" " (cond ((= m 0) (+ n 1))" " ((= n 0) (ack (- m 1) 1))" " (else (ack (- m 1) (ack m (- n 1))))))" "(ack 3 4)")), 125); } TEST(jit_list_sum) { /* JIT compiled function that uses car/cdr/null? in a named-let loop */ ASSERT_EQ_INT(as_int(run_jit( "(define (list-sum lst)" " (let loop ((l lst) (acc 0))" " (if (null? l) acc (loop (cdr l) (+ acc (car l))))))" "(list-sum '(1 2 3 4 5))")), 15); } TEST(jit_functional_suite) { /* Run the full shared functional test suite with JIT enabled */ Env *g = fresh_env(); g_jit_enabled = true; int count; Value *exprs = read_all(PRELUDE, &count, false); for (int i = 0; i < count; i++) leval(exprs[i], g); ul_free(exprs); /* Load and run the functional test file. * Try both paths since CWD may be project root or c/ subdir. */ TRY(ctx) { FILE *fp = fopen("tests/functional.lsp", "r"); if (fp) { fclose(fp); load_file("tests/functional.lsp", g); } else { load_file("../tests/functional.lsp", g); } } CATCH { /* Functional tests may use features beyond JIT scope — that's OK, * the interpreter handles what the JIT can't. */ ASSERT(0, ctx.message); } ENDTRY; /* Check results — *pass* should be 114, *fail* should be 0 */ Value pass_sym = intern("*pass*"); Value fail_sym = intern("*fail*"); Value pass_val = env_lookup(g, pass_sym); Value fail_val = env_lookup(g, fail_sym); ASSERT(as_int(pass_val) >= 114, "should pass >= 114 functional tests"); ASSERT_EQ_INT(as_int(fail_val), 0); g_jit_enabled = false; } /* ═══════════════════════════════════════════════════════════════════════════ * Continuation tests — call/cc with VM (auto_compile) * ═══════════════════════════════════════════════════════════════════════════ */ /* Helper: run with auto_compile (bytecode VM path) */ static Value run_vm(const char *src) { Env *g = fresh_env(); g_auto_compile = true; int count; Value *exprs = read_all(src, &count, false); Value result = VAL_VOID; for (int i = 0; i < count; i++) result = leval(exprs[i], g); g_auto_compile = false; ul_free(exprs); return result; } static char *run_vm_show(const char *src) { return show(run_vm(src), false); } TEST(callcc_escape) { /* Basic escape continuation — call/cc returns early. * Wrapped in a compiled procedure to stay within VM execution. */ ASSERT_EQ_INT(as_int(run_vm( "(define (test) (+ 1 (call/cc (lambda (k) (+ 2 (k 10))))))" "(test)" )), 11); } TEST(callcc_no_escape) { /* call/cc where the continuation is never invoked */ ASSERT_EQ_INT(as_int(run_vm( "(define (test) (call/cc (lambda (k) 42)))" "(test)" )), 42); } TEST(callcc_accumulate) { /* Accumulating values with call/cc — saves and re-invokes within same VM context. * Wrapped in a single compiled procedure to stay within one VM execution. */ ASSERT_EQ_INT(as_int(run_vm( "(define (test)" " (define saved #f)" " (define result (+ 10 (call/cc (lambda (k) (set! saved k) 0))))" " (if saved" " (let ((k saved))" " (set! saved #f)" " (k 32))" " result))" "(test)" )), 42); } TEST(callcc_loop_via_cont) { /* Continuation pass-through pattern: call/cc passes a value directly * through the continuation. Each re-invocation increments via the * passed value, not mutation. The continuation returns to right after * call/cc, with the new value. */ ASSERT_EQ_INT(as_int(run_vm( "(define (test)" " (define box (make-vector 1 #f))" " (define n (call/cc (lambda (c) (vector-set! box 0 c) 0)))" " (if (< n 5)" " ((vector-ref box 0) (+ n 1))" " n))" "(test)" )), 5); } /* ═══════════════════════════════════════════════════════════════════════════ * Portal tests — save/resume machine state * ═══════════════════════════════════════════════════════════════════════════ */ TEST(portal_save_resume_env) { /* Save environment to portal file, resume it, check values survived */ Env *g = fresh_env(); g_auto_compile = true; int count; Value *exprs = read_all("(define x 42) (define y \"hello\")", &count, false); for (int i = 0; i < count; i++) leval(exprs[i], g); ul_free(exprs); /* Save */ portal_save(g, "/tmp/test_portal.json", NULL); /* Resume into a fresh env */ Env *resumed_env = NULL; FullCont *resumed_cont = NULL; bool ok = portal_resume("/tmp/test_portal.json", g, &resumed_env, &resumed_cont); ASSERT(ok, "portal_resume should succeed"); ASSERT(resumed_cont == NULL, "no continuation expected"); /* Check values */ Value x_val = env_lookup(resumed_env, intern("x")); ASSERT_EQ_INT(as_int(x_val), 42); Value y_val = env_lookup(resumed_env, intern("y")); ASSERT(IS_STRING(y_val), "y should be string"); ASSERT_EQ_STR(AS_STRING(y_val)->data, "hello"); g_auto_compile = false; unlink("/tmp/test_portal.json"); } TEST(portal_save_resume_cont) { /* Save a continuation to a portal file via portal_save with a FullCont, * resume and verify the continuation marker is present. */ Env *g = fresh_env(); g_auto_compile = true; /* Create a FullCont manually for testing */ VMFrame *frames = NULL; Value stack_data[1] = {VAL_INT(99)}; FullCont *cont = make_full_cont(frames, 0, stack_data, 1, 0, NULL, 0, g, NULL); portal_save(g, "/tmp/test_portal_cont.json", cont); /* Resume */ Env *resumed_env = NULL; FullCont *resumed_cont = NULL; bool ok = portal_resume("/tmp/test_portal_cont.json", g, &resumed_env, &resumed_cont); ASSERT(ok, "portal_resume should succeed"); ASSERT(resumed_cont != NULL, "should have a continuation marker"); g_auto_compile = false; unlink("/tmp/test_portal_cont.json"); } TEST(portal_checkpoint_builtin) { /* Test portal-checkpoint! builtin triggers a save. * The checkpoint is checked at OP_JUMP and OP_TAIL_CALL, so we need * a loop or conditional after the checkpoint call. */ char *s = run_vm_show( "(define (test)" " (portal-checkpoint! \"/tmp/test_checkpoint.json\")" " (let loop ((i 0))" " (if (= i 3) 'done (loop (+ i 1)))))" "(test)" ); ASSERT_EQ_STR(s, "done"); ul_free(s); /* Check the file was created */ struct stat st; ASSERT(stat("/tmp/test_checkpoint.json", &st) == 0, "checkpoint file should exist"); unlink("/tmp/test_checkpoint.json"); } /* ═══════════════════════════════════════════════════════════════════════════ * emit-circuit-to-ops-bin-stream — streaming-emit primitive * * Tests build a small register + ops list via the Scheme reader, call the * primitive against a temp file, then read the bytes back & compare byte- * for-byte against a hand-rolled QECCOPS1 layout. Catches both kind/slot * packing & header-patch path. Cross-tier byte-identity with Python lives * outside the C unit-test harness (foxhop.net's vm-runner.sh envelope). * ═══════════════════════════════════════════════════════════════════════════ */ /* Hand-roll a 56-byte op record matching pack_op_record / op-specs->bytes. */ static void pack_rec_expected(unsigned char *buf, uint32_t kind, uint64_t q2, uint64_t q1, uint64_t qt, uint64_t ct, uint64_t cc, uint64_t rt) { buf[0] = (unsigned char)(kind & 0xFF); buf[1] = (unsigned char)((kind >> 8) & 0xFF); buf[2] = (unsigned char)((kind >> 16) & 0xFF); buf[3] = (unsigned char)((kind >> 24) & 0xFF); buf[4] = 0; buf[5] = 0; buf[6] = 0; buf[7] = 0; uint64_t slots[6] = { q2, q1, qt, ct, cc, rt }; for (int i = 0; i < 6; i++) { size_t off = 8 + i * 8; uint64_t x = slots[i]; buf[off + 0] = (unsigned char)(x & 0xFF); buf[off + 1] = (unsigned char)((x >> 8) & 0xFF); buf[off + 2] = (unsigned char)((x >> 16) & 0xFF); buf[off + 3] = (unsigned char)((x >> 24) & 0xFF); buf[off + 4] = (unsigned char)((x >> 32) & 0xFF); buf[off + 5] = (unsigned char)((x >> 40) & 0xFF); buf[off + 6] = (unsigned char)((x >> 48) & 0xFF); buf[off + 7] = (unsigned char)((x >> 56) & 0xFF); } } #define NO_SLOT_TEST 0xFFFFFFFFFFFFFFFFULL TEST(emit_stream_basic) { /* Small circuit: one declared register 'a' width 3, then x/cx/ccx ops. * Run primitive into temp file. Compare bytes against expected layout. * * Expected ops sequence: * Register reg-id=0 * Append qt=0 reg=0 * Append qt=1 reg=0 * Append qt=2 reg=0 * X qt=1 * CX q1=0 qt=2 * CCX q2=2 q1=0 qt=1 * Total: 7 ops. */ const char *path = "/tmp/test_emit_stream_basic.bin"; unlink(path); char src[1024]; snprintf(src, sizeof(src), "(emit-circuit-to-ops-bin-stream \"%s\" '((a 3)) " " '((x (a 1)) (cx (a 0) (a 2)) (ccx (a 0) (a 2) (a 1))))", path); Value r = run(src); ASSERT(IS_INT(r), "primitive must return fixnum"); /* 1 Register + 3 Append + 1 X + 1 CX + 1 CCX = 7. */ ASSERT_EQ_INT(as_int(r), 7); FILE *f = fopen(path, "rb"); ASSERT(f != NULL, "output file must exist"); fseek(f, 0, SEEK_END); long sz = ftell(f); fseek(f, 0, SEEK_SET); /* 16-byte header + 7×56 = 408. */ ASSERT_EQ_INT(sz, 16 + 7 * 56); unsigned char *got = (unsigned char *)ul_malloc(sz); ASSERT(fread(got, 1, sz, f) == (size_t)sz, "read full file"); fclose(f); /* Build expected bytes. */ unsigned char exp[16 + 7 * 56]; memcpy(exp, "QECCOPS1", 8); /* n_ops = 7 LE. */ exp[8] = 7; exp[9] = 0; exp[10] = 0; exp[11] = 0; exp[12] = 0; exp[13] = 0; exp[14] = 0; exp[15] = 0; size_t off = 16; /* kind 1 Register, reg-id=0. */ pack_rec_expected(exp + off, 1, NO_SLOT_TEST, NO_SLOT_TEST, NO_SLOT_TEST, NO_SLOT_TEST, NO_SLOT_TEST, 0); off += 56; /* 3 × Append. */ for (int i = 0; i < 3; i++) { pack_rec_expected(exp + off, 2, NO_SLOT_TEST, NO_SLOT_TEST, (uint64_t)i, NO_SLOT_TEST, NO_SLOT_TEST, 0); off += 56; } /* X qt=1. */ pack_rec_expected(exp + off, 6, NO_SLOT_TEST, NO_SLOT_TEST, 1, NO_SLOT_TEST, NO_SLOT_TEST, NO_SLOT_TEST); off += 56; /* CX q1=0 qt=2. */ pack_rec_expected(exp + off, 8, NO_SLOT_TEST, 0, 2, NO_SLOT_TEST, NO_SLOT_TEST, NO_SLOT_TEST); off += 56; /* CCX q2=2 q1=0 qt=1. */ pack_rec_expected(exp + off, 13, 2, 0, 1, NO_SLOT_TEST, NO_SLOT_TEST, NO_SLOT_TEST); off += 56; for (long i = 0; i < sz; i++) { if (got[i] != exp[i]) { ul_free(got); unlink(path); lisp_error("byte %ld differs: got 0x%02x, expected 0x%02x", i, got[i], exp[i]); } } ul_free(got); unlink(path); } TEST(emit_stream_alloc_free) { /* Exercise alloc & free op tags: declared register, then alloc ancilla, * use it, free it, alloc again (reusing next-q monotonic). The C tier * does NOT pool — base monotonically grows. Mirrors Python behavior. */ const char *path = "/tmp/test_emit_stream_alloc_free.bin"; unlink(path); char src[2048]; snprintf(src, sizeof(src), "(emit-circuit-to-ops-bin-stream \"%s\" '((tx 2)) " " '((alloc anc 2)" " (cx (tx 0) (anc 1))" " (free anc)" " (alloc anc2 1)" " (x (anc2 0))))", path); Value r = run(src); ASSERT(IS_INT(r), "primitive must return fixnum"); /* tx: Register + 2 Append = 3 * alloc anc 2: Register + 2 Append = 3 * cx: 1 * free: 0 (no op emitted) * alloc anc2 1: Register + 1 Append = 2 * x: 1 * Total: 10. */ ASSERT_EQ_INT(as_int(r), 10); FILE *f = fopen(path, "rb"); ASSERT(f != NULL, "output file must exist"); fseek(f, 0, SEEK_END); long sz = ftell(f); fseek(f, 0, SEEK_SET); ASSERT_EQ_INT(sz, 16 + 10 * 56); unsigned char *got = (unsigned char *)ul_malloc(sz); ASSERT(fread(got, 1, sz, f) == (size_t)sz, "read full file"); fclose(f); /* Verify magic + n_ops header. */ ASSERT(memcmp(got, "QECCOPS1", 8) == 0, "magic mismatch"); uint64_t n_ops = (uint64_t)got[8] | ((uint64_t)got[9] << 8) | ((uint64_t)got[10] << 16) | ((uint64_t)got[11] << 24) | ((uint64_t)got[12] << 32) | ((uint64_t)got[13] << 40) | ((uint64_t)got[14] << 48) | ((uint64_t)got[15] << 56); ASSERT_EQ_INT((int64_t)n_ops, 10); /* Verify cx record: qubit 0 = tx base, qubit 3 = anc base+1. * tx base = 0 (next_q was 0). After tx: next_q = 2. * alloc anc: base = 2. anc 1 = 3. After: next_q = 4. * cx q1 = 0, qt = 3. * Records: * 0-2: tx Register, Append qt=0, Append qt=1 (reg=0) * 3-5: anc Register reg=2, Append qt=2, Append qt=3 (reg=2) * 6: cx q1=0 qt=3 * 7-8: anc2 Register reg=4, Append qt=4 (reg=4) * 9: x qt=4 */ /* Spot-check the cx record (record index 6, offset = 16 + 6*56 = 352). */ size_t cx_off = 16 + 6 * 56; /* kind LE = 8. */ ASSERT_EQ_INT(got[cx_off], 8); ASSERT_EQ_INT(got[cx_off + 1], 0); /* q2 slot (offset +8) = NO_SLOT (all 0xFF). */ for (int i = 0; i < 8; i++) ASSERT_EQ_INT(got[cx_off + 8 + i], 0xFF); /* q1 slot (offset +16) = 0. */ for (int i = 0; i < 8; i++) ASSERT_EQ_INT(got[cx_off + 16 + i], 0); /* qt slot (offset +24) = 3. */ ASSERT_EQ_INT(got[cx_off + 24], 3); for (int i = 1; i < 8; i++) ASSERT_EQ_INT(got[cx_off + 24 + i], 0); ul_free(got); unlink(path); } TEST(emit_stream_empty) { /* No registers, no ops — should produce just header w/ n_ops=0. */ const char *path = "/tmp/test_emit_stream_empty.bin"; unlink(path); char src[256]; snprintf(src, sizeof(src), "(emit-circuit-to-ops-bin-stream \"%s\" '() '())", path); Value r = run(src); ASSERT(IS_INT(r), "primitive must return fixnum"); ASSERT_EQ_INT(as_int(r), 0); FILE *f = fopen(path, "rb"); ASSERT(f != NULL, "output file must exist"); unsigned char hdr[16]; ASSERT(fread(hdr, 1, 16, f) == 16, "read 16-byte header"); /* EOF after header. */ char extra; ASSERT(fread(&extra, 1, 1, f) == 0, "no body bytes"); fclose(f); ASSERT(memcmp(hdr, "QECCOPS1", 8) == 0, "magic mismatch"); for (int i = 8; i < 16; i++) ASSERT_EQ_INT(hdr[i], 0); unlink(path); } #undef NO_SLOT_TEST /* ═══════════════════════════════════════════════════════════════════════════ * Main * ═══════════════════════════════════════════════════════════════════════════ */ int main(void) { int stack_anchor; #ifdef USE_BOEHM_GC GC_INIT(); lumbda_gc_init(); lumbda_gc_set_stack_base(&stack_anchor); #else (void)stack_anchor; #endif init_symbols(); printf("Running lumbda C tests...\n\n"); printf("[types]\n"); run_test_nan_boxing_int(); run_test_nan_boxing_double(); run_test_nan_boxing_special(); run_test_symbol_interning(); run_test_pair_creation(); run_test_string_creation(); run_test_vector_creation(); run_test_rational_creation(); run_test_bignum_basic(); run_test_bignum_arith(); run_test_environment(); printf("\n[reader]\n"); run_test_read_integer(); run_test_read_float(); run_test_read_string(); run_test_read_boolean(); run_test_read_list(); run_test_read_vector(); run_test_read_char(); run_test_read_rational(); printf("\n[evaluator]\n"); run_test_eval_arithmetic(); run_test_eval_comparison(); run_test_eval_if(); run_test_eval_cond(); run_test_eval_and_or(); run_test_eval_define(); run_test_eval_lambda(); run_test_eval_define_function(); run_test_eval_let(); run_test_eval_let_star(); run_test_eval_named_let(); run_test_eval_letrec(); run_test_eval_begin(); run_test_eval_quote(); run_test_eval_quasiquote(); run_test_eval_list_ops(); run_test_eval_map(); run_test_eval_filter(); run_test_eval_string_ops(); run_test_eval_vector_ops(); run_test_eval_rational_arithmetic(); run_test_eval_do(); run_test_eval_set(); run_test_eval_closures(); run_test_eval_recursion(); run_test_eval_tail_call(); run_test_eval_macro(); run_test_eval_case(); run_test_eval_when_unless(); run_test_eval_hash_table(); run_test_eval_guard(); run_test_eval_define_record_type(); run_test_eval_module(); run_test_eval_string_port(); run_test_eval_fold(); printf("\n[integration]\n"); run_test_fibonacci_iterative(); run_test_fibonacci_recursive(); run_test_fibonacci_map(); printf("\n[vm/bytecode]\n"); run_test_vm_basic(); run_test_vm_fibonacci(); run_test_vm_tail_call(); printf("\n[jit]\n"); run_test_jit_arithmetic(); run_test_jit_comparison(); run_test_jit_if_branching(); run_test_jit_cond(); run_test_jit_not_zero(); run_test_jit_self_recursion(); run_test_jit_tco(); run_test_jit_and_or(); run_test_jit_let(); run_test_jit_let_star(); run_test_jit_named_let(); run_test_jit_named_let_factorial(); run_test_jit_car_cdr(); run_test_jit_cons(); run_test_jit_null_pair(); run_test_jit_ackermann(); run_test_jit_list_sum(); run_test_jit_functional_suite(); printf("\n[continuations]\n"); run_test_callcc_escape(); run_test_callcc_no_escape(); run_test_callcc_accumulate(); run_test_callcc_loop_via_cont(); printf("\n[portal]\n"); run_test_portal_save_resume_env(); run_test_portal_save_resume_cont(); run_test_portal_checkpoint_builtin(); printf("\n[emit-stream]\n"); run_test_emit_stream_basic(); run_test_emit_stream_alloc_free(); run_test_emit_stream_empty(); printf("\n═══════════════════════════════════════════\n"); printf("Results: %d/%d passed", tests_passed, tests_run); if (tests_failed > 0) printf(" (%d failed)", tests_failed); printf("\n"); return tests_failed > 0 ? 1 : 0; }