diff --git a/lib/tcl/conformance.sh b/lib/tcl/conformance.sh new file mode 100755 index 00000000..50d0f8d0 --- /dev/null +++ b/lib/tcl/conformance.sh @@ -0,0 +1,145 @@ +#!/usr/bin/env bash +# Tcl-on-SX conformance runner — epoch protocol to sx_server.exe +# Usage: lib/tcl/conformance.sh [file.tcl ...] +# Defaults to lib/tcl/tests/programs/*.tcl +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"; exit 1; fi + +SCOREBOARD_JSON="${SCOREBOARD_JSON:-lib/tcl/scoreboard.json}" +SCOREBOARD_MD="${SCOREBOARD_MD:-lib/tcl/scoreboard.md}" + +# Collect tcl files +if [ "$#" -gt 0 ]; then + TCL_FILES=("$@") +else + TCL_FILES=(lib/tcl/tests/programs/*.tcl) +fi + +# Generate a helper .sx file that defines the Tcl source as an SX string variable. +# We escape the source for SX string literals: backslashes → \\, quotes → \", newlines → \n. +# This is safe in a (define ...) context — no double-parsing like (eval "...") would cause. +write_sx_helper() { + local tcl_file="$1" + local helper_file="$2" + python3 << PYEOF +src = open('${tcl_file}').read() +escaped = src.replace('\\\\', '\\\\\\\\').replace('"', '\\\\"').replace('\\n', '\\\\n') +with open('${helper_file}', 'w') as f: + f.write(f'(define __tcl-src "{escaped}")\\n') + f.write('(define __tcl-result (get (tcl-eval-string (make-default-tcl-interp) __tcl-src) :result))\\n') +PYEOF +} + +total=0 +passed=0 +failed=0 +programs_json="" +md_rows="" + +for tcl_file in "${TCL_FILES[@]}"; do + basename_noext=$(basename "$tcl_file" .tcl) + total=$((total + 1)) + + # Read expected value from first-line comment "# expected: VALUE" + expected=$(head -1 "$tcl_file" | sed -n 's/^# expected: *//p') + if [ -z "$expected" ]; then + echo "WARN: no '# expected:' annotation in $tcl_file — skipping" + continue + fi + + tmpfile=$(mktemp) + helper=$(mktemp --suffix=.sx) + trap "rm -f $tmpfile $helper" EXIT + + # Write helper .sx with Tcl source embedded as SX string + write_sx_helper "$tcl_file" "$helper" + + # Build epoch input using quoted heredoc for static parts; helper path via variable + cat > "$tmpfile" << EPOCHS +(epoch 1) +(load "lib/tcl/tokenizer.sx") +(epoch 2) +(load "lib/tcl/parser.sx") +(epoch 3) +(load "lib/tcl/runtime.sx") +(epoch 4) +(load "$helper") +(epoch 5) +(eval "__tcl-result") +(epoch 6) +EPOCHS + + output=$(timeout 30 "$SX_SERVER" < "$tmpfile" 2>&1) + got=$(echo "$output" | grep -A1 "^(ok-len 5 " | tail -1 | tr -d '"') + + if [ "$got" = "$expected" ]; then + status="PASS" + passed=$((passed + 1)) + echo "PASS $basename_noext (expected: $expected, got: $got)" + else + status="FAIL" + failed=$((failed + 1)) + echo "FAIL $basename_noext (expected: $expected, got: ${got:-})" + if [ -n "${VERBOSE:-}" ]; then + echo "--- server output ---" + echo "$output" + echo "--- helper.sx ---" + cat "$helper" + fi + fi + + # Accumulate JSON fragment (escape for JSON) + got_json=$(printf '%s' "$got" | python3 -c "import sys,json; sys.stdout.write(json.dumps(sys.stdin.read()))" | tr -d '"') + exp_json=$(printf '%s' "$expected" | python3 -c "import sys,json; sys.stdout.write(json.dumps(sys.stdin.read()))" | tr -d '"') + + if [ -n "$programs_json" ]; then + programs_json="${programs_json}," + fi + programs_json="${programs_json} + \"${basename_noext}\": {\"status\": \"${status}\", \"expected\": \"${exp_json}\", \"got\": \"${got_json}\"}" + + # Accumulate Markdown row + if [ "$status" = "PASS" ]; then + icon="✓ PASS" + else + icon="✗ FAIL" + fi + md_rows="${md_rows}| ${basename_noext} | ${icon} | ${expected} | ${got} | +" +done + +# Write scoreboard.json +cat > "$SCOREBOARD_JSON" << JSON +{ + "total": ${total}, + "passed": ${passed}, + "failed": ${failed}, + "programs": {${programs_json} + } +} +JSON + +# Write scoreboard.md +cat > "$SCOREBOARD_MD" << MD +# Tcl-on-SX Conformance Scoreboard + +| Program | Status | Expected | Got | +|---|---|---|---| +${md_rows} +**${passed}/${total} passing** +MD + +echo "" +echo "Scoreboard: ${passed}/${total} passing" +echo "Written: $SCOREBOARD_JSON, $SCOREBOARD_MD" + +if [ "$failed" -gt 0 ]; then + exit 1 +fi +exit 0 diff --git a/lib/tcl/scoreboard.json b/lib/tcl/scoreboard.json new file mode 100644 index 00000000..8d3dd95f --- /dev/null +++ b/lib/tcl/scoreboard.json @@ -0,0 +1,10 @@ +{ + "total": 3, + "passed": 3, + "failed": 0, + "programs": { + "assert": {"status": "PASS", "expected": "10", "got": "10"}, + "for-each-line": {"status": "PASS", "expected": "13", "got": "13"}, + "with-temp-var": {"status": "PASS", "expected": "100 999", "got": "100 999"} + } +} diff --git a/lib/tcl/scoreboard.md b/lib/tcl/scoreboard.md new file mode 100644 index 00000000..910b3a40 --- /dev/null +++ b/lib/tcl/scoreboard.md @@ -0,0 +1,9 @@ +# Tcl-on-SX Conformance Scoreboard + +| Program | Status | Expected | Got | +|---|---|---|---| +| assert | ✓ PASS | 10 | 10 | +| for-each-line | ✓ PASS | 13 | 13 | +| with-temp-var | ✓ PASS | 100 999 | 100 999 | + +**3/3 passing** diff --git a/lib/tcl/tests/programs/assert.tcl b/lib/tcl/tests/programs/assert.tcl index bfaa2ad3..5f745d90 100644 --- a/lib/tcl/tests/programs/assert.tcl +++ b/lib/tcl/tests/programs/assert.tcl @@ -1,3 +1,4 @@ +# expected: 10 proc assert {expr_str} { set result [uplevel 1 [list expr $expr_str]] if {!$result} { diff --git a/lib/tcl/tests/programs/for-each-line.tcl b/lib/tcl/tests/programs/for-each-line.tcl index 8e0295c5..0fd44d92 100644 --- a/lib/tcl/tests/programs/for-each-line.tcl +++ b/lib/tcl/tests/programs/for-each-line.tcl @@ -1,3 +1,4 @@ +# expected: 13 proc for-each-line {var lines body} { foreach item $lines { uplevel 1 [list set $var $item] diff --git a/lib/tcl/tests/programs/with-temp-var.tcl b/lib/tcl/tests/programs/with-temp-var.tcl index 5de7db84..cec3e792 100644 --- a/lib/tcl/tests/programs/with-temp-var.tcl +++ b/lib/tcl/tests/programs/with-temp-var.tcl @@ -1,3 +1,4 @@ +# expected: 100 999 proc with-temp-var {varname tempval body} { upvar 1 $varname v set saved $v diff --git a/plans/tcl-on-sx.md b/plans/tcl-on-sx.md index 47ac45d9..1c0ee1cc 100644 --- a/plans/tcl-on-sx.md +++ b/plans/tcl-on-sx.md @@ -83,11 +83,11 @@ Core mapping: - [x] `info level`, `info level N`, `info frame`, `info vars`, `info locals`, `info globals`, `info commands`, `info procs`, `info args`, `info body` - [x] `global var ?…?` — alias to global frame (sugar for `upvar #0 var var`) - [x] `variable name ?value?` — namespace-scoped global -- [ ] Classic programs in `lib/tcl/tests/programs/`: - - [ ] `for-each-line.tcl` — define your own loop construct using `uplevel` - - [ ] `assert.tcl` — assertion macro that reports caller's line - - [ ] `with-temp-var.tcl` — scoped variable rebind via `upvar` -- [ ] `lib/tcl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` +- [x] Classic programs in `lib/tcl/tests/programs/`: + - [x] `for-each-line.tcl` — define your own loop construct using `uplevel` + - [x] `assert.tcl` — assertion macro that reports caller's line + - [x] `with-temp-var.tcl` — scoped variable rebind via `upvar` +- [x] `lib/tcl/conformance.sh` + runner, `scoreboard.json` + `scoreboard.md` ### Phase 4 — control flow + error handling - [ ] `return -code (ok|error|return|break|continue|N) -errorinfo … -errorcode … -level N value`