summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2023-09-27 09:17:44 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2023-09-27 09:17:44 (GMT)
commit524d6bb36ec16228d711b48a3806f39100e388d2 (patch)
tree24202ebe9ed4b18e655054eb287e35ede662c21a
parentfffc4119bef3f1894ff2043a720b902b6a88adbe (diff)
downloadtcl-524d6bb36ec16228d711b48a3806f39100e388d2.zip
tcl-524d6bb36ec16228d711b48a3806f39100e388d2.tar.gz
tcl-524d6bb36ec16228d711b48a3806f39100e388d2.tar.bz2
Eliminate use of old deprecated trace subcommands from testcases
-rw-r--r--generic/tclTrace.c8
-rw-r--r--tests/append.test18
-rw-r--r--tests/appendComp.test32
-rw-r--r--tests/expr.test6
-rw-r--r--tests/if.test4
-rw-r--r--tests/init.test4
-rw-r--r--tests/link.test4
-rw-r--r--tests/namespace-old.test6
-rw-r--r--tests/proc-old.test18
-rw-r--r--tests/trace.test60
-rw-r--r--tests/upvar.test16
-rw-r--r--tests/var.test26
12 files changed, 101 insertions, 101 deletions
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 442ce02..dc90024 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -1979,10 +1979,10 @@ TraceVarProc(
int rewind = ((Interp *)interp)->execEnvPtr->rewind;
/*
- * We might call Tcl_Eval() below, and that might evaluate [trace vdelete]
- * which might try to free tvarPtr. We want to use tvarPtr until the end
- * of this function, so we use Tcl_Preserve() and Tcl_Release() to be sure
- * it is not freed while we still need it.
+ * We might call Tcl_EvalEx() below, and that might evaluate
+ * [trace remove variable] which might try to free tvarPtr. We want to
+ * use tvarPtr until the end of this function, so we use Tcl_Preserve()
+ * and Tcl_Release() to be sure it is not freed while we still need it.
*/
result = NULL;
diff --git a/tests/append.test b/tests/append.test
index 0b06c8f..d3131e8 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -6,7 +6,7 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -188,7 +188,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}
@@ -201,37 +201,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 0b2beb9..3a18404 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -6,7 +6,7 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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 2a0c7ed..b8d3ff6 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -5,7 +5,7 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-2000 by Scriptics Corporation.
+# Copyright (c) 1998-2000 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -356,7 +356,7 @@ test expr-8.11 {CompileEqualityExpr: error compiling equality arm} -body {
expr 2!=x
} -returnCodes error -match glob -result *
test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1
-test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \u00fc]}} 1
+test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \xFC]}} 1
test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0
test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1
@@ -802,7 +802,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 e589351..f718dcb 100644
--- a/tests/if.test
+++ b/tests/if.test
@@ -5,7 +5,7 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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/init.test b/tests/init.test
index 91df4a1..6aec865 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -5,7 +5,7 @@
# No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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 d37f08a..bd6a708 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -364,7 +364,7 @@ test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
trace var int w 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 variable int write x
return $x
} {{int {} w} 32 -2.0 0 xyzzy 995511}
test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
@@ -378,7 +378,7 @@ test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
testlink delete
trace var int w 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 variable 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 e4715f8..a67ec14 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -9,7 +9,7 @@
#
# Copyright (c) 1997 Sun Microsystems, Inc.
# Copyright (c) 1997 Lucent Technologies
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -631,13 +631,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 a92c6ab..4d1f0d7 100644
--- a/tests/proc-old.test
+++ b/tests/proc-old.test
@@ -9,7 +9,7 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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 variable 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/trace.test b/tests/trace.test
index c1e1a24..e303e9a 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
@@ -1234,23 +1234,23 @@ test trace-18.1 {unset traces on procedure returns} {
p1 foo bar
set info
} {0 {a x y}}
-test trace-18.2 {namespace delete / trace vdelete combo} {
+test trace-18.2 {namespace delete / trace remove variable combo} {
namespace eval ::foo {
variable x 123
}
proc p1 args {
- trace vdelete ::foo::x u p1
+ trace remove variable ::foo::x unset p1
}
- trace variable ::foo::x u p1
+ trace add variable ::foo::x unset p1
namespace delete ::foo
info exists ::foo::x
} 0
-test trace-18.3 {namespace delete / trace vdelete combo, Bug \#1337229} {
+test trace-18.3 {namespace delete / trace remove variable combo, Bug \#1337229} {
namespace eval ::ns {}
trace add variable ::ns::var unset {unset ::ns::var ;#}
namespace delete ::ns
} {}
-test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} {
+test trace-18.4 {namespace delete / trace remove variable combo, Bug \#1338280} {
namespace eval ::ref {}
set ::ref::var1 AAA
trace add variable ::ref::var1 unset doTrace
@@ -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 9e44a79..1ba6605 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -6,7 +6,7 @@
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -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-6.1 {retargeting an upvar} {
proc p1 {} {
@@ -328,7 +328,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 968337b..9ad63ac 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -9,7 +9,7 @@
# No output means no errors were found.
#
# Copyright (c) 1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -596,10 +596,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}
@@ -607,13 +607,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} {
@@ -623,7 +623,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
}
@@ -702,8 +702,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]
@@ -711,7 +711,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
@@ -722,8 +722,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]
@@ -731,7 +731,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
@@ -793,7 +793,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"