cl: Phase 3 conditions + restarts — handler-bind, handler-case, restart-case, 55 tests (123 total runtime)
define-condition with 15-type ANSI hierarchy (condition/error/warning/
simple-error/simple-warning/type-error/arithmetic-error/division-by-zero/
cell-error/unbound-variable/undefined-function/program-error/storage-condition).
cl-condition-of-type? walks the hierarchy; cl-make-condition builds tagged
dicts {:cl-type "cl-condition" :class name :slots {...}}. cl-signal-obj
walks cl-handler-stack for non-unwinding dispatch. cl-handler-case and
cl-restart-case use call/cc escape continuations for unwinding. All stacks
are mutable SX globals (the built-in handler-bind/restart-case only accept
literal AST specs — not computed lists). Key fix: cl-condition-of-type?
captures cl-condition-classes at define-time via let-closure to avoid
free-variable failure through env_merge parent chain.
55 tests in lib/common-lisp/tests/conditions.sx, wired into test.sh.
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -292,6 +292,45 @@ 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
|
||||
|
||||
TOTAL=$((PASS+FAIL))
|
||||
if [ $FAIL -eq 0 ]; then
|
||||
echo "ok $PASS/$TOTAL lib/common-lisp tests passed"
|
||||
|
||||
Reference in New Issue
Block a user