1 source [file dirname [info script]]/testing.tcl
7 test alias-1.1 "One word alias" {
13 test alias-1.4 "Two word alias" {
14 alias infoexists info exists
18 test alias-1.5 "Replace alias" {
19 alias newincr infoexists
23 test alias-1.6 "Delete alias" {
28 test alias-1.7 "Replace alias with proc" {
35 test alias-1.8 "Replace proc with alias" {
36 alias infoexists info exists
40 test alias-1.9 "error message from alias" -body {
41 alias newstring string
43 } -returnCodes error -result {wrong # args: should be "string match ?-nocase? pattern string"}
45 test alias-1.10 "info alias" {
50 test alias-1.10 "info alias on non-alias" -body {
52 } -returnCodes error -result {command "format" is not an alias}
54 test curry-1.1 "One word curry" {
60 test curry-1.4 "Two word curry" {
61 set two [curry info exists]
62 list [$two x] [$two y]
65 test curry-1.5 "Delete curry" {
70 test local-1.2 "local curry in proc" {
72 local set p [curry info exists]
76 lassign [a] p exists_x exists_y
77 list [info procs $p] $exists_x $exists_y
80 test local-1.2 "set local curry in proc" {
82 set p [local curry info exists]
86 lassign [a] p exists_x exists_y
87 list [info procs $p] $exists_x $exists_y
90 test local-1.3 "local alias in proc" {
92 local alias p info exists
96 lassign [a] exists_x exists_y
97 list [info commands p] $exists_x $exists_y
100 test local-1.5 "local proc in proc" {
103 local proc b {} { incr ::x }
108 list [info procs b] $::x
111 test local-1.6 "local lambda in lsort" {
113 lsort -command [local lambda {a b} {string compare $a $b}] {d a f g}
118 test local-1.7 "check no reference procs" {
119 info procs "<reference*"
122 test local-1.8 "local on non-existent command" {
123 list [catch {local set x blah} msg] $msg
124 } {1 {invalid command name "blah"}}
126 test local-1.9 "local on existing proc" {
130 set c [lambda b {incr b -1}]
132 lappend result [a 1] [$c 2]
135 list [info procs a] $result
138 test statics-1.1 "missing static variable init" {
142 # No initialiser for c
147 test statics-1.2 "static variable with invalid name" {
149 proc a {b} "{c\0d 4}" {
154 test statics-1.3 "duplicate static variable" {
156 proc a {b} {{c 1} {c 2}} {
161 test statics-1.4 "bad static variable init" {
163 proc a {b} {{c 1 2}} {
168 test local-2.1 "proc over existing proc" {
171 proc a {b} {incr b -1}
180 test local-2.2 "local proc over existing proc" {
183 local proc a {b} {incr b -1}
192 test local-2.3 "local proc over existing proc" {
195 local proc a {b} {incr b -1}
204 test upcall-1.1 "upcall pushed proc" {
208 # invoke the original defn via upcall
211 # Should call the new defn which will call the original defn
215 test upcall-1.2 "upcall in proc" {
230 test upcall-1.3 "double upcall" {
232 local proc a {} {list 2 {*}[upcall a]}
233 local proc a {} {list 3 {*}[upcall a]}
237 test upcall-1.4 "upcall errors" {
239 list [catch {upcall a} msg] $msg
240 } {1 {no previous command: "a"}}
242 test upcall-1.4 "upcall errors" {
244 list [catch a msg] $msg
245 } {1 {no previous command: "a"}}