diff --git a/lib/tcl/tests/eval.sx b/lib/tcl/tests/eval.sx index 88db3ea3..5352646c 100644 --- a/lib/tcl/tests/eval.sx +++ b/lib/tcl/tests/eval.sx @@ -310,6 +310,25 @@ (ok "info-procs" (let ((r (get (run "proc myfn {} {}\ninfo procs") :result))) (contains? (tcl-list-split r) "myfn")) true) (ok "info-args" (get (run "proc add {a b} {expr {$a+$b}}\ninfo args add") :result) "a b") (ok "info-commands-has-set" (let ((r (get (run "info commands") :result))) (contains? (tcl-list-split r) "set")) true) + ; --- classic programs --- + (ok + "classic-for-each-line" + (get + (run "proc for-each-line {var lines body} {\n foreach item $lines {\n uplevel 1 [list set $var $item]\n uplevel 1 $body\n }\n}\nset total 0\nfor-each-line line {hello world foo} {\n incr total [string length $line]\n}\nset total") + :result) + "13") + (ok + "classic-assert" + (get + (run "proc assert {expr_str} {\n set result [uplevel 1 [list expr $expr_str]]\n if {!$result} {\n error \"Assertion failed: $expr_str\"\n }\n}\nset x 42\nassert {$x == 42}\nassert {$x > 0}\nset x 10\nassert {$x < 100}\nset x") + :result) + "10") + (ok + "classic-with-temp-var" + (get + (run "proc with-temp-var {varname tempval body} {\n upvar 1 $varname v\n set saved $v\n set v $tempval\n uplevel 1 $body\n set v $saved\n}\nset x 100\nwith-temp-var x 999 {\n set captured $x\n}\nlist $x $captured") + :result) + "100 999") (dict "passed" tcl-eval-pass diff --git a/lib/tcl/tests/programs/assert.tcl b/lib/tcl/tests/programs/assert.tcl new file mode 100644 index 00000000..bfaa2ad3 --- /dev/null +++ b/lib/tcl/tests/programs/assert.tcl @@ -0,0 +1,13 @@ +proc assert {expr_str} { + set result [uplevel 1 [list expr $expr_str]] + if {!$result} { + error "Assertion failed: $expr_str" + } +} + +set x 42 +assert {$x == 42} +assert {$x > 0} +set x 10 +assert {$x < 100} +set x diff --git a/lib/tcl/tests/programs/for-each-line.tcl b/lib/tcl/tests/programs/for-each-line.tcl new file mode 100644 index 00000000..8e0295c5 --- /dev/null +++ b/lib/tcl/tests/programs/for-each-line.tcl @@ -0,0 +1,13 @@ +proc for-each-line {var lines body} { + foreach item $lines { + uplevel 1 [list set $var $item] + uplevel 1 $body + } +} + +# Usage: accumulate lengths of each "line" +set total 0 +for-each-line line {hello world foo} { + incr total [string length $line] +} +set total diff --git a/lib/tcl/tests/programs/with-temp-var.tcl b/lib/tcl/tests/programs/with-temp-var.tcl new file mode 100644 index 00000000..5de7db84 --- /dev/null +++ b/lib/tcl/tests/programs/with-temp-var.tcl @@ -0,0 +1,13 @@ +proc with-temp-var {varname tempval body} { + upvar 1 $varname v + set saved $v + set v $tempval + uplevel 1 $body + set v $saved +} + +set x 100 +with-temp-var x 999 { + set captured $x +} +list $x $captured