giles
1ad8e74aa6
Type predicates, arithmetic, chars (inline α/digit/case), format, gensym, values, sets, radix, list utilities. cl-empty? guards all list traversal against () vs nil in sx_server. Load spec/stdlib.sx in test.sh to expose format. Fix lib/r7rs.sx number->string to use (= (len r) 0) not (nil? r). Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
303 lines
7.9 KiB
Bash
Executable File
303 lines
7.9 KiB
Bash
Executable File
#!/usr/bin/env bash
|
|
# lib/common-lisp/test.sh — quick smoke-test the CL runtime layer.
|
|
# Uses sx_server.exe epoch protocol (same as lib/lua/test.sh).
|
|
#
|
|
# Usage:
|
|
# bash lib/common-lisp/test.sh
|
|
# bash lib/common-lisp/test.sh -v
|
|
|
|
set -uo pipefail
|
|
cd "$(git rev-parse --show-toplevel)"
|
|
|
|
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
|
|
if [ ! -x "$SX_SERVER" ]; then
|
|
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
|
|
fi
|
|
if [ ! -x "$SX_SERVER" ]; then
|
|
echo "ERROR: sx_server.exe not found. Run: cd hosts/ocaml && dune build"
|
|
exit 1
|
|
fi
|
|
|
|
VERBOSE="${1:-}"
|
|
PASS=0; FAIL=0; ERRORS=""
|
|
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
|
|
|
|
cat > "$TMPFILE" << 'EPOCHS'
|
|
(epoch 1)
|
|
(load "spec/stdlib.sx")
|
|
(load "lib/common-lisp/runtime.sx")
|
|
|
|
;; --- Type predicates ---
|
|
(epoch 10)
|
|
(eval "(cl-null? nil)")
|
|
(epoch 11)
|
|
(eval "(cl-null? false)")
|
|
(epoch 12)
|
|
(eval "(cl-consp? (list 1 2))")
|
|
(epoch 13)
|
|
(eval "(cl-consp? nil)")
|
|
(epoch 14)
|
|
(eval "(cl-listp? nil)")
|
|
(epoch 15)
|
|
(eval "(cl-listp? (list 1))")
|
|
(epoch 16)
|
|
(eval "(cl-atom? nil)")
|
|
(epoch 17)
|
|
(eval "(cl-atom? (list 1))")
|
|
(epoch 18)
|
|
(eval "(cl-integerp? 42)")
|
|
(epoch 19)
|
|
(eval "(cl-floatp? 3.14)")
|
|
(epoch 20)
|
|
(eval "(cl-characterp? (integer->char 65))")
|
|
(epoch 21)
|
|
(eval "(cl-stringp? \"hello\")")
|
|
|
|
;; --- Arithmetic ---
|
|
(epoch 30)
|
|
(eval "(cl-mod 10 3)")
|
|
(epoch 31)
|
|
(eval "(cl-rem 10 3)")
|
|
(epoch 32)
|
|
(eval "(cl-quotient 10 3)")
|
|
(epoch 33)
|
|
(eval "(cl-gcd 12 8)")
|
|
(epoch 34)
|
|
(eval "(cl-lcm 4 6)")
|
|
(epoch 35)
|
|
(eval "(cl-abs -5)")
|
|
(epoch 36)
|
|
(eval "(cl-abs 5)")
|
|
(epoch 37)
|
|
(eval "(cl-min 2 7)")
|
|
(epoch 38)
|
|
(eval "(cl-max 2 7)")
|
|
(epoch 39)
|
|
(eval "(cl-evenp? 4)")
|
|
(epoch 40)
|
|
(eval "(cl-evenp? 3)")
|
|
(epoch 41)
|
|
(eval "(cl-oddp? 7)")
|
|
(epoch 42)
|
|
(eval "(cl-zerop? 0)")
|
|
(epoch 43)
|
|
(eval "(cl-plusp? 1)")
|
|
(epoch 44)
|
|
(eval "(cl-minusp? -1)")
|
|
(epoch 45)
|
|
(eval "(cl-signum 42)")
|
|
(epoch 46)
|
|
(eval "(cl-signum -7)")
|
|
(epoch 47)
|
|
(eval "(cl-signum 0)")
|
|
|
|
;; --- Characters ---
|
|
(epoch 50)
|
|
(eval "(cl-char-code (integer->char 65))")
|
|
(epoch 51)
|
|
(eval "(char? (cl-code-char 65))")
|
|
(epoch 52)
|
|
(eval "(cl-char=? (integer->char 65) (integer->char 65))")
|
|
(epoch 53)
|
|
(eval "(cl-char<? (integer->char 65) (integer->char 90))")
|
|
(epoch 54)
|
|
(eval "(cl-char-code cl-char-space)")
|
|
(epoch 55)
|
|
(eval "(cl-char-code cl-char-newline)")
|
|
(epoch 56)
|
|
(eval "(cl-alpha-char-p (integer->char 65))")
|
|
(epoch 57)
|
|
(eval "(cl-digit-char-p (integer->char 48))")
|
|
|
|
;; --- Format ---
|
|
(epoch 60)
|
|
(eval "(cl-format nil \"hello\")")
|
|
(epoch 61)
|
|
(eval "(cl-format nil \"~a\" \"world\")")
|
|
(epoch 62)
|
|
(eval "(cl-format nil \"~d\" 42)")
|
|
(epoch 63)
|
|
(eval "(cl-format nil \"~x\" 255)")
|
|
(epoch 64)
|
|
(eval "(cl-format nil \"x=~d y=~d\" 3 4)")
|
|
|
|
;; --- Gensym ---
|
|
(epoch 70)
|
|
(eval "(= (type-of (cl-gensym)) \"symbol\")")
|
|
(epoch 71)
|
|
(eval "(not (= (cl-gensym) (cl-gensym)))")
|
|
|
|
;; --- Sets ---
|
|
(epoch 80)
|
|
(eval "(cl-set? (cl-make-set))")
|
|
(epoch 81)
|
|
(eval "(let ((s (cl-make-set))) (do (cl-set-add s 1) (cl-set-memberp s 1)))")
|
|
(epoch 82)
|
|
(eval "(cl-set-memberp (cl-make-set) 42)")
|
|
(epoch 83)
|
|
(eval "(cl-set-memberp (cl-list->set (list 1 2 3)) 2)")
|
|
|
|
;; --- Lists ---
|
|
(epoch 90)
|
|
(eval "(cl-nth 0 (list 1 2 3))")
|
|
(epoch 91)
|
|
(eval "(cl-nth 2 (list 1 2 3))")
|
|
(epoch 92)
|
|
(eval "(cl-last (list 1 2 3))")
|
|
(epoch 93)
|
|
(eval "(cl-butlast (list 1 2 3))")
|
|
(epoch 94)
|
|
(eval "(cl-nthcdr 1 (list 1 2 3))")
|
|
(epoch 95)
|
|
(eval "(cl-assoc \"b\" (list (list \"a\" 1) (list \"b\" 2)))")
|
|
(epoch 96)
|
|
(eval "(cl-assoc \"z\" (list (list \"a\" 1)))")
|
|
(epoch 97)
|
|
(eval "(cl-getf (list \"x\" 42 \"y\" 99) \"x\")")
|
|
(epoch 98)
|
|
(eval "(cl-adjoin 0 (list 1 2))")
|
|
(epoch 99)
|
|
(eval "(cl-adjoin 1 (list 1 2))")
|
|
(epoch 100)
|
|
(eval "(cl-member 2 (list 1 2 3))")
|
|
(epoch 101)
|
|
(eval "(cl-member 9 (list 1 2 3))")
|
|
(epoch 102)
|
|
(eval "(cl-flatten (list 1 (list 2 3) 4))")
|
|
|
|
;; --- Radix ---
|
|
(epoch 110)
|
|
(eval "(cl-format-binary 10)")
|
|
(epoch 111)
|
|
(eval "(cl-format-octal 15)")
|
|
(epoch 112)
|
|
(eval "(cl-format-hex 255)")
|
|
(epoch 113)
|
|
(eval "(cl-format-decimal 42)")
|
|
(epoch 114)
|
|
(eval "(cl-integer-to-string 31 16)")
|
|
(epoch 115)
|
|
(eval "(cl-string-to-integer \"1f\" 16)")
|
|
|
|
EPOCHS
|
|
|
|
OUTPUT=$(timeout 30 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
|
|
|
|
check() {
|
|
local epoch="$1" desc="$2" expected="$3"
|
|
local actual
|
|
# ok-len format: value appears on the line AFTER "(ok-len N length)"
|
|
actual=$(echo "$OUTPUT" | grep -A1 "^(ok-len $epoch " | tail -1 || true)
|
|
# strip any leading "(ok-len ...)" if grep -A1 returned it instead
|
|
if echo "$actual" | grep -q "^(ok-len"; then actual=""; fi
|
|
if [ -z "$actual" ]; then
|
|
actual=$(echo "$OUTPUT" | grep "^(ok $epoch " | head -1 || true)
|
|
fi
|
|
if [ -z "$actual" ]; then
|
|
actual=$(echo "$OUTPUT" | grep "^(error $epoch " | head -1 || true)
|
|
fi
|
|
[ -z "$actual" ] && actual="<no output for epoch $epoch>"
|
|
|
|
if echo "$actual" | grep -qF -- "$expected"; then
|
|
PASS=$((PASS+1))
|
|
[ "$VERBOSE" = "-v" ] && echo " ok $desc"
|
|
else
|
|
FAIL=$((FAIL+1))
|
|
ERRORS+=" FAIL [$desc] (epoch $epoch) expected: $expected | actual: $actual
|
|
"
|
|
fi
|
|
}
|
|
|
|
# Type predicates
|
|
check 10 "cl-null? nil" "true"
|
|
check 11 "cl-null? false" "false"
|
|
check 12 "cl-consp? pair" "true"
|
|
check 13 "cl-consp? nil" "false"
|
|
check 14 "cl-listp? nil" "true"
|
|
check 15 "cl-listp? list" "true"
|
|
check 16 "cl-atom? nil" "true"
|
|
check 17 "cl-atom? pair" "false"
|
|
check 18 "cl-integerp?" "true"
|
|
check 19 "cl-floatp?" "true"
|
|
check 20 "cl-characterp?" "true"
|
|
check 21 "cl-stringp?" "true"
|
|
|
|
# Arithmetic
|
|
check 30 "cl-mod 10 3" "1"
|
|
check 31 "cl-rem 10 3" "1"
|
|
check 32 "cl-quotient 10 3" "3"
|
|
check 33 "cl-gcd 12 8" "4"
|
|
check 34 "cl-lcm 4 6" "12"
|
|
check 35 "cl-abs -5" "5"
|
|
check 36 "cl-abs 5" "5"
|
|
check 37 "cl-min 2 7" "2"
|
|
check 38 "cl-max 2 7" "7"
|
|
check 39 "cl-evenp? 4" "true"
|
|
check 40 "cl-evenp? 3" "false"
|
|
check 41 "cl-oddp? 7" "true"
|
|
check 42 "cl-zerop? 0" "true"
|
|
check 43 "cl-plusp? 1" "true"
|
|
check 44 "cl-minusp? -1" "true"
|
|
check 45 "cl-signum pos" "1"
|
|
check 46 "cl-signum neg" "-1"
|
|
check 47 "cl-signum zero" "0"
|
|
|
|
# Characters
|
|
check 50 "cl-char-code" "65"
|
|
check 51 "code-char returns char" "true"
|
|
check 52 "cl-char=?" "true"
|
|
check 53 "cl-char<?" "true"
|
|
check 54 "cl-char-space code" "32"
|
|
check 55 "cl-char-newline code" "10"
|
|
check 56 "cl-alpha-char-p A" "true"
|
|
check 57 "cl-digit-char-p 0" "true"
|
|
|
|
# Format
|
|
check 60 "cl-format plain" '"hello"'
|
|
check 61 "cl-format ~a" '"world"'
|
|
check 62 "cl-format ~d" '"42"'
|
|
check 63 "cl-format ~x" '"ff"'
|
|
check 64 "cl-format multi" '"x=3 y=4"'
|
|
|
|
# Gensym
|
|
check 70 "gensym returns symbol" "true"
|
|
check 71 "gensyms are unique" "true"
|
|
|
|
# Sets
|
|
check 80 "make-set is set?" "true"
|
|
check 81 "set-add + member" "true"
|
|
check 82 "member in empty" "false"
|
|
check 83 "list->set member" "true"
|
|
|
|
# Lists
|
|
check 90 "cl-nth 0" "1"
|
|
check 91 "cl-nth 2" "3"
|
|
check 92 "cl-last" "(3)"
|
|
check 93 "cl-butlast" "(1 2)"
|
|
check 94 "cl-nthcdr 1" "(2 3)"
|
|
check 95 "cl-assoc hit" '("b" 2)'
|
|
check 96 "cl-assoc miss" "nil"
|
|
check 97 "cl-getf hit" "42"
|
|
check 98 "cl-adjoin new" "(0 1 2)"
|
|
check 99 "cl-adjoin dup" "(1 2)"
|
|
check 100 "cl-member hit" "(2 3)"
|
|
check 101 "cl-member miss" "nil"
|
|
check 102 "cl-flatten" "(1 2 3 4)"
|
|
|
|
# Radix
|
|
check 110 "cl-format-binary 10" '"1010"'
|
|
check 111 "cl-format-octal 15" '"17"'
|
|
check 112 "cl-format-hex 255" '"ff"'
|
|
check 113 "cl-format-decimal 42" '"42"'
|
|
check 114 "n->s base 16" '"1f"'
|
|
check 115 "s->n base 16" "31"
|
|
|
|
TOTAL=$((PASS+FAIL))
|
|
if [ $FAIL -eq 0 ]; then
|
|
echo "ok $PASS/$TOTAL lib/common-lisp tests passed"
|
|
else
|
|
echo "FAIL $PASS/$TOTAL passed, $FAIL failed:"
|
|
echo "$ERRORS"
|
|
fi
|
|
[ $FAIL -eq 0 ]
|