Add shared functional test suite: 114 tests, both implementations pass
tests/functional.lsp — single .lsp file, runs identically in Python and C. Covers: arithmetic, comparison, booleans, pairs, lists, strings, characters, vectors, hash tables, control flow, let/lambda/closures, do loops, define, recursion, TCO (100k depth), quasiquote, macros, type predicates, call/cc, error handling, mergesort, higher-order programs. Fixed C call/cc: proper escape continuations via setjmp/longjmp. make test-all runs: Python unit (571) + C unit (58) + shared functional (114).
This commit is contained in:
parent
73440106c3
commit
db2cd77c62
3 changed files with 363 additions and 16 deletions
13
Makefile
13
Makefile
|
|
@ -33,6 +33,8 @@ c-build:
|
|||
|
||||
c-test: c-build
|
||||
$(MAKE) -C c test
|
||||
@echo "── C functional tests (shared .lsp suite) ──"
|
||||
./c/uncommonlisp tests/functional.lsp
|
||||
|
||||
c-bench: c-build
|
||||
$(MAKE) -C c bench
|
||||
|
|
@ -45,9 +47,16 @@ c-clean:
|
|||
|
||||
# ─── Both implementations ────────────────────────────────────────
|
||||
|
||||
test-all: test c-test
|
||||
functional-test: c-build
|
||||
@echo "═══ Shared functional tests (114 tests) ═══"
|
||||
@echo "── Python ──"
|
||||
@python3 uncommonlisp.py --fast tests/functional.lsp | tail -3
|
||||
@echo "── C ──"
|
||||
@./c/uncommonlisp tests/functional.lsp | tail -3
|
||||
|
||||
test-all: test c-test functional-test
|
||||
@echo "════════════════════════════════════"
|
||||
@echo "All tests passed (Python + C)"
|
||||
@echo "All tests passed (Python + C + shared functional)"
|
||||
|
||||
bench-all: bench c-bench
|
||||
|
||||
|
|
|
|||
45
c/eval.c
45
c/eval.c
|
|
@ -5,6 +5,21 @@
|
|||
*/
|
||||
#include "uncommonlisp.h"
|
||||
|
||||
/* ═══════════════════════════════════════════════════════════════════════════
|
||||
* call/cc support — thread-local escape state
|
||||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||||
|
||||
static __thread Value cc_escape_val;
|
||||
static __thread jmp_buf *cc_active_jmp;
|
||||
|
||||
static Value ul_callcc_kont(Value *args, int nargs, Env *env) {
|
||||
(void)env;
|
||||
cc_escape_val = (nargs > 0) ? args[0] : VAL_VOID;
|
||||
if (cc_active_jmp) longjmp(*cc_active_jmp, 1);
|
||||
lisp_error("continuation invoked outside call/cc");
|
||||
return VAL_VOID; /* unreachable */
|
||||
}
|
||||
|
||||
/* ═══════════════════════════════════════════════════════════════════════════
|
||||
* Helpers
|
||||
* ═══════════════════════════════════════════════════════════════════════════ */
|
||||
|
|
@ -1137,21 +1152,23 @@ Value leval(Value expr, Env *env) {
|
|||
Value *a; int na = value_to_list(tail, &a);
|
||||
Value proc = leval(a[0], env);
|
||||
ul_free(a);
|
||||
/* Simplified: just use longjmp-based escape */
|
||||
Value args[1];
|
||||
/* Create a builtin that raises an exception to escape */
|
||||
/* For now, implement simplified call/cc */
|
||||
static __thread Value cc_result;
|
||||
static __thread bool cc_invoked;
|
||||
static __thread jmp_buf cc_jmp;
|
||||
/* Escape-only call/cc using setjmp/longjmp */
|
||||
jmp_buf *saved_jmp = cc_active_jmp;
|
||||
jmp_buf local_jmp;
|
||||
cc_active_jmp = &local_jmp;
|
||||
|
||||
cc_invoked = false;
|
||||
/* The continuation function */
|
||||
/* This is tricky without closures. Use a simplified approach. */
|
||||
/* We'll just call the proc with a dummy kont for now */
|
||||
/* TODO: full continuations need the VM */
|
||||
Value kont_args[1] = {VAL_VOID};
|
||||
return call_proc(proc, kont_args, 1, env);
|
||||
if (setjmp(local_jmp) != 0) {
|
||||
/* Continuation was invoked — return the escape value */
|
||||
cc_active_jmp = saved_jmp;
|
||||
return cc_escape_val;
|
||||
}
|
||||
|
||||
/* Build the continuation as a builtin function */
|
||||
Value kont = VAL_BUILTIN(ul_callcc_kont);
|
||||
Value kont_args[1] = {kont};
|
||||
Value result = call_proc(proc, kont_args, 1, env);
|
||||
cc_active_jmp = saved_jmp;
|
||||
return result;
|
||||
}
|
||||
|
||||
if (head == SYM_APPLY) {
|
||||
|
|
|
|||
321
tests/functional.lsp
Normal file
321
tests/functional.lsp
Normal file
|
|
@ -0,0 +1,321 @@
|
|||
;;; functional.lsp — Shared functional test suite
|
||||
;;; Runs identically in both Python and C implementations.
|
||||
;;;
|
||||
;;; Python: python3 uncommonlisp.py --fast tests/functional.lsp
|
||||
;;; C: ./c/uncommonlisp tests/functional.lsp
|
||||
;;;
|
||||
;;; Output: lines of "PASS: name" or "FAIL: name got=X expected=Y"
|
||||
;;; Exit: displays summary at end
|
||||
|
||||
(define *pass* 0)
|
||||
(define *fail* 0)
|
||||
|
||||
(define (assert-equal name got expected)
|
||||
(if (equal? got expected)
|
||||
(begin (set! *pass* (+ *pass* 1))
|
||||
(display "PASS: ") (display name) (newline))
|
||||
(begin (set! *fail* (+ *fail* 1))
|
||||
(display "FAIL: ") (display name)
|
||||
(display " got=") (write got)
|
||||
(display " expected=") (write expected) (newline))))
|
||||
|
||||
(define (assert-true name val)
|
||||
(assert-equal name val #t))
|
||||
|
||||
(define (assert-false name val)
|
||||
(assert-equal name val #f))
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Arithmetic
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "add" (+ 1 2) 3)
|
||||
(assert-equal "sub" (- 10 3) 7)
|
||||
(assert-equal "mul" (* 6 7) 42)
|
||||
(assert-equal "div" (/ 10 2) 5)
|
||||
(assert-equal "nested-arith" (+ (* 3 4) (- 10 5)) 17)
|
||||
(assert-equal "negate" (- 5) -5)
|
||||
(assert-equal "zero-add" (+) 0)
|
||||
(assert-equal "one-mul" (*) 1)
|
||||
(assert-equal "multi-add" (+ 1 2 3 4) 10)
|
||||
(assert-equal "multi-mul" (* 1 2 3 4) 24)
|
||||
(assert-true "zero?" (zero? 0))
|
||||
(assert-false "zero?-1" (zero? 1))
|
||||
(assert-true "positive?" (positive? 5))
|
||||
(assert-true "negative?" (negative? -3))
|
||||
(assert-true "odd?" (odd? 3))
|
||||
(assert-true "even?" (even? 4))
|
||||
(assert-equal "abs" (abs -7) 7)
|
||||
(assert-equal "min" (min 3 1 4 1 5) 1)
|
||||
(assert-equal "max" (max 3 1 4 1 5) 5)
|
||||
(assert-equal "modulo" (modulo 10 3) 1)
|
||||
(assert-equal "expt" (expt 2 10) 1024)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Comparison
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-true "eq-nums" (= 5 5))
|
||||
(assert-false "neq-nums" (= 5 6))
|
||||
(assert-true "lt" (< 3 5))
|
||||
(assert-true "gt" (> 5 3))
|
||||
(assert-true "le" (<= 3 3))
|
||||
(assert-true "ge" (>= 5 5))
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Booleans
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-true "not-false" (not #f))
|
||||
(assert-false "not-true" (not #t))
|
||||
(assert-false "not-1" (not 1))
|
||||
(assert-equal "and-true" (and 1 2 3) 3)
|
||||
(assert-false "and-false" (and 1 #f 3))
|
||||
(assert-equal "or-true" (or #f #f 3) 3)
|
||||
(assert-equal "or-first" (or 1 2) 1)
|
||||
(assert-false "or-false" (or #f #f))
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Pairs & Lists
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "cons" (cons 1 2) '(1 . 2))
|
||||
(assert-equal "car" (car '(1 2 3)) 1)
|
||||
(assert-equal "cdr" (cdr '(1 2 3)) '(2 3))
|
||||
(assert-equal "list" (list 1 2 3) '(1 2 3))
|
||||
(assert-equal "length" (length '(a b c)) 3)
|
||||
(assert-equal "append" (append '(1 2) '(3 4)) '(1 2 3 4))
|
||||
(assert-equal "reverse" (reverse '(1 2 3)) '(3 2 1))
|
||||
(assert-equal "list-ref" (list-ref '(a b c d) 2) 'c)
|
||||
(assert-true "null?-nil" (null? '()))
|
||||
(assert-false "null?-pair" (null? '(1)))
|
||||
(assert-true "pair?" (pair? '(1 2)))
|
||||
(assert-false "pair?-num" (pair? 42))
|
||||
(assert-equal "map" (map (lambda (x) (* x x)) '(1 2 3 4)) '(1 4 9 16))
|
||||
(assert-equal "filter" (filter odd? '(1 2 3 4 5)) '(1 3 5))
|
||||
(assert-equal "fold-left" (fold-left + 0 '(1 2 3 4)) 10)
|
||||
(assert-equal "for-each-effect"
|
||||
(let ((acc '()))
|
||||
(for-each (lambda (x) (set! acc (cons x acc))) '(1 2 3))
|
||||
(reverse acc))
|
||||
'(1 2 3))
|
||||
(assert-true "member" (pair? (member 3 '(1 2 3 4))))
|
||||
(assert-false "member-miss" (member 5 '(1 2 3)))
|
||||
(assert-equal "assoc" (cdr (assoc 'b '((a . 1) (b . 2) (c . 3)))) 2)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Strings
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "string-length" (string-length "hello") 5)
|
||||
(assert-equal "string-append" (string-append "hello" " " "world") "hello world")
|
||||
(assert-equal "substring" (substring "hello" 1 3) "el")
|
||||
(assert-equal "string-ref" (string-ref "abc" 1) #\b)
|
||||
(assert-equal "string-upcase" (string-upcase "hello") "HELLO")
|
||||
(assert-equal "string-downcase" (string-downcase "HELLO") "hello")
|
||||
(assert-equal "number->string" (number->string 42) "42")
|
||||
(assert-equal "string->number" (string->number "42") 42)
|
||||
(assert-true "string=?" (string=? "abc" "abc"))
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Characters
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "char->integer" (char->integer #\A) 65)
|
||||
(assert-equal "integer->char" (integer->char 65) #\A)
|
||||
(assert-true "char-alphabetic?" (char-alphabetic? #\a))
|
||||
(assert-false "char-alphabetic?-num" (char-alphabetic? #\1))
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Vectors
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "make-vector" (vector-ref (make-vector 3 0) 1) 0)
|
||||
(assert-equal "vector" (vector-ref (vector 10 20 30) 2) 30)
|
||||
(assert-equal "vector-length" (vector-length (vector 1 2 3)) 3)
|
||||
(assert-equal "vector-set!"
|
||||
(let ((v (vector 1 2 3)))
|
||||
(vector-set! v 1 99)
|
||||
(vector-ref v 1))
|
||||
99)
|
||||
(assert-equal "vector->list" (vector->list (vector 1 2 3)) '(1 2 3))
|
||||
(assert-equal "list->vector" (vector-ref (list->vector '(a b c)) 1) 'b)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Hash Tables
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(define ht (make-hash-table))
|
||||
(hash-table-set! ht 'x 10)
|
||||
(hash-table-set! ht 'y 20)
|
||||
(assert-equal "hash-ref" (hash-table-ref ht 'x) 10)
|
||||
(assert-equal "hash-ref/default" (hash-table-ref/default ht 'z 99) 99)
|
||||
(assert-true "hash-exists?" (hash-table-exists? ht 'x))
|
||||
(assert-false "hash-not-exists?" (hash-table-exists? ht 'z))
|
||||
(assert-equal "hash-size" (hash-table-size ht) 2)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Control Flow
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "if-true" (if #t 1 2) 1)
|
||||
(assert-equal "if-false" (if #f 1 2) 2)
|
||||
(assert-equal "cond" (cond ((= 1 2) 'a) ((= 1 1) 'b) (else 'c)) 'b)
|
||||
(assert-equal "case" (case 3 ((1 2) 'a) ((3 4) 'b) (else 'c)) 'b)
|
||||
(assert-equal "when" (when #t 42) 42)
|
||||
(assert-equal "begin" (begin 1 2 3) 3)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Let / Lambda / Closures
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "let" (let ((x 1) (y 2)) (+ x y)) 3)
|
||||
(assert-equal "let*" (let* ((x 1) (y (+ x 1))) y) 2)
|
||||
(assert-equal "letrec"
|
||||
(letrec ((even? (lambda (n) (if (= n 0) #t (odd? (- n 1)))))
|
||||
(odd? (lambda (n) (if (= n 0) #f (even? (- n 1))))))
|
||||
(even? 10))
|
||||
#t)
|
||||
(assert-equal "named-let"
|
||||
(let loop ((i 0) (acc 0))
|
||||
(if (= i 5) acc (loop (+ i 1) (+ acc i))))
|
||||
10)
|
||||
(assert-equal "closure"
|
||||
(let ((make-adder (lambda (n) (lambda (x) (+ x n)))))
|
||||
((make-adder 10) 5))
|
||||
15)
|
||||
(assert-equal "closure-mutation"
|
||||
(let ((counter (let ((n 0)) (lambda () (set! n (+ n 1)) n))))
|
||||
(counter) (counter) (counter))
|
||||
3)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Do loops
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "do-loop"
|
||||
(do ((i 0 (+ i 1)) (s 0 (+ s i)))
|
||||
((= i 5) s))
|
||||
10)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Define & recursion
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(define (factorial n)
|
||||
(if (<= n 1) 1 (* n (factorial (- n 1)))))
|
||||
(assert-equal "factorial" (factorial 10) 3628800)
|
||||
|
||||
(define (fib n)
|
||||
(let loop ((a 0) (b 1) (i 0))
|
||||
(if (= i n) a (loop b (+ a b) (+ i 1)))))
|
||||
(assert-equal "fib-iter" (fib 10) 55)
|
||||
(assert-equal "fib-30" (fib 30) 832040)
|
||||
|
||||
(define (ack m n)
|
||||
(cond ((= m 0) (+ n 1))
|
||||
((= n 0) (ack (- m 1) 1))
|
||||
(else (ack (- m 1) (ack m (- n 1))))))
|
||||
(assert-equal "ackermann" (ack 3 4) 125)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Tail-call optimization
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(define (count-down n)
|
||||
(if (= n 0) 'done (count-down (- n 1))))
|
||||
(assert-equal "tco-100k" (count-down 100000) 'done)
|
||||
|
||||
(define (sum-to n)
|
||||
(let loop ((i n) (acc 0))
|
||||
(if (= i 0) acc (loop (- i 1) (+ acc i)))))
|
||||
(assert-equal "sum-to-50k" (sum-to 50000) 1250025000)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Quasiquote
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "quasiquote" `(1 ,(+ 1 1) 3) '(1 2 3))
|
||||
(assert-equal "unquote-splicing" `(1 ,@(list 2 3) 4) '(1 2 3 4))
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Macros
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(define-macro (my-when test . body)
|
||||
`(if ,test (begin ,@body) (void)))
|
||||
(assert-equal "define-macro" (my-when #t 1 2 3) 3)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Type predicates
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-true "number?" (number? 42))
|
||||
(assert-true "integer?" (integer? 42))
|
||||
(assert-true "string?" (string? "hello"))
|
||||
(assert-true "symbol?" (symbol? 'x))
|
||||
(assert-true "boolean?" (boolean? #t))
|
||||
(assert-true "procedure?" (procedure? car))
|
||||
(assert-true "vector?" (vector? (vector 1)))
|
||||
(assert-true "list?" (list? '(1 2)))
|
||||
(assert-true "char?" (char? #\a))
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Error handling
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "guard"
|
||||
(guard (e (#t 'caught))
|
||||
(error "test" "oops"))
|
||||
'caught)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; call/cc (escape) — wrapped in guard for implementations
|
||||
;;; that may not fully support call/cc
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(assert-equal "call/cc-escape"
|
||||
(guard (e (#t 'skip))
|
||||
(call/cc (lambda (k) (k 42) 99)))
|
||||
42)
|
||||
|
||||
(assert-equal "call/cc-no-escape"
|
||||
(guard (e (#t 'skip))
|
||||
(call/cc (lambda (k) 99)))
|
||||
99)
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Higher-order programs
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(define (mergesort lst)
|
||||
(define (merge a b)
|
||||
(cond ((null? a) b) ((null? b) a)
|
||||
((< (car a) (car b)) (cons (car a) (merge (cdr a) b)))
|
||||
(else (cons (car b) (merge a (cdr b))))))
|
||||
(define (split l a b)
|
||||
(if (null? l) (list a b) (split (cdr l) b (cons (car l) a))))
|
||||
(if (or (null? lst) (null? (cdr lst))) lst
|
||||
(let ((h (split lst '() '())))
|
||||
(merge (mergesort (car h)) (mergesort (cadr h))))))
|
||||
|
||||
(assert-equal "mergesort" (mergesort '(5 3 1 4 2)) '(1 2 3 4 5))
|
||||
|
||||
(assert-equal "compose"
|
||||
(let ((double (lambda (x) (* x 2)))
|
||||
(inc (lambda (x) (+ x 1))))
|
||||
(map (lambda (x) (double (inc x))) '(1 2 3)))
|
||||
'(4 6 8))
|
||||
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
;;; Summary
|
||||
;;; ═══════════════════════════════════════════════════════════════
|
||||
|
||||
(newline)
|
||||
(display "════════════════════════════════════════") (newline)
|
||||
(display "Results: ") (display *pass*) (display " passed, ")
|
||||
(display *fail*) (display " failed") (newline)
|
||||
(if (= *fail* 0)
|
||||
(display "ALL TESTS PASSED")
|
||||
(display "SOME TESTS FAILED"))
|
||||
(newline)
|
||||
Loading…
Add table
Add a link
Reference in a new issue