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
1261 lines
41 KiB
C
1261 lines
41 KiB
C
/*
|
||
* 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;
|
||
}
|