giles
2981a479e8
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
lib/guest/reflective/class-chain.sx — class inheritance walker with
adapter cfg for single-parent (Smalltalk) and multi-parent (CLOS)
hierarchies. Three primitives:
- refl-class-chain-find-with CFG CN PROBE
DFS through parents, returns first non-nil probe result.
Smalltalk method lookup uses this.
- refl-class-chain-depth-with CFG CN ANCESTOR
Min hop distance via any parent path, or nil if unreachable.
CLOS method specificity uses this.
- refl-class-chain-ancestors-with CFG CN
Flat DFS-ordered list of all reachable ancestor names.
Adapter cfg has two keys: :parents-of (CN → list of parent names,
possibly empty) and :class? (predicate; short-circuits walk on
non-existent class names mid-chain).
Migrations:
- lib/smalltalk/runtime.sx: st-method-lookup-walk now a 9-line
thin probe through the kit (was 20 lines of inline recursion);
st-class-cfg wraps the single-parent :superclass field into a
1-element list for the cfg.
- lib/common-lisp/clos.sx: clos-specificity is a one-line wrapper
around refl-class-chain-depth-with (was 28 lines); clos-class-cfg
reads the multi-parent :parents field.
Both consumers green:
- Smalltalk: 847/847 (unchanged)
- CL: 222/240 (unchanged baseline; 18 pre-existing failures, all
in stdlib functions like cl-set-memberp, unrelated to CLOS).
This is the second extracted reflective kit (env.sx was first).
The adapter-cfg pattern continues to bridge structurally divergent
consumers (Smalltalk single-inheritance vs CLOS multiple-inheritance
with method-precedence distance) via a uniform :parents-of callback.
150 lines
4.0 KiB
Bash
Executable File
150 lines
4.0 KiB
Bash
Executable File
#!/usr/bin/env bash
|
|
# Fast Smalltalk-on-SX test runner — pipes directly to sx_server.exe.
|
|
# Mirrors lib/haskell/test.sh.
|
|
#
|
|
# Usage:
|
|
# bash lib/smalltalk/test.sh # run all tests
|
|
# bash lib/smalltalk/test.sh -v # verbose
|
|
# bash lib/smalltalk/test.sh tests/tokenize.sx # run one file
|
|
|
|
set -uo pipefail
|
|
cd "$(git rev-parse --show-toplevel)"
|
|
|
|
SX_SERVER="hosts/ocaml/_build/default/bin/sx_server.exe"
|
|
if [ ! -x "$SX_SERVER" ]; then
|
|
MAIN_ROOT=$(git worktree list | head -1 | awk '{print $1}')
|
|
if [ -x "$MAIN_ROOT/$SX_SERVER" ]; then
|
|
SX_SERVER="$MAIN_ROOT/$SX_SERVER"
|
|
else
|
|
echo "ERROR: sx_server.exe not found. Run: cd hosts/ocaml && dune build"
|
|
exit 1
|
|
fi
|
|
fi
|
|
|
|
VERBOSE=""
|
|
FILES=()
|
|
for arg in "$@"; do
|
|
case "$arg" in
|
|
-v|--verbose) VERBOSE=1 ;;
|
|
*) FILES+=("$arg") ;;
|
|
esac
|
|
done
|
|
|
|
if [ ${#FILES[@]} -eq 0 ]; then
|
|
# tokenize.sx must load first — it defines the st-test helpers reused by
|
|
# subsequent test files. Sort enforces this lexicographically.
|
|
mapfile -t FILES < <(find lib/smalltalk/tests -maxdepth 2 -name '*.sx' | sort)
|
|
fi
|
|
|
|
TOTAL_PASS=0
|
|
TOTAL_FAIL=0
|
|
FAILED_FILES=()
|
|
|
|
for FILE in "${FILES[@]}"; do
|
|
[ -f "$FILE" ] || { echo "skip $FILE (not found)"; continue; }
|
|
TMPFILE=$(mktemp)
|
|
if [ "$(basename "$FILE")" = "tokenize.sx" ]; then
|
|
cat > "$TMPFILE" <<EPOCHS
|
|
(epoch 1)
|
|
(load "lib/smalltalk/tokenizer.sx")
|
|
(epoch 2)
|
|
(load "$FILE")
|
|
(epoch 3)
|
|
(eval "(list st-test-pass st-test-fail)")
|
|
EPOCHS
|
|
else
|
|
cat > "$TMPFILE" <<EPOCHS
|
|
(epoch 1)
|
|
(load "lib/smalltalk/tokenizer.sx")
|
|
(epoch 2)
|
|
(load "lib/smalltalk/parser.sx")
|
|
(epoch 3)
|
|
(load "lib/guest/reflective/class-chain.sx")
|
|
(load "lib/smalltalk/runtime.sx")
|
|
(epoch 4)
|
|
(load "lib/guest/reflective/env.sx")
|
|
(load "lib/smalltalk/eval.sx")
|
|
(epoch 5)
|
|
(load "lib/smalltalk/sunit.sx")
|
|
(epoch 6)
|
|
(load "lib/smalltalk/tests/tokenize.sx")
|
|
(epoch 7)
|
|
(load "$FILE")
|
|
(epoch 8)
|
|
(eval "(list st-test-pass st-test-fail)")
|
|
EPOCHS
|
|
fi
|
|
|
|
OUTPUT=$(timeout 180 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
|
|
rm -f "$TMPFILE"
|
|
|
|
# Final epoch's value: either (ok N (P F)) on one line or
|
|
# (ok-len N M)\n(P F) where the value is on the following line.
|
|
LINE=$(echo "$OUTPUT" | awk '/^\(ok-len [0-9]+ / {getline; print}' | tail -1)
|
|
if [ -z "$LINE" ]; then
|
|
LINE=$(echo "$OUTPUT" | grep -E '^\(ok [0-9]+ \([0-9]+ [0-9]+\)\)' | tail -1 \
|
|
| sed -E 's/^\(ok [0-9]+ //; s/\)$//')
|
|
fi
|
|
if [ -z "$LINE" ]; then
|
|
echo "X $FILE: could not extract summary"
|
|
echo "$OUTPUT" | tail -30
|
|
TOTAL_FAIL=$((TOTAL_FAIL + 1))
|
|
FAILED_FILES+=("$FILE")
|
|
continue
|
|
fi
|
|
P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
|
|
F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
|
|
TOTAL_PASS=$((TOTAL_PASS + P))
|
|
TOTAL_FAIL=$((TOTAL_FAIL + F))
|
|
if [ "$F" -gt 0 ]; then
|
|
FAILED_FILES+=("$FILE")
|
|
printf 'X %-40s %d/%d\n' "$FILE" "$P" "$((P+F))"
|
|
TMPFILE2=$(mktemp)
|
|
if [ "$(basename "$FILE")" = "tokenize.sx" ]; then
|
|
cat > "$TMPFILE2" <<EPOCHS
|
|
(epoch 1)
|
|
(load "lib/smalltalk/tokenizer.sx")
|
|
(epoch 2)
|
|
(load "$FILE")
|
|
(epoch 3)
|
|
(eval "(map (fn (f) (get f :name)) st-test-fails)")
|
|
EPOCHS
|
|
else
|
|
cat > "$TMPFILE2" <<EPOCHS
|
|
(epoch 1)
|
|
(load "lib/smalltalk/tokenizer.sx")
|
|
(epoch 2)
|
|
(load "lib/smalltalk/parser.sx")
|
|
(epoch 3)
|
|
(load "lib/guest/reflective/class-chain.sx")
|
|
(load "lib/smalltalk/runtime.sx")
|
|
(epoch 4)
|
|
(load "lib/guest/reflective/env.sx")
|
|
(load "lib/smalltalk/eval.sx")
|
|
(epoch 5)
|
|
(load "lib/smalltalk/sunit.sx")
|
|
(epoch 6)
|
|
(load "lib/smalltalk/tests/tokenize.sx")
|
|
(epoch 7)
|
|
(load "$FILE")
|
|
(epoch 8)
|
|
(eval "(map (fn (f) (get f :name)) st-test-fails)")
|
|
EPOCHS
|
|
fi
|
|
FAILS=$(timeout 180 "$SX_SERVER" < "$TMPFILE2" 2>&1 | grep -E '^\(ok [0-9]+ \(' | tail -1 || true)
|
|
rm -f "$TMPFILE2"
|
|
echo " $FAILS"
|
|
elif [ "$VERBOSE" = "1" ]; then
|
|
printf 'OK %-40s %d passed\n' "$FILE" "$P"
|
|
fi
|
|
done
|
|
|
|
TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
|
|
if [ $TOTAL_FAIL -eq 0 ]; then
|
|
echo "OK $TOTAL_PASS/$TOTAL smalltalk-on-sx tests passed"
|
|
else
|
|
echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed in: ${FAILED_FILES[*]}"
|
|
fi
|
|
|
|
[ $TOTAL_FAIL -eq 0 ]
|