coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
0e426cfea813843d799a2cdee7aaa0169f13e536
rose-ash/lib/common-lisp/test.sh
giles 0e426cfea8 cl: Phase 4 CLOS complete — generic functions, multi-dispatch, method qualifiers, 437/437 tests 
- lib/common-lisp/clos.sx (27 forms): class registry (8 built-in classes),
  defclass/make-instance/slot-value/slot-boundp/change-class, defgeneric/defmethod
  with :before/:after/:around, clos-call-generic (standard combination: sort by
  specificity, fire befores, call primary chain, fire afters reversed),
  call-next-method/next-method-p, with-slots, deferred accessor installation
- lib/common-lisp/tests/clos.sx: 41 tests (class-of, subclass-of?, defclass,
  make-instance, slot ops, inheritance, method specificity, qualifiers, accessors,
  with-slots, change-class)
- lib/common-lisp/tests/programs/geometry.sx: 12 tests — intersect generic
  dispatching on geo-point×geo-point, geo-point×geo-line, geo-line×geo-line,
  geo-line×geo-plane (multi-dispatch by class precedence)
- lib/common-lisp/tests/programs/mop-trace.sx: 13 tests — :before/:after
  tracing on area and describe-shape generics, call-next-method in circle/rect
- eval.sx: dynamic variables — cl-apply-dyn saves/restores global slot for
  specials; cl-mark-special!/cl-special?/cl-dyn-unbound; defvar now marks
  specials; let/let* rebind via cl-apply-dyn; 8 new tests (182 eval total)
- conformance.sh + test.sh: Phase 4 suites wired in
- plans/common-lisp-on-sx.md: Phase 4 + dynamic variable boxes ticked

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-05-05 11:38:37 +00:00

427 lines
14 KiB
Bash
Executable File
Raw Blame History

#!/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"
# ── Phase 2: condition system unit tests ─────────────────────────────────────
# Load runtime.sx then conditions.sx; query the passed/failed/failures globals.
UNIT_FILE=$(mktemp); trap "rm -f $UNIT_FILE" EXIT
cat > "$UNIT_FILE" << 'UNIT'
(epoch 1)
(load "spec/stdlib.sx")
(epoch 2)
(load "lib/common-lisp/runtime.sx")
(epoch 3)
(load "lib/common-lisp/tests/conditions.sx")
(epoch 4)
(eval "passed")
(epoch 5)
(eval "failed")
(epoch 6)
(eval "failures")
UNIT
UNIT_OUT=$(timeout 30 "$SX_SERVER" < "$UNIT_FILE" 2>/dev/null)
# extract passed/failed counts from ok-len lines
UNIT_PASSED=$(echo "$UNIT_OUT" | grep -A1 "^(ok-len 4 " | tail -1 || true)
UNIT_FAILED=$(echo "$UNIT_OUT" | grep -A1 "^(ok-len 5 " | tail -1 || true)
UNIT_ERRS=$(echo "$UNIT_OUT" | grep -A1 "^(ok-len 6 " | tail -1 || true)
# fallback: try plain ok lines
[ -z "$UNIT_PASSED" ] && UNIT_PASSED=$(echo "$UNIT_OUT" | grep "^(ok 4 " | awk '{print $3}' | tr -d ')' || true)
[ -z "$UNIT_FAILED" ] && UNIT_FAILED=$(echo "$UNIT_OUT" | grep "^(ok 5 " | awk '{print $3}' | tr -d ')' || true)
[ -z "$UNIT_PASSED" ] && UNIT_PASSED=0
[ -z "$UNIT_FAILED" ] && UNIT_FAILED=0
if [ "$UNIT_FAILED" = "0" ] && [ "$UNIT_PASSED" -gt 0 ] 2>/dev/null; then
PASS=$((PASS + UNIT_PASSED))
[ "$VERBOSE" = "-v" ] && echo " ok condition tests ($UNIT_PASSED)"
else
FAIL=$((FAIL + 1))
ERRORS+=" FAIL [condition tests] (${UNIT_PASSED} passed, ${UNIT_FAILED} failed) ${UNIT_ERRS}
"
fi
# ── Phase 3: classic program tests ───────────────────────────────────────────
run_program_suite() {
local prog="$1" pass_var="$2" fail_var="$3" failures_var="$4"
local PROG_FILE=$(mktemp)
printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "%s")\n(epoch 4)\n(eval "%s")\n(epoch 5)\n(eval "%s")\n(epoch 6)\n(eval "%s")\n' \
"$prog" "$pass_var" "$fail_var" "$failures_var" > "$PROG_FILE"
local OUT; OUT=$(timeout 20 "$SX_SERVER" < "$PROG_FILE" 2>/dev/null)
rm -f "$PROG_FILE"
local P F
P=$(echo "$OUT" | grep -A1 "^(ok-len 4 " | tail -1 || true)
F=$(echo "$OUT" | grep -A1 "^(ok-len 5 " | tail -1 || true)
local ERRS; ERRS=$(echo "$OUT" | grep -A1 "^(ok-len 6 " | tail -1 || true)
[ -z "$P" ] && P=0; [ -z "$F" ] && F=0
if [ "$F" = "0" ] && [ "$P" -gt 0 ] 2>/dev/null; then
PASS=$((PASS + P))
[ "$VERBOSE" = "-v" ] && echo " ok $prog ($P)"
else
FAIL=$((FAIL + 1))
ERRORS+=" FAIL [$prog] (${P} passed, ${F} failed) ${ERRS}
"
fi
}
run_program_suite \
"lib/common-lisp/tests/programs/restart-demo.sx" \
"demo-passed" "demo-failed" "demo-failures"
run_program_suite \
"lib/common-lisp/tests/programs/parse-recover.sx" \
"parse-passed" "parse-failed" "parse-failures"
run_program_suite \
"lib/common-lisp/tests/programs/interactive-debugger.sx" \
"debugger-passed" "debugger-failed" "debugger-failures"
# ── Phase 4: CLOS unit tests ─────────────────────────────────────────────────
CLOS_FILE=$(mktemp); trap "rm -f $CLOS_FILE" EXIT
printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "lib/common-lisp/clos.sx")\n(epoch 4)\n(load "lib/common-lisp/tests/clos.sx")\n(epoch 5)\n(eval "passed")\n(epoch 6)\n(eval "failed")\n(epoch 7)\n(eval "failures")\n' > "$CLOS_FILE"
CLOS_OUT=$(timeout 30 "$SX_SERVER" < "$CLOS_FILE" 2>/dev/null)
rm -f "$CLOS_FILE"
CLOS_PASSED=$(echo "$CLOS_OUT" | grep -A1 "^(ok-len 5 " | tail -1 || true)
CLOS_FAILED=$(echo "$CLOS_OUT" | grep -A1 "^(ok-len 6 " | tail -1 || true)
[ -z "$CLOS_PASSED" ] && CLOS_PASSED=$(echo "$CLOS_OUT" | grep "^(ok 5 " | awk '{print $3}' | tr -d ')' || true)
[ -z "$CLOS_FAILED" ] && CLOS_FAILED=$(echo "$CLOS_OUT" | grep "^(ok 6 " | awk '{print $3}' | tr -d ')' || true)
[ -z "$CLOS_PASSED" ] && CLOS_PASSED=0; [ -z "$CLOS_FAILED" ] && CLOS_FAILED=0
if [ "$CLOS_FAILED" = "0" ] && [ "$CLOS_PASSED" -gt 0 ] 2>/dev/null; then
PASS=$((PASS + CLOS_PASSED))
[ "$VERBOSE" = "-v" ] && echo " ok CLOS unit tests ($CLOS_PASSED)"
else
FAIL=$((FAIL + 1))
ERRORS+=" FAIL [CLOS unit tests] (${CLOS_PASSED} passed, ${CLOS_FAILED} failed)
"
fi
# ── Phase 4: CLOS classic programs ───────────────────────────────────────────
run_clos_suite() {
local prog="$1" pass_var="$2" fail_var="$3" failures_var="$4"
local PROG_FILE=$(mktemp)
printf '(epoch 1)\n(load "spec/stdlib.sx")\n(epoch 2)\n(load "lib/common-lisp/runtime.sx")\n(epoch 3)\n(load "lib/common-lisp/clos.sx")\n(epoch 4)\n(load "%s")\n(epoch 5)\n(eval "%s")\n(epoch 6)\n(eval "%s")\n(epoch 7)\n(eval "%s")\n' \
"$prog" "$pass_var" "$fail_var" "$failures_var" > "$PROG_FILE"
local OUT; OUT=$(timeout 20 "$SX_SERVER" < "$PROG_FILE" 2>/dev/null)
rm -f "$PROG_FILE"
local P F
P=$(echo "$OUT" | grep -A1 "^(ok-len 5 " | tail -1 || true)
F=$(echo "$OUT" | grep -A1 "^(ok-len 6 " | tail -1 || true)
local ERRS; ERRS=$(echo "$OUT" | grep -A1 "^(ok-len 7 " | tail -1 || true)
[ -z "$P" ] && P=0; [ -z "$F" ] && F=0
if [ "$F" = "0" ] && [ "$P" -gt 0 ] 2>/dev/null; then
PASS=$((PASS + P))
[ "$VERBOSE" = "-v" ] && echo " ok $prog ($P)"
else
FAIL=$((FAIL + 1))
ERRORS+=" FAIL [$prog] (${P} passed, ${F} failed) ${ERRS}
"
fi
}
run_clos_suite \
"lib/common-lisp/tests/programs/geometry.sx" \
"geo-passed" "geo-failed" "geo-failures"
run_clos_suite \
"lib/common-lisp/tests/programs/mop-trace.sx" \
"mop-passed" "mop-failed" "mop-failures"
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 ]
Reference in New Issue View Git Blame Copy Permalink