diff options
author | Steve Bennett <steveb@workware.net.au> | 2010-03-03 16:00:33 +1000 |
---|---|---|
committer | Steve Bennett <steveb@workware.net.au> | 2010-10-15 11:02:48 +1000 |
commit | b83beb2febcbe0abcf338e3f915b43889ce93eca (patch) | |
tree | 8baa5d1ff957f3209ac40a3d89d5fa5644796398 /tests/alias.test | |
parent | 80ddfb1fe799cde11aa65fcea5935686aacb4ca4 (diff) | |
download | jimtcl-b83beb2febcbe0abcf338e3f915b43889ce93eca.zip jimtcl-b83beb2febcbe0abcf338e3f915b43889ce93eca.tar.gz jimtcl-b83beb2febcbe0abcf338e3f915b43889ce93eca.tar.bz2 |
Move some core procs into the (Tcl) stdlib extension
Also implement 'local' to declare/delete local procs
* Add tests/alias.test for testing alias, current, local
* proc now returns the name of the proc created
* Add helper 'function' to stdlib
Reimplement glob and case to use local procs
* This keeps these internal procs out of the global namespace
Signed-off-by: Steve Bennett <steveb@workware.net.au>
Diffstat (limited to 'tests/alias.test')
-rw-r--r-- | tests/alias.test | 123 |
1 files changed, 123 insertions, 0 deletions
diff --git a/tests/alias.test b/tests/alias.test new file mode 100644 index 0000000..94aa4f1 --- /dev/null +++ b/tests/alias.test @@ -0,0 +1,123 @@ +source testing.tcl + +test alias-1.1 "One word alias" { + set x 2 + alias newincr incr + newincr x +} {3} + +test alias-1.4 "Two word alias" { + alias infoexists info exists + infoexists x +} {1} + +test alias-1.5 "Replace alias" { + alias newincr infoexists + newincr x +} {1} + +test alias-1.6 "Delete alias" { + rename newincr "" + catch {newincr x} +} {1} + +test alias-1.7 "Replace alias with proc" { + proc infoexists {n} { + return yes + } + infoexists any +} {yes} + +test alias-1.8 "Replace proc with alias" { + alias infoexists info exists + infoexists any +} {0} + +test curry-1.1 "One word curry" { + set x 2 + set one [curry incr] + $one x +} {3} + +test curry-1.4 "Two word curry" { + set two [curry info exists] + list [$two x] [$two y] +} {1 0} + +test curry-1.5 "Delete curry" { + unset one two + collect +} {2} + +test local-1.1 "local lambda in eval" { + set x 1 + eval { + local set a [lambda {b} { incr b }] + set x [$a $x] + } + list [info procs $a] $x +} {{} 2} + +test local-1.2 "local curry in proc" { + proc a {} { + local set p [curry info exists] + set x 1 + list $p [$p x] [$p y] + } + lassign [a] p exists_x exists_y + list [info procs $p] $exists_x $exists_y +} {{} 1 0} + +test local-1.2 "set local curry in proc" { + proc a {} { + set p [local curry info exists] + set x 1 + list $p [$p x] [$p y] + } + lassign [a] p exists_x exists_y + list [info procs $p] $exists_x $exists_y +} {{} 1 0} + +test local-1.3 "local alias in proc" { + proc a {} { + local alias p info exists + set x 1 + list [p x] [p y] + } + lassign [a] exists_x exists_y + list [info procs p] $exists_x $exists_y +} {{} 1 0} + +test local-1.5 "local proc in proc" { + set ::x 1 + proc a {} { + local proc b {} { incr ::x } + b + set ::x + } + a + list [info procs b] $::x +} {{} 2} + +test local-1.6 "local lambda in lsort" { + lsort -command [local lambda {a b} {string compare $a $b}] {d a f g} +} {a d f g} + +test local-1.7 "check no reference procs" { + info procs "<reference*" +} {} + +test local-1.8 "local on non-proc" { + list [catch {local set x blah} msg] $msg +} {1 {not a proc: "blah"}} + +test local-1.9 "local on existing proc" { + eval { + proc a {b} {incr b} + local function a + set c [lambda b {incr b -1}] + local function $c + lappend result [a 1] [$c 2] + } + list [info procs a] $result +} {{} {2 1}} |