diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/trace.test | 242 |
1 files changed, 121 insertions, 121 deletions
diff --git a/tests/trace.test b/tests/trace.test index 102850a..b6d75c2 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.10 2001/08/10 13:10:13 msofer Exp $ +# RCS: @(#) $Id: trace.test,v 1.11 2001/08/13 12:40:15 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -344,7 +344,7 @@ test trace-5.8 {array traces fire for undefined variables} { # Trace multiple trace types at once. -test trace-5.1 {multiple ops traced at once} { +test trace-6.1 {multiple ops traced at once} { catch {unset x} set info {} trace add variable x {read write unset} traceProc @@ -355,7 +355,7 @@ test trace-5.1 {multiple ops traced at once} { unset x set info } {x {} read x {} write x {} read x {} write x {} unset} -test trace-5.2 {multiple ops traced on array element} { +test trace-6.2 {multiple ops traced on array element} { catch {unset x} set info {} trace add variable x(0) {read write unset} traceProc @@ -367,7 +367,7 @@ test trace-5.2 {multiple ops traced on array element} { unset x set info } {x 0 read x 0 write x 0 read x 0 write x 0 unset} -test trace-5.3 {multiple ops traced on whole array} { +test trace-6.3 {multiple ops traced on whole array} { catch {unset x} set info {} trace add variable x {read write unset} traceProc @@ -382,7 +382,7 @@ test trace-5.3 {multiple ops traced on whole array} { # Check order of invocation of traces -test trace-6.1 {order of invocation of traces} { +test trace-7.1 {order of invocation of traces} { catch {unset x} set info {} trace add variable x read "traceTag 1" @@ -393,7 +393,7 @@ test trace-6.1 {order of invocation of traces} { set x set info } {3 2 1 3 2 1} -test trace-6.2 {order of invocation of traces} { +test trace-7.2 {order of invocation of traces} { catch {unset x} set x(0) 44 set info {} @@ -403,7 +403,7 @@ test trace-6.2 {order of invocation of traces} { set x(0) set info } {3 2 1} -test trace-6.3 {order of invocation of traces} { +test trace-7.3 {order of invocation of traces} { catch {unset x} set x(0) 44 set info {} @@ -419,7 +419,7 @@ test trace-6.3 {order of invocation of traces} { # Check effects of errors in trace procedures -test trace-7.1 {error returns from traces} { +test trace-8.1 {error returns from traces} { catch {unset x} set x 123 set info {} @@ -427,7 +427,7 @@ test trace-7.1 {error returns from traces} { trace add variable x read traceError list [catch {set x} msg] $msg $info } {1 {can't read "x": trace returned error} {}} -test trace-7.2 {error returns from traces} { +test trace-8.2 {error returns from traces} { catch {unset x} set x 123 set info {} @@ -435,14 +435,14 @@ test trace-7.2 {error returns from traces} { trace add variable x write traceError list [catch {set x 44} msg] $msg $info } {1 {can't set "x": trace returned error} {}} -test trace-7.3 {error returns from traces} { +test trace-8.3 {error returns from traces} { catch {unset x} set x 123 set info {} trace add variable x write traceError list [catch {append x 44} msg] $msg $info } {1 {can't set "x": trace returned error} {}} -test trace-7.4 {error returns from traces} { +test trace-8.4 {error returns from traces} { catch {unset x} set x 123 set info {} @@ -450,7 +450,7 @@ test trace-7.4 {error returns from traces} { trace add variable x unset traceError list [catch {unset x} msg] $msg $info } {0 {} 1} -test trace-7.5 {error returns from traces} { +test trace-8.5 {error returns from traces} { catch {unset x} set x(0) 123 set info {} @@ -460,13 +460,13 @@ test trace-7.5 {error returns from traces} { trace add variable x read "traceTag 3" list [catch {set x(0)} msg] $msg $info } {1 {can't read "x(0)": trace returned error} 3} -test trace-7.6 {error returns from traces} { +test trace-8.6 {error returns from traces} { catch {unset x} set x 123 trace add variable x unset traceError list [catch {unset x} msg] $msg } {0 {}} -test trace-7.7 {error returns from traces} { +test trace-8.7 {error returns from traces} { # This test just makes sure that the memory for the error message # gets deallocated correctly when the trace is invoked again or # when the trace is deleted. @@ -482,7 +482,7 @@ test trace-7.7 {error returns from traces} { # procedures are invoked, so trace procedure can even manipulate # a new copy of the variables. -test trace-8.1 {be sure variable is unset before trace is called} { +test trace-9.1 {be sure variable is unset before trace is called} { catch {unset x} set x 33 set info {} @@ -490,7 +490,7 @@ test trace-8.1 {be sure variable is unset before trace is called} { unset x set info } {1 {can't read "x": no such variable}} -test trace-8.2 {be sure variable is unset before trace is called} { +test trace-9.2 {be sure variable is unset before trace is called} { catch {unset x} set x 33 set info {} @@ -498,7 +498,7 @@ test trace-8.2 {be sure variable is unset before trace is called} { unset x concat $info [list [catch {set x} msg] $msg] } {0 22 0 22} -test trace-8.3 {be sure traces are cleared before unset trace called} { +test trace-9.3 {be sure traces are cleared before unset trace called} { catch {unset x} set x 33 set info {} @@ -506,7 +506,7 @@ test trace-8.3 {be sure traces are cleared before unset trace called} { unset x set info } {0 {}} -test trace-8.4 {set new trace during unset trace} { +test trace-9.4 {set new trace during unset trace} { catch {unset x} set x 33 set info {} @@ -515,7 +515,7 @@ test trace-8.4 {set new trace during unset trace} { concat $info [trace list variable x] } {0 {} {unset traceProc}} -test trace-9.1 {make sure array elements are unset before traces are called} { +test trace-10.1 {make sure array elements are unset before traces are called} { catch {unset x} set x(0) 33 set info {} @@ -523,7 +523,7 @@ test trace-9.1 {make sure array elements are unset before traces are called} { unset x(0) set info } {1 {can't read "x(0)": no such element in array}} -test trace-9.2 {make sure array elements are unset before traces are called} { +test trace-10.2 {make sure array elements are unset before traces are called} { catch {unset x} set x(0) 33 set info {} @@ -531,7 +531,7 @@ test trace-9.2 {make sure array elements are unset before traces are called} { unset x(0) concat $info [list [catch {set x(0)} msg] $msg] } {0 zzz 0 zzz} -test trace-9.3 {array elements are unset before traces are called} { +test trace-10.3 {array elements are unset before traces are called} { catch {unset x} set x(0) 33 set info {} @@ -539,7 +539,7 @@ test trace-9.3 {array elements are unset before traces are called} { unset x(0) set info } {0 {}} -test trace-9.4 {set new array element trace during unset trace} { +test trace-10.4 {set new array element trace during unset trace} { catch {unset x} set x(0) 33 set info {} @@ -548,7 +548,7 @@ test trace-9.4 {set new array element trace during unset trace} { concat $info [trace list variable x(0)] } {0 {} {read {}}} -test trace-10.1 {make sure arrays are unset before traces are called} { +test trace-11.1 {make sure arrays are unset before traces are called} { catch {unset x} set x(0) 33 set info {} @@ -556,7 +556,7 @@ test trace-10.1 {make sure arrays are unset before traces are called} { unset x set info } {1 {can't read "x(0)": no such variable}} -test trace-10.2 {make sure arrays are unset before traces are called} { +test trace-11.2 {make sure arrays are unset before traces are called} { catch {unset x} set x(y) 33 set info {} @@ -564,7 +564,7 @@ test trace-10.2 {make sure arrays are unset before traces are called} { unset x concat $info [list [catch {set x(y)} msg] $msg] } {0 22 0 22} -test trace-10.3 {make sure arrays are unset before traces are called} { +test trace-11.3 {make sure arrays are unset before traces are called} { catch {unset x} set x(y) 33 set info {} @@ -572,7 +572,7 @@ test trace-10.3 {make sure arrays are unset before traces are called} { unset x set info } {0 0} -test trace-10.4 {make sure arrays are unset before traces are called} { +test trace-11.4 {make sure arrays are unset before traces are called} { catch {unset x} set x(y) 33 set info {} @@ -581,7 +581,7 @@ test trace-10.4 {make sure arrays are unset before traces are called} { unset x set info } {0 {}} -test trace-10.5 {set new array trace during unset trace} { +test trace-11.5 {set new array trace during unset trace} { catch {unset x} set x(y) 33 set info {} @@ -589,7 +589,7 @@ test trace-10.5 {set new array trace during unset trace} { unset x concat $info [trace list variable x] } {0 {} {read {}}} -test trace-10.6 {create scalar during array unset trace} { +test trace-11.6 {create scalar during array unset trace} { catch {unset x} set x(y) 33 set info {} @@ -600,52 +600,52 @@ test trace-10.6 {create scalar during array unset trace} { # Check special conditions (e.g. errors) in Tcl_TraceVar2. -test trace-11.1 {creating array when setting variable traces} { +test trace-12.1 {creating array when setting variable traces} { catch {unset x} set info {} trace add variable x(0) write traceProc list [catch {set x 22} msg] $msg } {1 {can't set "x": variable is array}} -test trace-11.2 {creating array when setting variable traces} { +test trace-12.2 {creating array when setting variable traces} { catch {unset x} set info {} trace add variable x(0) write traceProc list [catch {set x(0)} msg] $msg } {1 {can't read "x(0)": no such element in array}} -test trace-11.3 {creating array when setting variable traces} { +test trace-12.3 {creating array when setting variable traces} { catch {unset x} set info {} trace add variable x(0) write traceProc set x(0) 22 set info } {x 0 write} -test trace-11.4 {creating variable when setting variable traces} { +test trace-12.4 {creating variable when setting variable traces} { catch {unset x} set info {} trace add variable x write traceProc list [catch {set x} msg] $msg } {1 {can't read "x": no such variable}} -test trace-11.5 {creating variable when setting variable traces} { +test trace-12.5 {creating variable when setting variable traces} { catch {unset x} set info {} trace add variable x write traceProc set x 22 set info } {x {} write} -test trace-11.6 {creating variable when setting variable traces} { +test trace-12.6 {creating variable when setting variable traces} { catch {unset x} set info {} trace add variable x write traceProc set x(0) 22 set info } {x 0 write} -test trace-11.7 {create array element during read trace} { +test trace-12.7 {create array element during read trace} { catch {unset x} set x(2) zzz trace add variable x read {traceCrtElement xyzzy} list [catch {set x(3)} msg] $msg } {0 xyzzy} -test trace-11.8 {errors when setting variable traces} { +test trace-12.8 {errors when setting variable traces} { catch {unset x} set x 44 list [catch {trace add variable x(0) write traceProc} msg] $msg @@ -653,7 +653,7 @@ test trace-11.8 {errors when setting variable traces} { # Check deleting one trace from another. -test trace-12.1 {delete one trace from another} { +test trace-13.1 {delete one trace from another} { proc delTraces {args} { global x trace remove variable x read {traceTag 2} @@ -686,41 +686,41 @@ set i 0 set start "wrong # args:" foreach type {variable command} { foreach op {add remove} { - test trace-13.0.[incr i] "trace command, wrong # args errors" { + test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace $op $type} msg] $msg } [list 1 "$start should be \"trace $op $type name opList command\""] - test trace-13.0.[incr i] "trace command wrong # args errors" { + test trace-14.0.[incr i] "trace command wrong # args errors" { list [catch {trace $op $type foo} msg] $msg } [list 1 "$start should be \"trace $op $type name opList command\""] - test trace-13.0.[incr i] "trace command, wrong # args errors" { + test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace $op $type foo bar} msg] $msg } [list 1 "$start should be \"trace $op $type name opList command\""] - test trace-13.0.[incr i] "trace command, wrong # args errors" { + test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace $op $type foo bar baz boo} msg] $msg } [list 1 "$start should be \"trace $op $type name opList command\""] } - test trace-13.0.[incr i] "trace command, wrong # args errors" { + test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace list $type foo bar} msg] $msg } [list 1 "$start should be \"trace list $type name\""] - test trace-13.0.[incr i] "trace command, wrong # args errors" { + test trace-14.0.[incr i] "trace command, wrong # args errors" { list [catch {trace list $type} msg] $msg } [list 1 "$start should be \"trace list $type name\""] } -test trace-13.1 "trace command, wrong # args errors" { +test trace-14.1 "trace command, wrong # args errors" { list [catch {trace} msg] $msg } [list 1 "wrong # args: should be \"trace option ?arg arg ...?\""] -test trace-13.2 "trace command, wrong # args errors" { +test trace-14.2 "trace command, wrong # args errors" { list [catch {trace add} msg] $msg } [list 1 "wrong # args: should be \"trace add type ?arg arg ...?\""] -test trace-13.3 "trace command, wrong # args errors" { +test trace-14.3 "trace command, wrong # args errors" { list [catch {trace remove} msg] $msg } [list 1 "wrong # args: should be \"trace remove type ?arg arg ...?\""] -test trace-13.4 "trace command, wrong # args errors" { +test trace-14.4 "trace command, wrong # args errors" { list [catch {trace list} msg] $msg } [list 1 "wrong # args: should be \"trace list type ?arg arg ...?\""] -test trace-13.5 {trace command, invalid option} { +test trace-14.5 {trace command, invalid option} { list [catch {trace gorp} msg] $msg } [list 1 "bad option \"gorp\": must be add, list, remove, variable, vdelete, or vinfo"] @@ -733,44 +733,44 @@ set errs [list "array, read, unset, or write" "delete or rename"] set abbvs [list {a r u w} {d r}] foreach type {variable command} err $errs abbvlist $abbvs { foreach op {add remove} { - test trace-13.6.[incr i] "trace $op $type errors" { + test trace-14.6.[incr i] "trace $op $type errors" { list [catch {trace $op $type x {y z w} a} msg] $msg } [list 1 "bad operation \"y\": must be $err"] foreach abbv $abbvlist { - test trace-13.6.[incr i] "trace $op $type rejects abbreviations" { + test trace-14.6.[incr i] "trace $op $type rejects abbreviations" { list [catch {trace $op $type x $abbv a} msg] $msg } [list 1 "bad operation \"$abbv\": must be $err"] } - test trace-13.6.[incr i] "trace $op $type rejects null opList" { + test trace-14.6.[incr i] "trace $op $type rejects null opList" { list [catch {trace $op $type x {} a} msg] $msg } [list 1 "bad operation list \"\": must be one or more of $err"] } } -test trace-13.7 {trace command, "trace variable" errors} { +test trace-14.7 {trace command, "trace variable" errors} { list [catch {trace variable} msg] $msg } [list 1 "wrong # args: should be \"trace variable name ops command\""] -test trace-13.8 {trace command, "trace variable" errors} { +test trace-14.8 {trace command, "trace variable" errors} { list [catch {trace variable x} msg] $msg } [list 1 "wrong # args: should be \"trace variable name ops command\""] -test trace-13.9 {trace command, "trace variable" errors} { +test trace-14.9 {trace command, "trace variable" errors} { list [catch {trace variable x y} msg] $msg } [list 1 "wrong # args: should be \"trace variable name ops command\""] -test trace-13.10 {trace command, "trace variable" errors} { +test trace-14.10 {trace command, "trace variable" errors} { list [catch {trace variable x y z w} msg] $msg } [list 1 "wrong # args: should be \"trace variable name ops command\""] -test trace-13.11 {trace command, "trace variable" errors} { +test trace-14.11 {trace command, "trace variable" errors} { list [catch {trace variable x y z} msg] $msg } [list 1 "bad operations \"y\": should be one or more of rwua"] -test trace-13.9 {trace command ("remove variable" option)} { +test trace-14.9 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write traceProc trace remove variable x write traceProc } {} -test trace-13.10 {trace command ("remove variable" option)} { +test trace-14.10 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write traceProc @@ -778,7 +778,7 @@ test trace-13.10 {trace command ("remove variable" option)} { set x 12345 set info } {} -test trace-13.11 {trace command ("remove variable" option)} { +test trace-14.11 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write {traceTag 1} @@ -793,7 +793,7 @@ test trace-13.11 {trace command ("remove variable" option)} { set x gorp set info } {2 x {} write 1 2 1 2} -test trace-13.12 {trace command ("remove variable" option)} { +test trace-14.12 {trace command ("remove variable" option)} { catch {unset x} set info {} trace add variable x write {traceTag 1} @@ -801,27 +801,27 @@ test trace-13.12 {trace command ("remove variable" option)} { set x 12345 set info } {1} -test trace-13.15 {trace command ("list variable" option)} { +test trace-14.15 {trace command ("list variable" option)} { catch {unset x} trace add variable x write {traceTag 1} trace add variable x write traceProc trace add variable x write {traceTag 2} trace list variable x } {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}} -test trace-13.16 {trace command ("list variable" option)} { +test trace-14.16 {trace command ("list variable" option)} { catch {unset x} trace list variable x } {} -test trace-13.17 {trace command ("list variable" option)} { +test trace-14.17 {trace command ("list variable" option)} { catch {unset x} trace list variable x(0) } {} -test trace-13.18 {trace command ("list variable" option)} { +test trace-14.18 {trace command ("list variable" option)} { catch {unset x} set x 44 trace list variable x(0) } {} -test trace-13.19 {trace command ("list variable" option)} { +test trace-14.19 {trace command ("list variable" option)} { catch {unset x} set x 44 trace add variable x write {traceTag 1} @@ -831,7 +831,7 @@ test trace-13.19 {trace command ("list variable" option)} { # Check fancy trace commands (long ones, weird arguments, etc.) -test trace-14.1 {long trace command} { +test trace-15.1 {long trace command} { catch {unset x} set info {} trace add variable x write {traceTag {This is a very very long argument. It's \ @@ -846,7 +846,7 @@ test trace-14.1 {long trace command} { with such long arguments by malloc-ing space. One possibility \ is that space doesn't get freed properly. If this happens, then \ invoking this test over and over again will eventually leak memory.} -test trace-14.2 {long trace command result to ignore} { +test trace-15.2 {long trace command result to ignore} { proc longResult {args} {return "quite a bit of text, designed to generate a core leak if this command file is invoked over and over again and memory isn't being recycled correctly"} @@ -856,7 +856,7 @@ test trace-14.2 {long trace command result to ignore} { set x 5 set x abcde } abcde -test trace-14.3 {special list-handling in trace commands} { +test trace-15.3 {special list-handling in trace commands} { catch {unset "x y z"} set "x y z(a\n\{)" 44 set info {} @@ -887,7 +887,7 @@ proc traceAppend {string name1 name2 op} { lappend info $string } -test trace-15.1 {unsets during read traces} { +test trace-16.1 {unsets during read traces} { catch {unset y} set y 1234 set info {} @@ -895,49 +895,49 @@ test trace-15.1 {unsets during read traces} { trace add variable y unset {traceAppend unset} lappend info [catch {set y} msg] $msg } {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}} -test trace-15.2 {unsets during read traces} { +test trace-16.2 {unsets during read traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) read {traceUnset y(0)} lappend info [catch {set y(0)} msg] $msg } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}} -test trace-15.3 {unsets during read traces} { +test trace-16.3 {unsets during read traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) read {traceUnset y} lappend info [catch {set y(0)} msg] $msg } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}} -test trace-15.4 {unsets during read traces} { +test trace-16.4 {unsets during read traces} { catch {unset y} set y 1234 set info {} trace add variable y read {traceReset y y} lappend info [catch {set y} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} -test trace-15.5 {unsets during read traces} { +test trace-16.5 {unsets during read traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) read {traceReset y(0) y(0)} lappend info [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} -test trace-15.6 {unsets during read traces} { +test trace-16.6 {unsets during read traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) read {traceReset y y(0)} lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}} -test trace-15.7 {unsets during read traces} { +test trace-16.7 {unsets during read traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) read {traceReset2 y y(0)} lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy} -test trace-15.8 {unsets during write traces} { +test trace-16.8 {unsets during write traces} { catch {unset y} set y 1234 set info {} @@ -945,91 +945,91 @@ test trace-15.8 {unsets during write traces} { trace add variable y unset {traceAppend unset} lappend info [catch {set y xxx} msg] $msg } {unset 0 {} 1 {can't read "x": no such variable} 0 {}} -test trace-15.9 {unsets during write traces} { +test trace-16.9 {unsets during write traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) write {traceUnset y(0)} lappend info [catch {set y(0) xxx} msg] $msg } {0 {} 1 {can't read "x": no such variable} 0 {}} -test trace-15.10 {unsets during write traces} { +test trace-16.10 {unsets during write traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) write {traceUnset y} lappend info [catch {set y(0) xxx} msg] $msg } {0 {} 1 {can't read "x": no such variable} 0 {}} -test trace-15.11 {unsets during write traces} { +test trace-16.11 {unsets during write traces} { catch {unset y} set y 1234 set info {} trace add variable y write {traceReset y y} lappend info [catch {set y xxx} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} -test trace-15.12 {unsets during write traces} { +test trace-16.12 {unsets during write traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) write {traceReset y(0) y(0)} lappend info [catch {set y(0) xxx} msg] $msg } {0 {} 0 xyzzy 0 xyzzy} -test trace-15.13 {unsets during write traces} { +test trace-16.13 {unsets during write traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) write {traceReset y y(0)} lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}} -test trace-15.14 {unsets during write traces} { +test trace-16.14 {unsets during write traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) write {traceReset2 y y(0)} lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 0 {} 0 xyzzy} -test trace-15.15 {unsets during unset traces} { +test trace-16.15 {unsets during unset traces} { catch {unset y} set y 1234 set info {} trace add variable y unset {traceUnset y} lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}} -test trace-15.16 {unsets during unset traces} { +test trace-16.16 {unsets during unset traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) unset {traceUnset y(0)} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}} -test trace-15.17 {unsets during unset traces} { +test trace-16.17 {unsets during unset traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) unset {traceUnset y} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}} -test trace-15.18 {unsets during unset traces} { +test trace-16.18 {unsets during unset traces} { catch {unset y} set y 1234 set info {} trace add variable y unset {traceReset2 y y} lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg } {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy} -test trace-15.19 {unsets during unset traces} { +test trace-16.19 {unsets during unset traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) unset {traceReset2 y(0) y(0)} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy} -test trace-15.20 {unsets during unset traces} { +test trace-16.20 {unsets during unset traces} { catch {unset y} set y(0) 1234 set info {} trace add variable y(0) unset {traceReset2 y y(0)} lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg } {0 {} 0 xyzzy 0 {} 0 xyzzy} -test trace-15.21 {unsets cancelling traces} { +test trace-16.21 {unsets cancelling traces} { catch {unset y} set y 1234 set info {} @@ -1039,7 +1039,7 @@ test trace-15.21 {unsets cancelling traces} { trace add variable y unset {traceAppend unset} lappend info [catch {set y} msg] $msg } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}} -test trace-15.22 {unsets cancelling traces} { +test trace-16.22 {unsets cancelling traces} { catch {unset y} set y(0) 1234 set info {} @@ -1052,19 +1052,19 @@ test trace-15.22 {unsets cancelling traces} { # Check various non-interference between traces and other things. -test trace-16.1 {trace doesn't prevent unset errors} { +test trace-17.1 {trace doesn't prevent unset errors} { catch {unset x} set info {} trace add variable x unset {traceProc} list [catch {unset x} msg] $msg $info } {1 {can't unset "x": no such variable} {x {} unset}} -test trace-16.2 {traced variables must survive procedure exits} { +test trace-17.2 {traced variables must survive procedure exits} { catch {unset x} proc p1 {} {global x; trace add variable x write traceProc} p1 trace list variable x } {{write traceProc}} -test trace-16.3 {traced variables must survive procedure exits} { +test trace-17.3 {traced variables must survive procedure exits} { catch {unset x} set info {} proc p1 {} {global x; trace add variable x write traceProc} @@ -1076,7 +1076,7 @@ test trace-16.3 {traced variables must survive procedure exits} { # Be sure that procedure frames are released before unset traces # are invoked. -test trace-17.1 {unset traces on procedure returns} { +test trace-18.1 {unset traces on procedure returns} { proc p1 {x y} {set a 44; p2 14} proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel {info vars}]}}} set info {} @@ -1090,24 +1090,24 @@ test trace-17.1 {unset traces on procedure returns} { catch {unset x} catch {unset y} -test trace-17.2 {trace add command (command existence)} { +test trace-18.2 {trace add command (command existence)} { # Just in case! catch {rename nosuchname ""} list [catch {trace add command nosuchname rename traceCommand} msg] $msg } {1 {unknown command "nosuchname"}} -test trace-17.3 {trace add command (command existence in ns)} { +test trace-18.3 {trace add command (command existence in ns)} { list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg } {1 {unknown command "nosuchns::nosuchname"}} -test trace-18.1 {trace add command (rename option)} { +test trace-19.1 {trace add command (rename option)} { proc foo {} {} catch {rename bar {}} trace add command foo rename traceCommand rename foo bar set info } {foo bar rename} -test trace-18.2 {traces stick with renamed commands} { +test trace-19.2 {traces stick with renamed commands} { proc foo {} {} catch {rename bar {}} trace add command foo rename traceCommand @@ -1115,19 +1115,19 @@ test trace-18.2 {traces stick with renamed commands} { rename bar foo set info } {bar foo rename} -test trace-18.2.1 {trace add command rename trace exists} { +test trace-19.2.1 {trace add command rename trace exists} { proc foo {} {} trace add command foo rename traceCommand trace list command foo } {{rename traceCommand}} -test trace-18.3 {command rename traces don't fire on command deletion} { +test trace-19.3 {command rename traces don't fire on command deletion} { proc foo {} {} set info {} trace add command foo rename traceCommand rename foo {} set info } {} -test trace-18.4 {trace add command rename doesn't trace recreated commands} { +test trace-19.4 {trace add command rename doesn't trace recreated commands} { proc foo {} {} catch {rename bar {}} trace add command foo rename traceCommand @@ -1135,7 +1135,7 @@ test trace-18.4 {trace add command rename doesn't trace recreated commands} { rename foo bar set info } {} -test trace-18.5 {trace add command deleted removes traces} { +test trace-19.5 {trace add command deleted removes traces} { proc foo {} {} trace add command foo rename traceCommand proc foo {} {} @@ -1144,24 +1144,24 @@ test trace-18.5 {trace add command deleted removes traces} { namespace eval tc {} proc tc::tcfoo {} {} -test trace-18.6 {trace add command rename in namespace} { +test trace-19.6 {trace add command rename in namespace} { trace add command tc::tcfoo rename traceCommand rename tc::tcfoo tc::tcbar set info } {tc::tcfoo tc::tcbar rename} -test trace-18.7 {trace add command rename in namespace back again} { +test trace-19.7 {trace add command rename in namespace back again} { rename tc::tcbar tc::tcfoo set info } {tc::tcbar tc::tcfoo rename} -test trace-18.8 {trace add command rename in namespace to out of namespace} { +test trace-19.8 {trace add command rename in namespace to out of namespace} { rename tc::tcfoo tcbar set info } {tc::tcfoo tcbar rename} -test trace-18.9 {trace add command rename back into namespace} { +test trace-19.9 {trace add command rename back into namespace} { rename tcbar tc::tcfoo set info } {tcbar tc::tcfoo rename} -test trace-18.10 {trace add command failed rename doesn't trigger trace} { +test trace-19.10 {trace add command failed rename doesn't trigger trace} { set info {} proc foo {} {} proc bar {} {} @@ -1175,33 +1175,33 @@ catch {rename bar {}} # Make sure it exists again proc foo {} {} -test trace-19.1 {trace add command (delete option)} { +test trace-20.1 {trace add command (delete option)} { trace add command foo delete traceCommand rename foo "" set info } {foo {} delete} -test trace-19.2 {trace add command delete doesn't trace recreated commands} { +test trace-20.2 {trace add command delete doesn't trace recreated commands} { set info {} proc foo {} {} rename foo "" set info } {} -test trace-19.2.1 {trace add command delete trace info} { +test trace-20.2.1 {trace add command delete trace info} { proc foo {} {} trace add command foo delete traceCommand trace list command foo } {{delete traceCommand}} -test trace-19.3 {trace add command implicit delete} { +test trace-20.3 {trace add command implicit delete} { proc foo {} {} trace add command foo delete traceCommand proc foo {} {} set info } {foo {} delete} -test trace-19.3.1 {trace add command delete trace info} { +test trace-20.3.1 {trace add command delete trace info} { proc foo {} {} trace list command foo } {} -test trace-19.4 {trace add command rename followed by delete} { +test trace-20.4 {trace add command rename followed by delete} { set infotemp {} proc foo {} {} trace add command foo {rename delete} traceCommand @@ -1216,7 +1216,7 @@ test trace-19.4 {trace add command rename followed by delete} { catch {rename foo {}} catch {rename bar {}} -test trace-19.5 {trace add command rename and delete} { +test trace-20.5 {trace add command rename and delete} { set infotemp {} set info {} proc foo {} {} @@ -1230,7 +1230,7 @@ test trace-19.5 {trace add command rename and delete} { set info } {{foo bar rename} {bar {} delete}} -test trace-19.6 {trace add command rename and delete in subinterp} { +test trace-20.6 {trace add command rename and delete in subinterp} { set tc [interp create] foreach p {traceCommand} { $tc eval [list proc $p [info args $p] [info body $p]] @@ -1253,7 +1253,7 @@ test trace-19.6 {trace add command rename and delete in subinterp} { # I'd like it if this test could give 'foo {} d' as a result, # but interp deletion means there is no interp to evaluate # the trace in. -test trace-19.7 {trace add command delete in subinterp while being deleted} { +test trace-20.7 {trace add command delete in subinterp while being deleted} { set info {} set tc [interp create] interp alias $tc traceCommand {} traceCommand @@ -1274,7 +1274,7 @@ proc traceCmdrename {cmd old new op} { proc traceCmddelete {cmd old new op} { rename $old "" } -test trace-19.8 {trace delete while trace is active} { +test trace-20.8 {trace delete while trace is active} { set info {} proc foo {} {} catch {rename bar {}} @@ -1283,7 +1283,7 @@ test trace-19.8 {trace delete while trace is active} { list [set info] [trace list command bar] } {{foo bar rename} {}} -test trace-19.9 {rename trace deletes command} { +test trace-20.9 {rename trace deletes command} { set info {} proc foo {} {} catch {rename bar {}} @@ -1293,7 +1293,7 @@ test trace-19.9 {rename trace deletes command} { list [info commands foo] [info commands bar] [info commands someothername] } {{} {} {}} -test trace-19.10 {rename trace renames command} { +test trace-20.10 {rename trace renames command} { set info {} proc foo {} {} catch {rename bar {}} @@ -1305,7 +1305,7 @@ test trace-19.10 {rename trace renames command} { set info } {{} {} someothername} -test trace-19.11 {delete trace deletes command} { +test trace-20.11 {delete trace deletes command} { set info {} proc foo {} {} catch {rename bar {}} @@ -1315,7 +1315,7 @@ test trace-19.11 {delete trace deletes command} { list [info commands foo] [info commands bar] [info commands someothername] } {{} {} {}} -test trace-19.12 {delete trace renames command} { +test trace-20.12 {delete trace renames command} { set info {} proc foo {} {} catch {rename bar {}} |