diff options
| -rw-r--r-- | doc/trace.n | 2 | ||||
| -rw-r--r-- | doc/upvar.n | 2 | ||||
| -rw-r--r-- | tests/append.test | 16 | ||||
| -rw-r--r-- | tests/appendComp.test | 30 | ||||
| -rw-r--r-- | tests/expr.test | 2 | ||||
| -rw-r--r-- | tests/if.test | 2 | ||||
| -rw-r--r-- | tests/incr-old.test | 2 | ||||
| -rw-r--r-- | tests/init.test | 2 | ||||
| -rw-r--r-- | tests/link.test | 10 | ||||
| -rw-r--r-- | tests/namespace-old.test | 4 | ||||
| -rw-r--r-- | tests/proc-old.test | 16 | ||||
| -rw-r--r-- | tests/set-old.test | 16 | ||||
| -rw-r--r-- | tests/set.test | 4 | ||||
| -rw-r--r-- | tests/trace.test | 52 | ||||
| -rw-r--r-- | tests/upvar.test | 14 | ||||
| -rw-r--r-- | tests/var.test | 24 |
16 files changed, 99 insertions, 99 deletions
diff --git a/doc/trace.n b/doc/trace.n index 959acc2..d54b17f 100644 --- a/doc/trace.n +++ b/doc/trace.n @@ -231,7 +231,7 @@ When the trace triggers, three arguments are appended to .PP \fIName1\fR gives the name for the variable being accessed. This is not necessarily the same as the name used in the -\fBtrace variable\fR command: the \fBupvar\fR command allows a +\fBtrace add variable\fR command: the \fBupvar\fR command allows a procedure to reference a variable under a different name. If the trace was originally set on an array or array element, \fIname2\fR provides which index into the array was affected. diff --git a/doc/upvar.n b/doc/upvar.n index b0324b2..55632d1 100644 --- a/doc/upvar.n +++ b/doc/upvar.n @@ -94,7 +94,7 @@ proc \fIsetByUpvar\fR { name value } { set localVar $value } set originalVar 1 -trace variable originalVar w \fItraceproc\fR +trace add variable originalVar write \fItraceproc\fR \fIsetByUpvar\fR originalVar 2 .CE .PP diff --git a/tests/append.test b/tests/append.test index c0c0cce..1055ae0 100644 --- a/tests/append.test +++ b/tests/append.test @@ -221,7 +221,7 @@ test append-7.1 {lappend-created var and error in trace on that var} -setup { catch {rename foo ""} unset -nocomplain x } -body { - trace variable x w foo + trace add variable x write foo proc foo {} {global x; unset x} catch {lappend x 1} proc foo {args} {global x; unset x} @@ -234,37 +234,37 @@ test append-7.2 {lappend var triggers read trace} -setup { unset -nocomplain myvar unset -nocomplain ::result } -body { - trace variable myvar r foo + trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar a return $::result -} -result {myvar {} r} +} -result {myvar {} read} test append-7.3 {lappend var triggers read trace, array var} -setup { unset -nocomplain myvar unset -nocomplain ::result } -body { # The behavior of read triggers on lappend changed in 8.0 to not trigger # them, and was changed back in 8.4. - trace variable myvar r foo + trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a return $::result -} -result {myvar b r} +} -result {myvar b read} test append-7.4 {lappend var triggers read trace, array var exists} -setup { unset -nocomplain myvar unset -nocomplain ::result } -body { set myvar(0) 1 - trace variable myvar r foo + trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a return $::result -} -result {myvar b r} +} -result {myvar b read} test append-7.5 {append var does not trigger read trace} -setup { unset -nocomplain myvar unset -nocomplain ::result } -body { - trace variable myvar r foo + trace add variable myvar read foo proc foo {args} {append ::result $args} append myvar a info exists ::result diff --git a/tests/appendComp.test b/tests/appendComp.test index 121b704..ddb4fb2 100644 --- a/tests/appendComp.test +++ b/tests/appendComp.test @@ -250,7 +250,7 @@ test appendComp-7.1 {lappendComp-created var and error in trace on that var} -se } -body { proc bar {} { global x - trace variable x w foo + trace add variable x write foo proc foo {} {global x; unset x} catch {lappend x 1} proc foo {args} {global x; unset x} @@ -265,19 +265,19 @@ test appendComp-7.2 {lappend var triggers read trace, index var} -setup { unset -nocomplain ::result } -body { proc bar {} { - trace variable myvar r foo + trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar a return $::result } bar -} -result {myvar {} r} -constraints {bug-3057639} +} -result {myvar {} read} -constraints {bug-3057639} test appendComp-7.3 {lappend var triggers read trace, stack var} -setup { unset -nocomplain ::result unset -nocomplain ::myvar } -body { proc bar {} { - trace variable ::myvar r foo + trace add variable ::myvar read foo proc foo {args} {append ::result $args} lappend ::myvar a return $::result @@ -290,67 +290,67 @@ test appendComp-7.4 {lappend var triggers read trace, array var} -setup { # The behavior of read triggers on lappend changed in 8.0 to not trigger # them. Maybe not correct, but been there a while. proc bar {} { - trace variable myvar r foo + trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a return $::result } bar -} -result {myvar b r} -constraints {bug-3057639} +} -result {myvar b read} -constraints {bug-3057639} test appendComp-7.5 {lappend var triggers read trace, array var} -setup { unset -nocomplain ::result } -body { # The behavior of read triggers on lappend changed in 8.0 to not trigger # them. Maybe not correct, but been there a while. proc bar {} { - trace variable myvar r foo + trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a b return $::result } bar -} -result {myvar b r} +} -result {myvar b read} test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup { unset -nocomplain ::result } -body { proc bar {} { set myvar(0) 1 - trace variable myvar r foo + trace add variable myvar read foo proc foo {args} {append ::result $args} lappend myvar(b) a return $::result } bar -} -result {myvar b r} -constraints {bug-3057639} +} -result {myvar b read} -constraints {bug-3057639} test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup { unset -nocomplain ::myvar unset -nocomplain ::result } -body { proc bar {} { - trace variable ::myvar r foo + trace add variable ::myvar read foo proc foo {args} {append ::result $args} lappend ::myvar(b) a return $::result } bar -} -result {::myvar b r} -constraints {bug-3057639} +} -result {::myvar b read} -constraints {bug-3057639} test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup { unset -nocomplain ::myvar unset -nocomplain ::result } -body { proc bar {} { - trace variable ::myvar r foo + trace add variable ::myvar read foo proc foo {args} {append ::result $args} lappend ::myvar(b) a b return $::result } bar -} -result {::myvar b r} +} -result {::myvar b read} test appendComp-7.9 {append var does not trigger read trace} -setup { unset -nocomplain ::result } -body { proc bar {} { - trace variable myvar r foo + trace add variable myvar read foo proc foo {args} {append ::result $args} append myvar a info exists ::result diff --git a/tests/expr.test b/tests/expr.test index 15eff76..6ff8b21 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -777,7 +777,7 @@ test expr-20.2 {double invocation of variable traces} -body { set var "$counter + [concat $extraargs]" } } - trace variable exprtracevar r [list exprtraceproc 10] + trace add variable exprtracevar read [list exprtraceproc 10] list [catch {expr "$exprtracevar + 20"} a] $a \ [catch {expr "$exprtracevar + 20"} b] $b \ [unset exprtracevar exprtracecounter] diff --git a/tests/if.test b/tests/if.test index c5babdd..a1399a0 100644 --- a/tests/if.test +++ b/tests/if.test @@ -1265,7 +1265,7 @@ test if-10.6 {double invocation of variable traces} -body { set var "$counter + [concat $extraargs]" } } - trace variable iftracevar r [list iftraceproc 10] + trace add variable iftracevar read [list iftraceproc 10] list [catch {if "$iftracevar + 20" {}} a] $a \ [catch {if "$iftracevar + 20" {}} b] $b } -cleanup { diff --git a/tests/incr-old.test b/tests/incr-old.test index 818bccc..662fdc7 100644 --- a/tests/incr-old.test +++ b/tests/incr-old.test @@ -63,7 +63,7 @@ test incr-old-2.5 {incr errors} { test incr-old-2.6 {incr errors} -body { proc readonly args {error "variable is read-only"} set x 123 - trace var x w readonly + trace add var x write readonly list [catch {incr x 1} msg] $msg $::errorInfo } -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing diff --git a/tests/init.test b/tests/init.test index 4acad3d..ac80016 100644 --- a/tests/init.test +++ b/tests/init.test @@ -170,7 +170,7 @@ foreach arg [subst -nocommands -novariables { auto_reset } -body { namespace eval junk [list array set $arg [list 1 2 3 4]] - trace variable ::junk::$arg r \ + trace add variable ::junk::$arg read \ "[list error [subst {Variable \"$arg\" is write-only}]] ;# " catch {parray ::junk::$arg} set first $::errorInfo diff --git a/tests/link.test b/tests/link.test index 43a85fb..6ac2277 100644 --- a/tests/link.test +++ b/tests/link.test @@ -384,11 +384,11 @@ test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} { set x {} testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 - trace var int w x + trace add var int write x testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340 - trace vdelete int w x + trace remove var int write x return $x -} {{int {} w} 32 -2.0 0 xyzzy 995511} +} {{int {} write} 32 -2.0 0 xyzzy 995511} test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} { proc x args { global x int real bool string wide @@ -398,9 +398,9 @@ test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} { testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1 testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234 testlink delete - trace var int w x + trace add var int write x testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340 - trace vdelete int w x + trace remove var int write x return $x } {} test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} { diff --git a/tests/namespace-old.test b/tests/namespace-old.test index bf73e87..36b613f 100644 --- a/tests/namespace-old.test +++ b/tests/namespace-old.test @@ -635,13 +635,13 @@ test namespace-old-8.1 {traces work across namespace boundaries} { variable status lappend status "$op: $name1" } - trace variable foo::x rwu [namespace code monitor] + trace add variable foo::x {read write unset} [namespace code monitor] } set test_ns_trace::foo::x "yes!" set test_ns_trace::foo::x unset test_ns_trace::foo::x namespace eval test_ns_trace { set status } -} {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}} +} {{write: test_ns_trace::foo::x} {read: test_ns_trace::foo::x} {unset: test_ns_trace::foo::x}} # ----------------------------------------------------------------------- # TEST: imported commands diff --git a/tests/proc-old.test b/tests/proc-old.test index ab93fca..2f0f417 100644 --- a/tests/proc-old.test +++ b/tests/proc-old.test @@ -137,25 +137,25 @@ test proc-old-3.7 {local and global arrays} { proc t1 {args} {global info; set info 1} catch {unset a} set info {} - do {global a; trace var a(1) w t1} + do {global a; trace add var a(1) write t1} set a(1) 44 set info } 1 test proc-old-3.8 {local and global arrays} { proc t1 {args} {global info; set info 1} catch {unset a} - trace var a(1) w t1 + trace add var a(1) write t1 set info {} - do {global a; trace vdelete a(1) w t1} + do {global a; trace remove var a(1) write t1} set a(1) 44 set info } {} test proc-old-3.9 {local and global arrays} { proc t1 {args} {global info; set info 1} catch {unset a} - trace var a(1) w t1 - do {global a; trace vinfo a(1)} -} {{w t1}} + trace add var a(1) write t1 + do {global a; trace info var a(1)} +} {{write t1}} catch {unset a} test proc-old-30.1 {arguments and defaults} { @@ -349,7 +349,7 @@ test proc-old-5.16 {error conditions} { } proc tproc {} { set x 44 - trace var x u foo + trace add var x unset foo while {$x < 100} { error "Nested error" } @@ -361,7 +361,7 @@ test proc-old-5.16 {error conditions} { "error "Nested error"" (procedure "tproc" line 5) invoked from within -"tproc"} {foo was called: x {} u}} +"tproc"} {foo was called: x {} unset}} # The tests below will really only be useful when run under Purify or # some other system that can detect accesses to freed memory... diff --git a/tests/set-old.test b/tests/set-old.test index 052bd23..3289ae8 100644 --- a/tests/set-old.test +++ b/tests/set-old.test @@ -169,7 +169,7 @@ test set-old-5.4 {errors in reading variables} { test set-old-6.1 {creating array during write} { catch {unset a} - trace var a rwu ignore + trace add var a {read write unset} ignore list [catch {set a(14) 186} msg] $msg [array names a] } {0 186 14} test set-old-6.2 {errors in writing variables} { @@ -407,7 +407,7 @@ test set-old-8.18 {array command, get option} { test set-old-8.19 {array command, get option (unset variable)} { catch {unset a} set a(x) 3 - trace var a(y) w ignore + trace add var a(y) write ignore array get a } {x 3} test set-old-8.20 {array command, get option, with pattern} { @@ -445,13 +445,13 @@ test set-old-8.24 {array command, names option} { test set-old-8.25 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; - trace var a(xxx) w ignore + trace add var a(xxx) write ignore list [catch {lsort [array names a]} msg] $msg } {0 {22 33}} test set-old-8.26 {array command, names option} { catch {unset a} set a(22) 3; set a(33) 44; - trace var a(xxx) w ignore + trace add var a(xxx) write ignore set a(xxx) value list [catch {lsort [array names a]} msg] $msg } {0 {22 33 xxx}} @@ -579,7 +579,7 @@ test set-old-8.43 {array command, size option} { test set-old-8.44 {array command, size option} { catch {unset a} set a(22) 3; - trace var a(33) rwu ignore + trace add var a(33) {read write unset} ignore list [catch {array size a} msg] $msg } {0 1} test set-old-8.45 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} { @@ -786,7 +786,7 @@ test set-old-9.10 {array enumeration: searches automatically stopped} { set a(a) 1 set x [array startsearch a] set y [array startsearch a] - trace var a(b) r {} + trace add var a(b) read {} list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}} @@ -795,14 +795,14 @@ test set-old-9.11 {array enumeration: searches automatically stopped} { set a(a) 1 set x [array startsearch a] set y [array startsearch a] - trace var a(a) r {} + trace add var a(a) read {} list [catch {array next a $x} msg] $msg \ [catch {array next a $y} msg2] $msg2 } {0 a 0 a} test set-old-9.12 {array enumeration with traced undefined elements} { catch {unset a} set a(a) 1 - trace var a(b) r {} + trace add var a(b) read {} set x [array startsearch a] lsort [list [array next a $x] [array next a $x]] } {{} a} diff --git a/tests/set.test b/tests/set.test index 357e34b..3f099a3 100644 --- a/tests/set.test +++ b/tests/set.test @@ -263,7 +263,7 @@ test set-2.4 {set command: runtime error, readonly variable} -setup { } -body { proc readonly args {error "variable is read-only"} set x 123 - trace var x w readonly + trace add var x write readonly list [catch {set x 1} msg] $msg $::errorInfo } -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing @@ -521,7 +521,7 @@ test set-4.4 {uncompiled set command: runtime error, readonly variable} -body { set z set proc readonly args {error "variable is read-only"} $z x 123 - trace var x w readonly + trace add var x write readonly list [catch {$z x 1} msg] $msg $::errorInfo } -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only while executing diff --git a/tests/trace.test b/tests/trace.test index 3f30048..d3c2dad 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -76,26 +76,26 @@ test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} { trace add variable z array {set z(foo) 1 ;#} set res "names: [array names z]" unset -nocomplain ::z - trace variable ::z w {unset ::z; error "memory corruption";#} + trace add variable ::z write {unset ::z; error "memory corruption";#} list [catch {set ::z 1} msg] $msg } {1 {can't set "::z": memory corruption}} # Read-tracing on variables -test trace-1.1 {trace variable reads} { +test trace-1.1 {trace add variable reads} { unset -nocomplain x set info {} trace add variable x read traceScalar list [catch {set x} msg] $msg $info } {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}} -test trace-1.2 {trace variable reads} { +test trace-1.2 {trace add variable reads} { unset -nocomplain x set x 123 set info {} trace add variable x read traceScalar list [catch {set x} msg] $msg $info } {0 123 {x {} read 0 123}} -test trace-1.3 {trace variable reads} { +test trace-1.3 {trace add variable reads} { unset -nocomplain x set info {} trace add variable x read traceScalar @@ -156,7 +156,7 @@ test trace-1.9 {trace reads on whole arrays} { trace add variable x read traceArray list [catch {set x(2)} msg] $msg $info } {0 zzz {x 2 read 0 zzz}} -test trace-1.10 {trace variable reads} { +test trace-1.10 {trace add variable reads} { unset -nocomplain x set x 444 set info {} @@ -167,35 +167,35 @@ test trace-1.10 {trace variable reads} { test trace-1.11 {read traces that modify the array structure} { unset -nocomplain x set x(bar) 0 - trace variable x r {set x(foo) 1 ;#} - trace variable x r {unset -nocomplain x(bar) ;#} + trace add variable x read {set x(foo) 1 ;#} + trace add variable x read {unset -nocomplain x(bar) ;#} array get x } {} test trace-1.12 {read traces that modify the array structure} { unset -nocomplain x set x(bar) 0 - trace variable x r {unset -nocomplain x(bar) ;#} - trace variable x r {set x(foo) 1 ;#} + trace add variable x read {unset -nocomplain x(bar) ;#} + trace add variable x read {set x(foo) 1 ;#} array get x } {} test trace-1.13 {read traces that modify the array structure} { unset -nocomplain x set x(bar) 0 - trace variable x r {set x(foo) 1 ;#} - trace variable x r {unset -nocomplain x;#} + trace add variable x read {set x(foo) 1 ;#} + trace add variable x read {unset -nocomplain x;#} list [catch {array get x} res] $res } {1 {can't read "x(bar)": no such variable}} test trace-1.14 {read traces that modify the array structure} { unset -nocomplain x set x(bar) 0 - trace variable x r {unset -nocomplain x;#} - trace variable x r {set x(foo) 1 ;#} + trace add variable x read {unset -nocomplain x;#} + trace add variable x read {set x(foo) 1 ;#} list [catch {array get x} res] $res } {1 {can't read "x(bar)": no such variable}} # Basic write-tracing on variables -test trace-2.1 {trace variable writes} { +test trace-2.1 {trace add variable writes} { unset -nocomplain x set info {} trace add variable x write traceScalar @@ -216,7 +216,7 @@ test trace-2.3 {trace writes on whole arrays} { set x(abc) qq set info } {x abc write 0 qq} -test trace-2.4 {trace variable writes} { +test trace-2.4 {trace add variable writes} { unset -nocomplain x set x 1234 set info {} @@ -224,7 +224,7 @@ test trace-2.4 {trace variable writes} { set x set info } {} -test trace-2.5 {trace variable writes} { +test trace-2.5 {trace add variable writes} { unset -nocomplain x set x 1234 set info {} @@ -232,7 +232,7 @@ test trace-2.5 {trace variable writes} { unset x set info } {} -test trace-2.6 {trace variable writes on compiled local} { +test trace-2.6 {trace add variable writes on compiled local} { # # Check correct function of whole array traces on compiled local # arrays [Bug 1770591]. The corresponding function for read traces is @@ -247,7 +247,7 @@ test trace-2.6 {trace variable writes on compiled local} { p set info } {x X write 0 willy} -test trace-2.7 {trace variable writes on errorInfo} -body { +test trace-2.7 {trace add variable writes on errorInfo} -body { # # Check correct behaviour of write traces on errorInfo. # [Bug 1773040] @@ -266,7 +266,7 @@ test trace-2.7 {trace variable writes on errorInfo} -body { # still trigger these read traces. Also lappend triggers only one write # trace: after appending all arguments to the list. -test trace-3.1 {trace variable read-modify-writes} { +test trace-3.1 {trace add variable read-modify-writes} { unset -nocomplain x set info {} trace add variable x read traceScalarAppend @@ -275,7 +275,7 @@ test trace-3.1 {trace variable read-modify-writes} { lappend x 789 set info } {x {} read 0 123456} -test trace-3.2 {trace variable read-modify-writes} { +test trace-3.2 {trace add variable read-modify-writes} { unset -nocomplain x set info {} trace add variable x {read write} traceScalarAppend @@ -286,7 +286,7 @@ test trace-3.2 {trace variable read-modify-writes} { # Basic unset-tracing on variables -test trace-4.1 {trace variable unsets} { +test trace-4.1 {trace add variable unsets} { unset -nocomplain x set info {} trace add variable x unset traceScalar @@ -397,10 +397,10 @@ test trace-5.4 {array traces properly listed in trace information} { } [list [list array traceArray2]] test trace-5.5 {array traces properly listed in trace information} { unset -nocomplain x - trace variable x a traceArray2 - set result [trace vinfo x] + trace add variable x array traceArray2 + set result [trace info variable x] set result -} [list [list a traceArray2]] +} [list [list array traceArray2]] test trace-5.6 {array traces don't fire on scalar variables} { unset -nocomplain x set x foo @@ -1241,7 +1241,7 @@ test trace-18.2 {namespace delete / trace vdelete combo} { proc p1 args { trace vdelete ::foo::x u p1 } - trace variable ::foo::x u p1 + trace add variable ::foo::x unset p1 namespace delete ::foo info exists ::foo::x } 0 @@ -2420,7 +2420,7 @@ test trace-32.1 { test trace-33.1 {variable match with remove variable} { unset -nocomplain x - trace variable x w foo + trace add variable x write foo trace remove variable x write foo llength [trace info variable x] } 0 diff --git a/tests/upvar.test b/tests/upvar.test index 6330fa6..a394f4d 100644 --- a/tests/upvar.test +++ b/tests/upvar.test @@ -187,26 +187,26 @@ test upvar-4.2 {nested upvars} { proc tproc {args} {global x; set x [list $args [uplevel info vars]]} test upvar-5.1 {traces involving upvars} { - proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2} + proc p1 {a b} {set c 22; set d 33; trace add var c {read write} tproc; p2} proc p2 {} {upvar c x1; set x1 22} set x --- p1 foo bar set x -} {{x1 {} w} x1} +} {{x1 {} write} x1} test upvar-5.2 {traces involving upvars} { - proc p1 {a b} {set c 22; set d 33; trace var c rw tproc; p2} + proc p1 {a b} {set c 22; set d 33; trace add var c {read write} tproc; p2} proc p2 {} {upvar c x1; set x1} set x --- p1 foo bar set x -} {{x1 {} r} x1} +} {{x1 {} read} x1} test upvar-5.3 {traces involving upvars} { - proc p1 {a b} {set c 22; set d 33; trace var c rwu tproc; p2} + proc p1 {a b} {set c 22; set d 33; trace add var c {read write unset} tproc; p2} proc p2 {} {upvar c x1; unset x1} set x --- p1 foo bar set x -} {{x1 {} u} x1} +} {{x1 {} unset} x1} test upvar-5.4 {read trace on upvar array element} -body { proc p1 {a b} { array set foo {c 22 d 33} @@ -416,7 +416,7 @@ test upvar-8.6 {errors in upvar command} -returnCodes error -body { p1 } -result {variable "a" already exists} test upvar-8.7 {errors in upvar command} -returnCodes error -body { - proc p1 {} {trace variable a w foo; upvar b a} + proc p1 {} {trace add variable a write foo; upvar b a} p1 } -result {variable "a" has traces: can't use for upvar} test upvar-8.8 {create nested array with upvar} -body { diff --git a/tests/var.test b/tests/var.test index 864bec8..d4369b3 100644 --- a/tests/var.test +++ b/tests/var.test @@ -598,10 +598,10 @@ test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var variable info set info [concat $info [list $name1 $name2 $op]] } - trace var v u [namespace code traceUnset] + trace add var v unset [namespace code traceUnset] } list [unset test_ns_var::v] $test_ns_var::info -} -result {{} {test_ns_var::v {} u}} +} -result {{} {test_ns_var::v {} unset}} test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} -setup { catch {namespace delete test_ns_var} catch {unset a} @@ -609,13 +609,13 @@ test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called wit set info "" namespace eval test_ns_var { variable v 123 1 - trace var v u ::traceUnset + trace add var v unset ::traceUnset } proc traceUnset {name1 name2 op} { set ::info [concat $::info [list $name1 $name2 $op]] } list [namespace delete test_ns_var] $::info -} -result {{} {::test_ns_var::v {} u}} +} -result {{} {::test_ns_var::v {} unset}} test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup { proc ::t {a i o} { @@ -625,7 +625,7 @@ test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup { leaktest { namespace eval n { variable v 123 - trace variable v u ::t + trace add variable v unset ::t } namespace delete n } @@ -704,8 +704,8 @@ test var-9.9 {behaviour of TclGetVar read trace success} -setup { } -constraints testsetnoerr -body { proc resetvar {val name elem op} {upvar 1 $name v; set v $val} set u 10 - trace var u r [list resetvar 1] - trace var v r [list resetvar 2] + trace add var u read [list resetvar 1] + trace add var v read [list resetvar 2] list \ [testsetnoerr u] \ [testseterr v] @@ -713,7 +713,7 @@ test var-9.9 {behaviour of TclGetVar read trace success} -setup { test var-9.10 {behaviour of TclGetVar read trace error} testsetnoerr { proc writeonly args {error "write-only"} set v 456 - trace var v r writeonly + trace add var v read writeonly list \ [catch {testsetnoerr v} msg] $msg \ [catch {testseterr v} msg] $msg @@ -724,8 +724,8 @@ test var-9.11 {behaviour of TclSetVar write trace success} -setup { } -constraints testsetnoerr -body { proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]} set v 1 - trace var v w doubleval - trace var u w doubleval + trace add var v write doubleval + trace add var u write doubleval list \ [testsetnoerr u 2] \ [testseterr v 3] @@ -733,7 +733,7 @@ test var-9.11 {behaviour of TclSetVar write trace success} -setup { test var-9.12 {behaviour of TclSetVar write trace error} testsetnoerr { proc readonly args {error "read-only"} set v 456 - trace var v w readonly + trace add var v write readonly list \ [catch {testsetnoerr v 2} msg] $msg $v \ [catch {testseterr v 3} msg] $msg $v @@ -795,7 +795,7 @@ test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} -setup { } namespace eval :: { set t(1) 1 - trace variable t(1) u foo + trace add variable t(1) unset foo unset t } set x "If you see this, it worked" |
