russell@unturf.com
db2cd77c62
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).
321 lines
16 KiB
Text
321 lines
16 KiB
Text
;;; 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)
|