lumbda/c/test.c
russell@unturf.com b841b30bc4
c: precise GC tracing for NaN-boxed Values
Boehm's conservative pointer scan cannot recognize lumbda's Value
layout — heap pointers live in the low 48 bits with QNAN + tag bits
in the upper mantissa, so a raw word never looks like a heap address.
Until now main.c neutralized this with GC_disable(): every allocation
leaked, OOMing any long-running workload.

Add precise tracing via a custom Boehm kind:

- New c/gc.c: mark proc walks 8-byte words in mixed mode — when the
  QNAN bits are set with a pointer-bearing tag (0/2/4/5/6) extract
  the low-48 pointer; otherwise fall through to raw-pointer
  validation. GC_set_push_other_roots callback decodes NaN-boxed
  Values on the C stack via setjmp anchor + scan up to the stack
  base captured at process start.

- Allocations holding Values (Pair, Env bindings, ValueStack data,
  ULVector data, HTEntry, Proc params + body, FullCont stack,
  CodeObj instrs, SymbolEntry) route through lumbda_value_malloc.
  Pure-byte sites (bignum limbs, char buffers, source files) stay
  on regular GC_MALLOC.

- main.c / test.c / bench.c capture stack-base then drop GC_disable.

types.c also zeros popped slots on the value stack so stale pointers
do not survive a vs_pop and pin freed objects — independent
correctness fix that pays off once GC actually runs.

Build: USE_GC=1 (default when /usr/include/gc.h exists).

Tests with GC enabled:
- 88/88 c-test
- 4/4 regression-named-let-leak (test that motivated GC_disable)
- 205/205 functional (Python + C)
- zoe-favorites all tiers (Python + C + asm + asm-full)

alloc-test 1M cons drop-loop:
- Before: 0.60s wall, 156 MB RSS, leaks every cell
- After:  0.37s wall,   4 MB RSS, ~1500 GC cycles each freeing ~370 KB
2026-06-07 17:18:45 -04:00

1261 lines
41 KiB
C
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/*
* 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;
}