tcl: classic programs — for-each-line, assert, with-temp-var (+3 tests, 228 total)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
@@ -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-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-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)
|
(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
|
(dict
|
||||||
"passed"
|
"passed"
|
||||||
tcl-eval-pass
|
tcl-eval-pass
|
||||||
|
|||||||
13
lib/tcl/tests/programs/assert.tcl
Normal file
13
lib/tcl/tests/programs/assert.tcl
Normal file
@@ -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
|
||||||
13
lib/tcl/tests/programs/for-each-line.tcl
Normal file
13
lib/tcl/tests/programs/for-each-line.tcl
Normal file
@@ -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
|
||||||
13
lib/tcl/tests/programs/with-temp-var.tcl
Normal file
13
lib/tcl/tests/programs/with-temp-var.tcl
Normal file
@@ -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
|
||||||
Reference in New Issue
Block a user