russell@unturf.com
bfd4ec7ec8
Added tcp-listen/accept/connect/recv/send/close to Python, C, and asm. One examples/http-server.lsp runs identically in all three impls and serves HTTP/1.0 with routing, content-type, and content-length headers. asm additions: - SYS_SOCKET/BIND/LISTEN/ACCEPT/CONNECT/SETSOCKOPT syscalls - 6 tcp-* builtins using the existing port encoding (SPECIAL ≥ 1000) - bi_tcp_connect: dotted-quad IPv4 parser, no DNS dependency Defects fixed along the way (surfaced by the HTTP server): - string-append: was 2-arg only; now variadic (walks arg list twice) - number->string: was stubbed to VAL_VOID; now correctly writes digits into a heap-allocated string (incl. negative handling) - String-literal reader: \r and \0 escape sequences now handled (was silently dropping backslash, treating them as literal 'r' / '0') - tcp_accept: sockaddr buffer was 8 bytes, now 16 (was corrupting caller's stack when accept wrote full struct sockaddr_in) Pinocchio benchmark (tests/web-benchmark.sh): At concurrency=20, 1000 requests, serving a 1KB body: uncommonlisp Python 373 req/s uncommonlisp C 370 req/s uncommonlisp asm 370 req/s python3 http.server 381 req/s (stdlib reference) busybox httpd 382 req/s (production reference) All five converge within 3% — the client (curl fork/exec) is the bottleneck, not the server. Our single-threaded blocking servers are indistinguishable from battle-tested ones at this load. Binary sizes: uncommonlisp asm 45 KB (HTTP + everything else) busybox httpd 2.1 MB (multi-call binary) python3 8 MB (interpreter) The asm HTTP server is 46× smaller than busybox and 176× smaller than Python, serves from 7 Linux syscalls, and the entire protocol handler is 70 lines of portable Scheme. Test counts: 132 asm (up 1), rest unchanged. All green.
295 lines
13 KiB
Bash
295 lines
13 KiB
Bash
#!/bin/bash
|
|
# test.sh — Unit, integration, and functional tests for the asm Scheme interpreter
|
|
#
|
|
# Usage: bash test.sh
|
|
#
|
|
# Tests verify expected output. Any mismatch = FAIL.
|
|
|
|
set -e
|
|
cd "$(dirname "$0")"
|
|
|
|
PASS=0
|
|
FAIL=0
|
|
UL=./uncommonlisp
|
|
|
|
check() {
|
|
local name="$1" input="$2" expected="$3"
|
|
local got
|
|
got=$(echo "$input" | $UL 2>/dev/null | tr -d '\n')
|
|
if [ "$got" = "$expected" ]; then
|
|
PASS=$((PASS + 1))
|
|
else
|
|
FAIL=$((FAIL + 1))
|
|
echo "FAIL: $name"
|
|
echo " input: $input"
|
|
echo " expected: $expected"
|
|
echo " got: $got"
|
|
fi
|
|
}
|
|
|
|
echo "═══════════════════════════════════════════════════════"
|
|
echo "asm/uncommonlisp test suite"
|
|
echo "═══════════════════════════════════════════════════════"
|
|
|
|
# ─── UNIT TESTS: individual primitives ────────────────────
|
|
|
|
echo "[unit] arithmetic"
|
|
check "add" "(+ 1 2)" "3"
|
|
check "sub" "(- 10 3)" "7"
|
|
check "mul" "(* 6 7)" "42"
|
|
check "nested" "(+ (* 3 4) (- 10 5))" "17"
|
|
check "negate" "(- 5)" "-5"
|
|
check "zero-add" "(+)" "0"
|
|
check "one-mul" "(*)" "1"
|
|
check "multi-add" "(+ 1 2 3 4)" "10"
|
|
check "multi-mul" "(* 2 3 4)" "24"
|
|
check "modulo" "(modulo 10 3)" "1"
|
|
check "remainder" "(remainder 10 3)" "1"
|
|
check "quotient" "(quotient 10 3)" "3"
|
|
check "abs" "(abs -7)" "7"
|
|
check "min" "(min 3 1 4)" "1"
|
|
check "max" "(max 3 1 4)" "4"
|
|
check "expt" "(* 2 2 2 2 2 2 2 2 2 2)" "1024"
|
|
check "div" "(/ 10 2)" "5"
|
|
check "expt-bi" "(expt 2 10)" "1024"
|
|
check "odd?" "(odd? 3)" "#t"
|
|
check "odd?-even" "(odd? 4)" "#f"
|
|
check "even?" "(even? 4)" "#t"
|
|
check "even?-odd" "(even? 3)" "#f"
|
|
|
|
echo "[unit] comparison"
|
|
check "eq" "(= 5 5)" "#t"
|
|
check "neq" "(= 5 6)" "#f"
|
|
check "lt" "(< 3 5)" "#t"
|
|
check "gt" "(> 5 3)" "#t"
|
|
check "le" "(<= 3 3)" "#t"
|
|
check "ge" "(>= 5 5)" "#t"
|
|
check "lt-false" "(< 5 3)" "#f"
|
|
|
|
echo "[unit] booleans"
|
|
check "not-false" "(not #f)" "#t"
|
|
check "not-true" "(not #t)" "#f"
|
|
check "not-num" "(not 42)" "#f"
|
|
|
|
echo "[unit] predicates"
|
|
check "zero?" "(zero? 0)" "#t"
|
|
check "zero?-1" "(zero? 1)" "#f"
|
|
check "null?-nil" "(null? '())" "#t"
|
|
check "null?-pair" "(null? (cons 1 2))" "#f"
|
|
check "pair?" "(pair? (cons 1 2))" "#t"
|
|
check "pair?-num" "(pair? 42)" "#f"
|
|
check "number?" "(number? 42)" "#t"
|
|
check "boolean?" "(boolean? #t)" "#t"
|
|
check "symbol?" "(symbol? 'x)" "#t"
|
|
check "positive?" "(positive? 5)" "#t"
|
|
check "negative?" "(negative? -3)" "#t"
|
|
check "integer?" "(integer? 42)" "#t"
|
|
check "integer?-f" "(integer? #t)" "#f"
|
|
check "list?" "(list? (list 1 2))" "#t"
|
|
check "list?-f" "(list? 42)" "#f"
|
|
|
|
echo "[unit] pairs & lists"
|
|
check "cons" "(cons 1 2)" "(1 . 2)"
|
|
check "car" "(car (cons 1 2))" "1"
|
|
check "cdr" "(cdr (cons 1 2))" "2"
|
|
check "list" "(list 1 2 3)" "(1 2 3)"
|
|
check "length" "(length (list 1 2 3 4 5))" "5"
|
|
check "car-list" "(car (list 10 20 30))" "10"
|
|
check "cdr-list" "(car (cdr (list 10 20 30)))" "20"
|
|
check "append" "(append (list 1 2) (list 3 4))" "(1 2 3 4)"
|
|
check "append-nil" "(append '() (list 1))" "(1)"
|
|
check "reverse" "(reverse (list 1 2 3))" "(3 2 1)"
|
|
check "member" "(car (member 3 (list 1 2 3 4)))" "3"
|
|
check "member-f" "(member 9 (list 1 2 3))" "#f"
|
|
check "assoc" "(cdr (assoc 'b (list (cons 'a 1) (cons 'b 2))))" "2"
|
|
|
|
echo "[unit] and/or"
|
|
check "and-all" "(and 1 2 3)" "3"
|
|
check "and-false" "(and 1 #f 3)" "#f"
|
|
check "and-empty" "(and)" "#t"
|
|
check "or-first" "(or 1 2)" "1"
|
|
check "or-false" "(or #f #f 42)" "42"
|
|
check "or-empty" "(or)" "#f"
|
|
|
|
# ─── INTEGRATION TESTS: combined features ────────────────
|
|
|
|
echo "[integration] special forms"
|
|
check "if-true" "(if #t 1 2)" "1"
|
|
check "if-false" "(if #f 1 2)" "2"
|
|
check "if-pred" "(if (< 1 2) 42 99)" "42"
|
|
check "quote" "(quote (1 2 3))" "(1 2 3)"
|
|
check "begin" "(begin 1 2 3)" "3"
|
|
check "cond" "(cond ((= 1 2) 10) ((= 1 1) 20) (else 30))" "20"
|
|
check "cond-else" "(cond (#f 1) (else 99))" "99"
|
|
|
|
echo "[integration] bindings"
|
|
check "define-val" "(define x 10) (+ x 5)" "15"
|
|
check "define-fn" "(define (f x) (+ x 1)) (f 41)" "42"
|
|
check "set!" "(define x 1) (set! x 42) x" "42"
|
|
check "let" "(let ((x 10) (y 20)) (+ x y))" "30"
|
|
check "lambda" "((lambda (x y) (+ x y)) 3 4)" "7"
|
|
check "closure" "(define (make-adder n) (lambda (x) (+ x n))) ((make-adder 10) 5)" "15"
|
|
|
|
echo "[integration] named-let"
|
|
check "named-let-sum" "(let loop ((i 5) (acc 0)) (if (= i 0) acc (loop (- i 1) (+ acc i))))" "15"
|
|
|
|
echo "[integration] recursion"
|
|
check "factorial" "(define (fact n) (if (<= n 1) 1 (* n (fact (- n 1))))) (fact 10)" "3628800"
|
|
check "fib-rec" "(define (fib n) (if (<= n 1) n (+ (fib (- n 1)) (fib (- n 2))))) (fib 10)" "55"
|
|
|
|
echo "[integration] higher-order"
|
|
check "apply-lambda" "((lambda (f x) (f x)) (lambda (n) (* n n)) 7)" "49"
|
|
check "map" "(map (lambda (x) (* x x)) (list 1 2 3))" "(1 4 9)"
|
|
check "map-add" "(map (lambda (x) (+ x 10)) (list 1 2 3))" "(11 12 13)"
|
|
check "filter" "(filter odd? (list 1 2 3 4 5))" "(1 3 5)"
|
|
check "filter-all" "(filter even? (list 1 3 5))" "()"
|
|
check "fold-left" "(fold-left + 0 (list 1 2 3 4))" "10"
|
|
check "fold-sub" "(fold-left - 100 (list 10 20 30))" "40"
|
|
|
|
echo "[integration] strings"
|
|
check "str-length" "(string-length \"hello\")" "5"
|
|
check "str-eq" "(string=? \"abc\" \"abc\")" "#t"
|
|
check "str-neq" "(string=? \"abc\" \"def\")" "#f"
|
|
check "str-to-num" "(string->number \"42\")" "42"
|
|
check "char-to-int" "(char->integer (string-ref \"A\" 0))" "65"
|
|
|
|
echo "[integration] vectors"
|
|
check "vec-ref" "(vector-ref (vector 10 20 30) 1)" "20"
|
|
check "vec-ref0" "(vector-ref (vector 10 20 30) 0)" "10"
|
|
check "vec-len" "(vector-length (vector 1 2 3))" "3"
|
|
check "vec?" "(vector? (vector 1))" "#t"
|
|
check "vec?-f" "(vector? 42)" "#f"
|
|
check "vec-set" "(let ((v (vector 1 2 3))) (vector-set! v 1 99) (vector-ref v 1))" "99"
|
|
|
|
# ─── FUNCTIONAL TESTS: real programs ─────────────────────
|
|
|
|
echo "[functional] fibonacci"
|
|
check "fib-35" "(define (fib n) (let loop ((a 0) (b 1) (i 0)) (if (= i n) a (loop b (+ a b) (+ i 1))))) (fib 35)" "9227465"
|
|
|
|
echo "[functional] ackermann"
|
|
check "ack-3-4" "(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"
|
|
|
|
echo "[functional] tail-call optimization"
|
|
check "tco-deep" "(define (count n) (if (= n 0) 0 (count (- n 1)))) (count 100000)" "0"
|
|
|
|
echo "[functional] list processing"
|
|
check "list-ops" "(define (sum lst) (if (null? lst) 0 (+ (car lst) (sum (cdr lst))))) (sum (list 1 2 3 4 5))" "15"
|
|
check "list-rev" "(define (rev lst acc) (if (null? lst) acc (rev (cdr lst) (cons (car lst) acc)))) (rev (list 1 2 3) '())" "(3 2 1)"
|
|
|
|
echo "[functional] mutual recursion"
|
|
check "even-odd" "(define (my-even n) (if (= n 0) #t (my-odd (- n 1)))) (define (my-odd n) (if (= n 0) #f (my-even (- n 1)))) (my-even 10)" "#t"
|
|
|
|
echo "[functional] closure state"
|
|
check "counter" "(define c (let ((n 0)) (lambda () (set! n (+ n 1)) n))) (c) (c) (c)" "123"
|
|
|
|
# ─── LOAD BUILTIN: unit + integration + functional ───────
|
|
|
|
LOAD_TMP=$(mktemp -d)
|
|
trap "rm -rf $LOAD_TMP" EXIT
|
|
|
|
echo "[unit] load — basic file"
|
|
cat > "$LOAD_TMP/a.lsp" <<EOF
|
|
(define loaded-x 42)
|
|
EOF
|
|
check "load-basic" "(load \"$LOAD_TMP/a.lsp\") loaded-x" "42"
|
|
|
|
echo "[unit] load — define procedure"
|
|
cat > "$LOAD_TMP/b.lsp" <<EOF
|
|
(define (square n) (* n n))
|
|
EOF
|
|
check "load-proc" "(load \"$LOAD_TMP/b.lsp\") (square 9)" "81"
|
|
|
|
echo "[unit] load — missing file returns #f"
|
|
check "load-missing" "(load \"/tmp/__nope_uncommonlisp_$$\")" "#f"
|
|
|
|
echo "[unit] load — empty file is void"
|
|
: > "$LOAD_TMP/empty.lsp"
|
|
check "load-empty" "(load \"$LOAD_TMP/empty.lsp\") 99" "99"
|
|
|
|
echo "[integration] load — nested (outer loads inner)"
|
|
cat > "$LOAD_TMP/inner.lsp" <<EOF
|
|
(define inner-val 7)
|
|
EOF
|
|
cat > "$LOAD_TMP/outer.lsp" <<EOF
|
|
(define outer-val 99)
|
|
(load "$LOAD_TMP/inner.lsp")
|
|
EOF
|
|
check "load-nested" "(load \"$LOAD_TMP/outer.lsp\") (+ outer-val inner-val)" "106"
|
|
|
|
echo "[integration] load — continues after loaded file"
|
|
cat > "$LOAD_TMP/c.lsp" <<EOF
|
|
(define c-val 10)
|
|
EOF
|
|
check "load-after" "(load \"$LOAD_TMP/c.lsp\") (define after-val 20) (+ c-val after-val)" "30"
|
|
|
|
echo "[integration] load — S-expression portal resume"
|
|
cat > "$LOAD_TMP/portal.sexp" <<EOF
|
|
;; portable state
|
|
(define p-int 777)
|
|
(define p-list '(1 2 3 4 5))
|
|
(define p-str "hello")
|
|
EOF
|
|
check "load-portal-int" "(load \"$LOAD_TMP/portal.sexp\") p-int" "777"
|
|
check "load-portal-list" "(load \"$LOAD_TMP/portal.sexp\") (length p-list)" "5"
|
|
check "load-portal-str" "(load \"$LOAD_TMP/portal.sexp\") (display p-str)" "hello"
|
|
|
|
echo "[functional] load — set! then restore from file"
|
|
cat > "$LOAD_TMP/restore.sexp" <<EOF
|
|
(define restored 12345)
|
|
EOF
|
|
check "load-restore" "(define restored 0) (load \"$LOAD_TMP/restore.sexp\") restored" "12345"
|
|
|
|
# ─── WRITE-FILE + FILE->STRING ───────────────────────────
|
|
|
|
echo "[unit] write-file / file->string"
|
|
# `check` joins all REPL outputs; suffix the "answer" so we can match.
|
|
check "wf-basic" "(begin (write-file \"$LOAD_TMP/wf.txt\" \"abc\") (file->string \"$LOAD_TMP/wf.txt\"))" '"abc"'
|
|
check "wf-truth" "(write-file \"$LOAD_TMP/wf.txt\" \"x\")" "#t"
|
|
check "fs-missing" "(file->string \"/tmp/__no_such_$$__\")" "#f"
|
|
check "wf-overwrite" "(begin (write-file \"$LOAD_TMP/wf.txt\" \"one\") (write-file \"$LOAD_TMP/wf.txt\" \"two\") (file->string \"$LOAD_TMP/wf.txt\"))" '"two"'
|
|
check "fs-length" "(begin (write-file \"$LOAD_TMP/wf.txt\" \"hello\") (string-length (file->string \"$LOAD_TMP/wf.txt\")))" "5"
|
|
|
|
echo "[integration] write-file + load round-trip"
|
|
check "wf-load-rt" "(begin (write-file \"$LOAD_TMP/rt.sexp\" \"(define rt-val 456)\") (define rt-val 0) (load \"$LOAD_TMP/rt.sexp\") rt-val)" "456"
|
|
|
|
# ─── PORTS: open-output-file, close-port, port?, display/write/newline to port ──
|
|
|
|
echo "[unit] ports"
|
|
check "port?-true" "(port? (open-output-file \"$LOAD_TMP/p.txt\"))" "#t"
|
|
check "port?-false" "(port? 42)" "#f"
|
|
check "port-close" "(begin (let ((p (open-output-file \"$LOAD_TMP/p.txt\"))) (close-port p)) 1)" "1"
|
|
check "port-display" "(begin (let ((p (open-output-file \"$LOAD_TMP/p.txt\"))) (display \"hi\" p) (close-port p)) (file->string \"$LOAD_TMP/p.txt\"))" '"hi"'
|
|
# newline in file gets eaten by tr -d '\n' in check helper, so count chars: a + \n + b = 3
|
|
check "port-newline" "(begin (let ((p (open-output-file \"$LOAD_TMP/p.txt\"))) (display \"a\" p) (newline p) (display \"b\" p) (close-port p)) (string-length (file->string \"$LOAD_TMP/p.txt\")))" "3"
|
|
check "port-write-num" "(begin (let ((p (open-output-file \"$LOAD_TMP/p.txt\"))) (write 42 p) (close-port p)) (file->string \"$LOAD_TMP/p.txt\"))" '"42"'
|
|
|
|
echo "[unit] tcp sockets (create/close only)"
|
|
check "tcp-listen-close" "(let ((s (tcp-listen 0))) (port? s))" "#t"
|
|
# Note: tcp-listen 0 binds to ephemeral port. Can't accept (would block).
|
|
# Full connection round-trip tests live in the web-benchmark integration script.
|
|
|
|
echo "[integration] ports — S-expression portal written via ports"
|
|
PORTAL_TMP="$LOAD_TMP/port-portal.sexp"
|
|
check "port-portal" "(begin (define p (open-output-file \"$PORTAL_TMP\")) (display \"(define pp-x \" p) (write 42 p) (display \")\" p) (newline p) (display \"(define pp-y \" p) (write 777 p) (display \")\" p) (newline p) (close-port p) (define pp-x 0) (define pp-y 0) (load \"$PORTAL_TMP\") (+ pp-x pp-y))" "819"
|
|
|
|
echo "[functional] display output"
|
|
# display writes to stdout without newline, result is void
|
|
got=$(echo '(display 42) (newline)' | $UL 2>/dev/null)
|
|
if echo "$got" | grep -q "42"; then
|
|
PASS=$((PASS + 1))
|
|
else
|
|
FAIL=$((FAIL + 1))
|
|
echo "FAIL: display-42"
|
|
fi
|
|
|
|
# ─── SUMMARY ─────────────────────────────────────────────
|
|
|
|
echo
|
|
echo "═══════════════════════════════════════════════════════"
|
|
echo "Results: $PASS passed, $FAIL failed"
|
|
if [ $FAIL -eq 0 ]; then
|
|
echo "ALL TESTS PASSED"
|
|
else
|
|
echo "SOME TESTS FAILED"
|
|
exit 1
|
|
fi
|