summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog4
-rw-r--r--tests/trace.test242
2 files changed, 125 insertions, 121 deletions
diff --git a/ChangeLog b/ChangeLog
index c83539f..b8aaf12 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2001-08-10 Miguel Sofer <msofer@users.sourceforge.net>
+
+ * tests/trace.test: Corrected test numbers [Bug: 449794]
+
2001-08-12 Mo DeJong <mdejong@redhat.com>
* unix/configure: Regen.
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 {}}
generated by cgit v0.12 at 2024-11-13 00:20:18 (GMT)