tcl: Phase 2 eval engine — tcl-eval-script + set/puts/incr/append (+20 tests, 87 total)

Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
2026-04-26 14:02:52 +00:00
parent 35aa998fcc
commit 82da16e4bb
4 changed files with 360 additions and 20 deletions
--- a/lib/tcl/tests/eval.sx
+++ b/lib/tcl/tests/eval.sx
@@ -0,0 +1,102 @@
+; Tcl-on-SX eval tests
+(define tcl-eval-pass 0)
+(define tcl-eval-fail 0)
+(define tcl-eval-failures (list))
+
+(define
+  tcl-eval-assert
+  (fn
+    (label expected actual)
+    (if
+      (equal? expected actual)
+      (set! tcl-eval-pass (+ tcl-eval-pass 1))
+      (begin
+        (set! tcl-eval-fail (+ tcl-eval-fail 1))
+        (append!
+          tcl-eval-failures
+          (str label ": expected=" (str expected) " got=" (str actual)))))))
+
+(define
+  tcl-run-eval-tests
+  (fn
+    ()
+    (set! tcl-eval-pass 0)
+    (set! tcl-eval-fail 0)
+    (set! tcl-eval-failures (list))
+    (define interp (fn () (make-default-tcl-interp)))
+    (define run (fn (src) (tcl-eval-string (interp) src)))
+    (tcl-eval-assert "set-result" "hello" (get (run "set x hello") :result))
+    (tcl-eval-assert
+      "set-stored"
+      "hello"
+      (tcl-var-get (run "set x hello") "x"))
+    (tcl-eval-assert
+      "var-sub"
+      "hello"
+      (tcl-var-get (run "set x hello\nset y $x") "y"))
+    (tcl-eval-assert
+      "puts"
+      "world\n"
+      (get (run "set x world\nputs $x") :output))
+    (tcl-eval-assert
+      "puts-nonewline"
+      "hi"
+      (get (run "puts -nonewline hi") :output))
+    (tcl-eval-assert "incr" "6" (tcl-var-get (run "set x 5\nincr x") "x"))
+    (tcl-eval-assert
+      "incr-delta"
+      "8"
+      (tcl-var-get (run "set x 5\nincr x 3") "x"))
+    (tcl-eval-assert
+      "incr-neg"
+      "7"
+      (tcl-var-get (run "set x 10\nincr x -3") "x"))
+    (tcl-eval-assert
+      "append"
+      "foobar"
+      (tcl-var-get (run "set x foo\nappend x bar") "x"))
+    (tcl-eval-assert
+      "append-new"
+      "hello"
+      (tcl-var-get (run "append x hello") "x"))
+    (tcl-eval-assert
+      "cmdsub-result"
+      "42"
+      (get (run "set y [set x 42]") :result))
+    (tcl-eval-assert
+      "cmdsub-y"
+      "42"
+      (tcl-var-get (run "set y [set x 42]") "y"))
+    (tcl-eval-assert
+      "cmdsub-x"
+      "42"
+      (tcl-var-get (run "set y [set x 42]") "x"))
+    (tcl-eval-assert
+      "multi-cmd"
+      "4"
+      (tcl-var-get (run "set x 1\nincr x\nincr x\nincr x") "x"))
+    (tcl-eval-assert "semi-x" "1" (tcl-var-get (run "set x 1; set y 2") "x"))
+    (tcl-eval-assert "semi-y" "2" (tcl-var-get (run "set x 1; set y 2") "y"))
+    (tcl-eval-assert
+      "braced-nosub"
+      "$x"
+      (tcl-var-get (run "set x 42\nset y {$x}") "y"))
+    (tcl-eval-assert
+      "concat-word"
+      "foobar"
+      (tcl-var-get (run "set x foo\nset y ${x}bar") "y"))
+    (tcl-eval-assert
+      "set-get"
+      "world"
+      (get (run "set x world\nset x") :result))
+    (tcl-eval-assert
+      "puts-channel"
+      "hello\n"
+      (get (run "puts stdout hello") :output))
+    (dict
+      "passed"
+      tcl-eval-pass
+      "failed"
+      tcl-eval-fail
+      "failures"
+      tcl-eval-failures)))