coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

tcl: Phase 2 core commands — if/while/for/foreach/switch/break/continue/return/error/expr (+20 tests, 107 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 16s
Details

Browse Source 
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-26 14:40:48 +00:00
parent 82da16e4bb
commit c8d7fdd59a
3 changed files with 467 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

108
lib/tcl/tests/eval.sx
View File

@@ -25,6 +25,12 @@
(set! tcl-eval-failures (list))
(define interp (fn () (make-default-tcl-interp)))
(define run (fn (src) (tcl-eval-string (interp) src)))
(define
ok
(fn (label actual expected) (tcl-eval-assert label expected actual)))
(define
ok?
(fn (label condition) (tcl-eval-assert label true condition)))
(tcl-eval-assert "set-result" "hello" (get (run "set x hello") :result))
(tcl-eval-assert
"set-stored"
@@ -61,20 +67,20 @@
(tcl-var-get (run "append x hello") "x"))
(tcl-eval-assert
"cmdsub-result"
"42"
(get (run "set y [set x 42]") :result))
"6"
(get (run "set x 5\nset y [incr x]") :result))
(tcl-eval-assert
"cmdsub-y"
"42"
(tcl-var-get (run "set y [set x 42]") "y"))
"6"
(tcl-var-get (run "set x 5\nset y [incr x]") "y"))
(tcl-eval-assert
"cmdsub-x"
"42"
(tcl-var-get (run "set y [set x 42]") "x"))
"6"
(tcl-var-get (run "set x 5\nset y [incr x]") "x"))
(tcl-eval-assert
"multi-cmd"
"4"
(tcl-var-get (run "set x 1\nincr x\nincr x\nincr x") "x"))
"second"
(get (run "set x first\nset x second") :result))
(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
@@ -93,6 +99,92 @@
"puts-channel"
"hello\n"
(get (run "puts stdout hello") :output))
(ok "if-true" (get (run "set x 0\nif {1} {set x 1}") :result) "1")
(ok "if-false" (get (run "set x 0\nif {0} {set x 1}") :result) "0")
(ok
"if-else-t"
(tcl-var-get (run "if {1} {set x yes} else {set x no}") "x")
"yes")
(ok
"if-else-f"
(tcl-var-get (run "if {0} {set x yes} else {set x no}") "x")
"no")
(ok
"if-cmp"
(tcl-var-get
(run "set x 5\nif {$x > 3} {set r big} else {set r small}")
"r")
"big")
(ok
"while"
(tcl-var-get
(run "set i 0\nset s 0\nwhile {$i < 5} {incr i\nincr s $i}")
"s")
"15")
(ok
"while-break"
(tcl-var-get
(run "set i 0\nwhile {1} {incr i\nif {$i == 3} {break}}")
"i")
"3")
(ok
"for"
(tcl-var-get
(run "set s 0\nfor {set i 1} {$i <= 5} {incr i} {incr s $i}")
"s")
"15")
(ok
"foreach"
(tcl-var-get (run "set s 0\nforeach x {1 2 3 4 5} {incr s $x}") "s")
"15")
(ok
"foreach-list"
(get (run "set acc \"\"\nforeach w {hello world} {append acc $w}") :result)
"helloworld")
(ok
"lappend"
(tcl-var-get (run "lappend lst a\nlappend lst b\nlappend lst c") "lst")
"a b c")
(ok?
"unset-gone"
(let
((i (run "set x 42\nunset x")))
(let
((frame (get i :frame)))
(nil? (get (get frame :locals) "x")))))
(ok "eval" (tcl-var-get (run "eval {set x hello}") "x") "hello")
(ok "expr-add" (get (run "expr {3 + 4}") :result) "7")
(ok "expr-cmp" (get (run "expr {5 > 3}") :result) "1")
(ok
"break-stops"
(tcl-var-get (run "set x 0\nwhile {1} {set x 1\nbreak\nset x 99}") "x")
"1")
(ok
"continue"
(tcl-var-get
(run
"set s 0\nfor {set i 1} {$i <= 5} {incr i} {if {$i == 3} {continue}\nincr s $i}")
"s")
"12")
(ok
"switch"
(tcl-var-get
(run "set x foo\nswitch $x {{foo} {set r yes} {bar} {set r no}}")
"r")
"yes")
(ok
"switch-default"
(tcl-var-get
(run "set x baz\nswitch $x {{foo} {set r yes} default {set r other}}")
"r")
"other")
(ok
"nested-if"
(tcl-var-get
(run
"set x 5\nif {$x > 10} {set r big} elseif {$x > 3} {set r mid} else {set r small}")
"r")
"mid")
(dict
"passed"
tcl-eval-pass