From e157c7129f3a72ca6d3711c857d55c57231eef29 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Wed, 30 Jan 2013 21:34:24 +0000
Subject: For traces, select modernizations from Patrick Fradlin.

---
 tests/trace.test | 295 +++++++++++++++++++++++++++----------------------------
 1 file changed, 145 insertions(+), 150 deletions(-)

diff --git a/tests/trace.test b/tests/trace.test
index b1202b8..9c3a686 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -11,10 +11,8 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace import ::tcltest::*
 
 testConstraint testcmdtrace [llength [info commands testcmdtrace]]
 testConstraint testevalobjv [llength [info commands testevalobjv]]
@@ -29,15 +27,15 @@ proc getbytes {} {
 
 proc traceScalar {name1 name2 op} {
     global info
-    set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
+    set info [list $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg]
 }
 proc traceScalarAppend {name1 name2 op} {
     global info
-    lappend info $name1 $name2 $op [catch {uplevel set $name1} msg] $msg
+    lappend info $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg
 }
 proc traceArray {name1 name2 op} {
     global info
-    set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg]
+    set info [list $name1 $name2 $op [catch {uplevel 1 set [set name1]($name2)} msg] $msg]
 }
 proc traceArray2 {name1 name2 op} {
     global info
@@ -59,7 +57,7 @@ proc traceCheck {cmd args} {
     set info [list [catch $cmd msg] $msg]
 }
 proc traceCrtElement {value name1 name2 op} {
-    uplevel set ${name1}($name2) $value
+    uplevel 1 set ${name1}($name2) $value
 }
 proc traceCommand {oldName newName op} {
     global info
@@ -69,10 +67,10 @@ proc traceCommand {oldName newName op} {
 test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
     # You may need Purify or Electric Fence to reliably
     # see this one fail.
-    catch {unset z}
+    unset -nocomplain z
     trace add variable z array {set z(foo) 1 ;#}
     set res "names: [array names z]"
-    catch {unset ::z}
+    unset -nocomplain ::z
     trace variable ::z w {unset ::z; error "memory corruption";#}
     list [catch {set ::z 1} msg] $msg
 } {1 {can't set "::z": memory corruption}}
@@ -80,40 +78,40 @@ test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
 # Read-tracing on variables
 
 test trace-1.1 {trace variable reads} {
-    catch {unset x}
+    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} {
-    catch {unset x}
+    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} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read traceScalar
     set x 123
     set info
 } {}
 test trace-1.4 {trace array element reads} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(2) read traceArray
     list [catch {set x(2)} msg] $msg $info
 } {1 {can't read "x(2)": no such element in array} {x 2 read 1 {can't read "x(2)": no such element in array}}}
 test trace-1.5 {trace array element reads} {
-    catch {unset x}
+    unset -nocomplain x
     set x(2) zzz
     set info {}
     trace add variable x(2) read traceArray
     list [catch {set x(2)} msg] $msg $info
 } {0 zzz {x 2 read 0 zzz}}
 test trace-1.6 {trace array element reads} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read traceArray2
     proc p {} {
@@ -124,7 +122,7 @@ test trace-1.6 {trace array element reads} {
     list [catch {p} msg] $msg $info
 } {0 willi {x 2 read}}
 test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read q
     proc q {name1 name2 op} {
@@ -141,20 +139,20 @@ test trace-1.7 {trace array element reads, create element undefined if nonexista
     list [catch {p} msg] $msg $info
 } {0 wolf {x Y read}}
 test trace-1.8 {trace reads on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read traceArray
     list [catch {set x(2)} msg] $msg $info
 } {1 {can't read "x(2)": no such variable} {}}
 test trace-1.9 {trace reads on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set x(2) zzz
     set info {}
     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} {
-    catch {unset x}
+    unset -nocomplain x
     set x 444
     set info {}
     trace add variable x read traceScalar
@@ -162,28 +160,28 @@ test trace-1.10 {trace variable reads} {
     set info
 } {}
 test trace-1.11 {read traces that modify the array structure} {
-    catch {unset x}
+    unset -nocomplain x
     set x(bar) 0 
     trace variable x r {set x(foo) 1 ;#} 
     trace variable x r {unset -nocomplain x(bar) ;#} 
     array get x
 } {}
 test trace-1.12 {read traces that modify the array structure} {
-    catch {unset x}
+    unset -nocomplain x
     set x(bar) 0 
     trace variable x r {unset -nocomplain x(bar) ;#} 
     trace variable x r {set x(foo) 1 ;#} 
     array get x
 } {}
 test trace-1.13 {read traces that modify the array structure} {
-    catch {unset x}
+    unset -nocomplain x
     set x(bar) 0 
     trace variable x r {set x(foo) 1 ;#} 
     trace variable x r {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} {
-    catch {unset x}
+    unset -nocomplain x
     set x(bar) 0 
     trace variable x r {unset -nocomplain x;#} 
     trace variable x r {set x(foo) 1 ;#} 
@@ -193,28 +191,28 @@ test trace-1.14 {read traces that modify the array structure} {
 # Basic write-tracing on variables
 
 test trace-2.1 {trace variable writes} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceScalar
     set x 123
     set info
 } {x {} write 0 123}
 test trace-2.2 {trace writes to array elements} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(33) write traceArray
     set x(33) 444
     set info
 } {x 33 write 0 444}
 test trace-2.3 {trace writes on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceArray
     set x(abc) qq
     set info
 } {x abc write 0 qq}
 test trace-2.4 {trace variable writes} {
-    catch {unset x}
+    unset -nocomplain x
     set x 1234
     set info {}
     trace add variable x write traceScalar
@@ -222,7 +220,7 @@ test trace-2.4 {trace variable writes} {
     set info
 } {}
 test trace-2.5 {trace variable writes} {
-    catch {unset x}
+    unset -nocomplain x
     set x 1234
     set info {}
     trace add variable x write traceScalar
@@ -235,7 +233,7 @@ test trace-2.6 {trace variable writes on compiled local} {
     # arrays [Bug 1770591]. The corresponding function for read traces is
     # already indirectly tested in trace-1.7
     #
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     proc p {} {
 	trace add variable x write traceArray
@@ -264,7 +262,7 @@ test trace-2.7 {trace variable writes on errorInfo} -body {
 # trace: after appending all arguments to the list.
 
 test trace-3.1 {trace variable read-modify-writes} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read traceScalarAppend
     append x 123
@@ -273,7 +271,7 @@ test trace-3.1 {trace variable read-modify-writes} {
     set info
 } {x {} read 0 123456}
 test trace-3.2 {trace variable read-modify-writes} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x {read write} traceScalarAppend
     append x 123
@@ -284,14 +282,14 @@ test trace-3.2 {trace variable read-modify-writes} {
 # Basic unset-tracing on variables
 
 test trace-4.1 {trace variable unsets} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x unset traceScalar
-    catch {unset x}
+    unset -nocomplain x
     set info
 } {x {} unset 1 {can't read "x": no such variable}}
 test trace-4.2 {variable mustn't exist during unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x 1234
     set info {}
     trace add variable x unset traceScalar
@@ -299,7 +297,7 @@ test trace-4.2 {variable mustn't exist during unset trace} {
     set info
 } {x {} unset 1 {can't read "x": no such variable}}
 test trace-4.3 {unset traces mustn't be called during reads and writes} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x unset traceScalar
     set x 44
@@ -307,15 +305,15 @@ test trace-4.3 {unset traces mustn't be called during reads and writes} {
     set info
 } {}
 test trace-4.4 {trace unsets on array elements} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 18
     set info {}
     trace add variable x(1) unset traceArray
-    catch {unset x(1)}
+    unset -nocomplain x(1)
     set info
 } {x 1 unset 1 {can't read "x(1)": no such element in array}}
 test trace-4.5 {trace unsets on array elements} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set info {}
     trace add variable x(1) unset traceArray
@@ -323,7 +321,7 @@ test trace-4.5 {trace unsets on array elements} {
     set info
 } {x 1 unset 1 {can't read "x(1)": no such element in array}}
 test trace-4.6 {trace unsets on array elements} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set info {}
     trace add variable x(1) unset traceArray
@@ -331,15 +329,15 @@ test trace-4.6 {trace unsets on array elements} {
     set info
 } {x 1 unset 1 {can't read "x(1)": no such variable}}
 test trace-4.7 {trace unsets on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set info {}
     trace add variable x unset traceProc
-    catch {unset x(0)}
+    unset -nocomplain x(0)
     set info
 } {}
 test trace-4.8 {trace unsets on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set x(2) 144
     set x(3) 14
@@ -349,7 +347,7 @@ test trace-4.8 {trace unsets on whole arrays} {
     set info
 } {x 1 unset}
 test trace-4.9 {trace unsets on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set x(2) 144
     set x(3) 14
@@ -361,7 +359,7 @@ test trace-4.9 {trace unsets on whole arrays} {
 
 # Array tracing on variables
 test trace-5.1 {array traces fire on accesses via [array]} {
-    catch {unset x}
+    unset -nocomplain x
     set x(b) 2
     trace add variable x array traceArray2
     set ::info {}
@@ -369,7 +367,7 @@ test trace-5.1 {array traces fire on accesses via [array]} {
     set ::info
 } {x {} array}
 test trace-5.2 {array traces do not fire on normal accesses} {
-    catch {unset x}
+    unset -nocomplain x
     set x(b) 2
     trace add variable x array traceArray2
     set ::info {}
@@ -378,7 +376,7 @@ test trace-5.2 {array traces do not fire on normal accesses} {
     set ::info
 } {}
 test trace-5.3 {array traces do not outlive variable} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x array traceArray2
     set ::info {}
     set x(a) 1
@@ -387,19 +385,19 @@ test trace-5.3 {array traces do not outlive variable} {
     set ::info
 } {}
 test trace-5.4 {array traces properly listed in trace information} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x array traceArray2
     set result [trace info variable x]
     set result
 } [list [list array traceArray2]]
 test trace-5.5 {array traces properly listed in trace information} {
-    catch {unset x}
+    unset -nocomplain x
     trace variable x a traceArray2
     set result [trace vinfo x]
     set result
 } [list [list a traceArray2]]
 test trace-5.6 {array traces don't fire on scalar variables} {
-    catch {unset x}
+    unset -nocomplain x
     set x foo
     trace add variable x array traceArray2
     set ::info {}
@@ -407,14 +405,14 @@ test trace-5.6 {array traces don't fire on scalar variables} {
     set ::info
 } {}
 test trace-5.7 {array traces fire for undefined variables} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x array traceArray2
     set ::info {}
     array set x {a 1}
     set ::info
 } {x {} array}
 test trace-5.8 {array traces fire for undefined variables} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x array {set x(foo) 1 ;#}
     set res "names: [array names x]"
 } {names: foo}
@@ -422,7 +420,7 @@ test trace-5.8 {array traces fire for undefined variables} {
 # Trace multiple trace types at once.
 
 test trace-6.1 {multiple ops traced at once} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x {read write unset} traceProc
     catch {set x}
@@ -433,7 +431,7 @@ test trace-6.1 {multiple ops traced at once} {
     set info
 } {x {} read x {} write x {} read x {} write x {} unset}
 test trace-6.2 {multiple ops traced on array element} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(0) {read write unset} traceProc
     catch {set x(0)}
@@ -445,7 +443,7 @@ test trace-6.2 {multiple ops traced on array element} {
     set info
 } {x 0 read x 0 write x 0 read x 0 write x 0 unset}
 test trace-6.3 {multiple ops traced on whole array} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x {read write unset} traceProc
     catch {set x(0)}
@@ -460,7 +458,7 @@ test trace-6.3 {multiple ops traced on whole array} {
 # Check order of invocation of traces
 
 test trace-7.1 {order of invocation of traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read "traceTag 1"
     trace add variable x read "traceTag 2"
@@ -471,7 +469,7 @@ test trace-7.1 {order of invocation of traces} {
     set info
 } {3 2 1 3 2 1}
 test trace-7.2 {order of invocation of traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 44
     set info {}
     trace add variable x(0) read "traceTag 1"
@@ -481,7 +479,7 @@ test trace-7.2 {order of invocation of traces} {
     set info
 } {3 2 1}
 test trace-7.3 {order of invocation of traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 44
     set info {}
     trace add variable x(0) read "traceTag 1"
@@ -497,7 +495,7 @@ test trace-7.3 {order of invocation of traces} {
 # Check effects of errors in trace procedures
 
 test trace-8.1 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     set info {}
     trace add variable x read "traceTag 1"
@@ -505,7 +503,7 @@ test trace-8.1 {error returns from traces} {
     list [catch {set x} msg] $msg $info
 } {1 {can't read "x": trace returned error} {}}
 test trace-8.2 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     set info {}
     trace add variable x write "traceTag 1"
@@ -513,14 +511,14 @@ test trace-8.2 {error returns from traces} {
     list [catch {set x 44} msg] $msg $info
 } {1 {can't set "x": trace returned error} {}}
 test trace-8.3 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain 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-8.4 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     set info {}
     trace add variable x unset "traceTag 1"
@@ -528,7 +526,7 @@ test trace-8.4 {error returns from traces} {
     list [catch {unset x} msg] $msg $info
 } {0 {} 1}
 test trace-8.5 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 123
     set info {}
     trace add variable x(0) read "traceTag 1"
@@ -538,7 +536,7 @@ test trace-8.5 {error returns from traces} {
     list [catch {set x(0)} msg] $msg $info
 } {1 {can't read "x(0)": trace returned error} 3}
 test trace-8.6 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     trace add variable x unset traceError
     list [catch {unset x} msg] $msg
@@ -547,7 +545,7 @@ 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.
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     trace add variable x read traceError
     catch {set x}
@@ -568,7 +566,7 @@ test trace-8.8 {error returns from traces} {
 	trace add    variable ::x write [list foo $::x]
 	error "foo"
     }
-    catch {unset ::x ::y}
+    unset -nocomplain ::x ::y
     set x junk
     trace add variable ::x write [list foo $x]
     for {set y 0} {$y<100} {incr y} {
@@ -582,31 +580,31 @@ test trace-8.8 {error returns from traces} {
 # a new copy of the variables.
 
 test trace-9.1 {be sure variable is unset before trace is called} {
-    catch {unset x}
+    unset -nocomplain x
     set x 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel set x}}
+    trace add variable x unset {traceCheck {uplevel 1 set x}}
     unset x
     set info
 } {1 {can't read "x": no such variable}}
 test trace-9.2 {be sure variable is unset before trace is called} {
-    catch {unset x}
+    unset -nocomplain x
     set x 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel set x 22}}
+    trace add variable x unset {traceCheck {uplevel 1 set x 22}}
     unset x
     concat $info [list [catch {set x} msg] $msg]
 } {0 22 0 22}
 test trace-9.3 {be sure traces are cleared before unset trace called} {
-    catch {unset x}
+    unset -nocomplain x
     set x 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel trace info variable x}}
+    trace add variable x unset {traceCheck {uplevel 1 trace info variable x}}
     unset x
     set info
 } {0 {}}
 test trace-9.4 {set new trace during unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x 33
     set info {}
     trace add variable x unset {traceCheck {global x; trace add variable x unset traceProc}}
@@ -615,23 +613,23 @@ test trace-9.4 {set new trace during unset trace} {
 } {0 {} {unset traceProc}}
 
 test trace-10.1 {make sure array elements are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
-    trace add variable x(0) unset {traceCheck {uplevel set x(0)}}
+    trace add variable x(0) unset {traceCheck {uplevel 1 set x(0)}}
     unset x(0)
     set info
 } {1 {can't read "x(0)": no such element in array}}
 test trace-10.2 {make sure array elements are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
-    trace add variable x(0) unset {traceCheck {uplevel set x(0) zzz}}
+    trace add variable x(0) unset {traceCheck {uplevel 1 set x(0) zzz}}
     unset x(0)
     concat $info [list [catch {set x(0)} msg] $msg]
 } {0 zzz 0 zzz}
 test trace-10.3 {array elements are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
     trace add variable x(0) unset {traceCheck {global x; trace info variable x(0)}}
@@ -639,49 +637,49 @@ test trace-10.3 {array elements are unset before traces are called} {
     set info
 } {0 {}}
 test trace-10.4 {set new array element trace during unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
-    trace add variable x(0) unset {traceCheck {uplevel {trace add variable x(0) read {}}}}
-    catch {unset x(0)}
+    trace add variable x(0) unset {traceCheck {uplevel 1 {trace add variable x(0) read {}}}}
+    unset -nocomplain x(0)
     concat $info [trace info variable x(0)]
 } {0 {} {read {}}}
 
 test trace-11.1 {make sure arrays are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel set x(0)}}
+    trace add variable x unset {traceCheck {uplevel 1 set x(0)}}
     unset x
     set info
 } {1 {can't read "x(0)": no such variable}}
 test trace-11.2 {make sure arrays are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel set x(y) 22}}
+    trace add variable x unset {traceCheck {uplevel 1 set x(y) 22}}
     unset x
     concat $info [list [catch {set x(y)} msg] $msg]
 } {0 22 0 22}
 test trace-11.3 {make sure arrays are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel array exists x}}
+    trace add variable x unset {traceCheck {uplevel 1 array exists x}}
     unset x
     set info
 } {0 0}
 test trace-11.4 {make sure arrays are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
-    set cmd {traceCheck {uplevel {trace info variable x}}}
+    set cmd {traceCheck {uplevel 1 {trace info variable x}}}
     trace add variable x unset $cmd
     unset x
     set info
 } {0 {}}
 test trace-11.5 {set new array trace during unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
     trace add variable x unset {traceCheck {global x; trace add variable x read {}}}
@@ -689,7 +687,7 @@ test trace-11.5 {set new array trace during unset trace} {
     concat $info [trace info variable x]
 } {0 {} {read {}}}
 test trace-11.6 {create scalar during array unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
     trace add variable x unset {traceCheck {global x; set x 44}}
@@ -700,52 +698,52 @@ test trace-11.6 {create scalar during array unset trace} {
 # Check special conditions (e.g. errors) in Tcl_TraceVar2.
 
 test trace-12.1 {creating array when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain 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-12.2 {creating array when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain 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-12.3 {creating array when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(0) write traceProc
     set x(0) 22
     set info
 } {x 0 write}
 test trace-12.4 {creating variable when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain 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-12.5 {creating variable when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceProc
     set x 22
     set info
 } {x {} write}
 test trace-12.6 {creating variable when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceProc
     set x(0) 22
     set info
 } {x 0 write}
 test trace-12.7 {create array element during read trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x(2) zzz
     trace add variable x read {traceCrtElement xyzzy}
     list [catch {set x(3)} msg] $msg
 } {0 xyzzy}
 test trace-12.8 {errors when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 44
     list [catch {trace add variable x(0) write traceProc} msg] $msg
 } {1 {can't trace "x(0)": variable isn't array}}
@@ -759,7 +757,7 @@ test trace-13.1 {delete one trace from another} {
 	trace remove variable x read {traceTag 3}
 	trace remove variable x read {traceTag 4}
     }
-    catch {unset x}
+    unset -nocomplain x
     set x 44
     set info {}
     trace add variable x read {traceTag 1}
@@ -913,13 +911,13 @@ test trace-14.11 {trace command, "trace variable" errors} {
 
 
 test trace-14.12 {trace command ("remove variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceProc
     trace remove variable x write traceProc
 } {}
 test trace-14.13 {trace command ("remove variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceProc
     trace remove variable x write traceProc
@@ -927,7 +925,7 @@ test trace-14.13 {trace command ("remove variable" option)} {
     set info
 } {}
 test trace-14.14 {trace command ("remove variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write {traceTag 1}
     trace add variable x write traceProc
@@ -942,7 +940,7 @@ test trace-14.14 {trace command ("remove variable" option)} {
     set info
 } {2 x {} write 1 2 1 2}
 test trace-14.15 {trace command ("remove variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write {traceTag 1}
     trace remove variable x write non_existent
@@ -950,27 +948,27 @@ test trace-14.15 {trace command ("remove variable" option)} {
     set info
 } {1}
 test trace-14.16 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x write {traceTag 1}
     trace add variable x write traceProc
     trace add variable x write {traceTag 2}
     trace info variable x
 } {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
 test trace-14.17 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     trace info variable x
 } {}
 test trace-14.18 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     trace info variable x(0)
 } {}
 test trace-14.19 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set x 44
     trace info variable x(0)
 } {}
 test trace-14.20 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set x 44
     trace add variable x write {traceTag 1}
     proc check {} {global x; trace info variable x}
@@ -980,7 +978,7 @@ test trace-14.20 {trace command ("info variable" option)} {
 # Check fancy trace commands (long ones, weird arguments, etc.)
 
 test trace-15.1 {long trace command} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write {traceTag {This is a very very long argument.  It's \
 	designed to test out the facilities of TraceVarProc for dealing \
@@ -998,14 +996,14 @@ 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"}
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x write longResult
     set x 44
     set x 5
     set x abcde
 } abcde
 test trace-15.3 {special list-handling in trace commands} {
-    catch {unset "x y z"}
+    unset -nocomplain "x y z"
     set "x y z(a\n\{)" 44
     set info {}
     trace add variable "x y z(a\n\{)" write traceProc
@@ -1017,18 +1015,18 @@ test trace-15.3 {special list-handling in trace commands} {
 
 proc traceUnset {unsetName args} {
     global info
-    upvar $unsetName x
+    upvar 1 $unsetName x
     lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg
 }
 proc traceReset {unsetName resetName args} {
     global info
-    upvar $unsetName x $resetName y
+    upvar 1 $unsetName x $resetName y
     lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg
 }
 proc traceReset2 {unsetName resetName args} {
     global info
-    lappend info [catch {uplevel unset $unsetName} msg] $msg \
-	    [catch {uplevel set $resetName xyzzy} msg] $msg
+    lappend info [catch {uplevel 1 unset $unsetName} msg] $msg \
+	    [catch {uplevel 1 set $resetName xyzzy} msg] $msg
 }
 proc traceAppend {string name1 name2 op} {
     global info
@@ -1036,7 +1034,7 @@ proc traceAppend {string name1 name2 op} {
 }
 
 test trace-16.1 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y read {traceUnset y}
@@ -1044,49 +1042,49 @@ test trace-16.1 {unsets during read traces} {
     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-16.2 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.3 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.4 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.5 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.6 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.7 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.8 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y write {traceUnset y}
@@ -1094,91 +1092,91 @@ test trace-16.8 {unsets during write traces} {
     lappend info [catch {set y xxx} msg] $msg
 } {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
 test trace-16.9 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.10 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.11 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.12 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.13 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.14 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.15 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.16 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.17 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.18 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.19 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.20 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain 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-16.21 {unsets cancelling traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y read {traceAppend first}
@@ -1188,7 +1186,7 @@ test trace-16.21 {unsets cancelling traces} {
     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-16.22 {unsets cancelling traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) read {traceAppend first}
@@ -1201,19 +1199,19 @@ test trace-16.22 {unsets cancelling traces} {
 # Check various non-interference between traces and other things.
 
 test trace-17.1 {trace doesn't prevent unset errors} {
-    catch {unset x}
+    unset -nocomplain 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-17.2 {traced variables must survive procedure exits} {
-    catch {unset x}
+    unset -nocomplain x
     proc p1 {} {global x; trace add variable x write traceProc}
     p1
     trace info variable x
 } {{write traceProc}}
 test trace-17.3 {traced variables must survive procedure exits} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     proc p1 {} {global x; trace add variable x write traceProc}
     p1
@@ -1226,7 +1224,7 @@ test trace-17.3 {traced variables must survive procedure exits} {
 
 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}]}}}
+    proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}}
     set info {}
     p1 foo bar
     set info
@@ -1266,8 +1264,7 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} {
 # Delete arrays when done, so they can be re-used as scalars
 # elsewhere.
 
-catch {unset x}
-catch {unset y}
+unset -nocomplain x y
 
 test trace-19.0.1 {trace add command (command existence)} {
     # Just in case!
@@ -1539,8 +1536,7 @@ proc foo {b} { set a $b }
 # Delete arrays when done, so they can be re-used as scalars
 # elsewhere.
 
-catch {unset x}
-catch {unset y}
+unset -nocomplain x y
 
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
@@ -2047,7 +2043,7 @@ test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)}
     trace remove execution foo {enter enterstep leavestep leave} \
         [list traceExecute foo]
     rename foo {}
-    catch {unset a}
+    unset -nocomplain a
     join $info "\n"
 } {foo foo enter
 foo {set a 1} enterstep
@@ -2631,9 +2627,8 @@ catch {rename traceproc {}}
 catch {rename runbase {}}
 
 # Unset the variable when done
-catch {unset info}
-catch {unset base}
+unset -nocomplain info base
 
 # cleanup
-::tcltest::cleanupTests
+cleanupTests
 return
-- 
cgit v0.12


From f385174158496b543825ede31d40b25de7196e51 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 31 Jan 2013 04:29:30 +0000
Subject: For embedding support, select modernizations from Patrick Fradin

---
 tests/main.test | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/tests/main.test b/tests/main.test
index cdd3b17..324b594 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -137,7 +137,7 @@ namespace eval ::tcl::test::main {
 	set script [makeFile {} script]
 	file delete $script
 	set f [open $script w]
-	fconfigure $f -encoding utf-8
+	chan configure $f -encoding utf-8
 	puts $f {puts [list $argv0 $argv $tcl_interactive]}
 	puts -nonewline $f {puts [string equal \u20ac }
 	puts $f "\u20ac]"
@@ -158,7 +158,7 @@ namespace eval ::tcl::test::main {
 	set script [makeFile {} script]
 	file delete $script
 	set f [open $script w]
-	fconfigure $f -encoding utf-8
+	chan configure $f -encoding utf-8
 	puts $f {puts [list $argv0 $argv $tcl_interactive]}
 	puts -nonewline $f {puts [string equal \u20ac }
 	puts $f "\u20ac]"
@@ -179,7 +179,7 @@ namespace eval ::tcl::test::main {
 	set script [makeFile {} script]
 	file delete $script
 	set f [open $script w]
-	fconfigure $f -encoding utf-8
+	chan configure $f -encoding utf-8
 	puts $f {puts [list $argv0 $argv $tcl_interactive]}
 	puts -nonewline $f {puts [string equal \u20ac }
 	puts $f "\u20ac]"
@@ -600,7 +600,7 @@ namespace eval ::tcl::test::main {
 	catch {set f [open "|[list [interpreter]]" w+]}
     } -body {
 	type $f {
-	    fconfigure stdin -blocking 0
+	    chan configure stdin -blocking 0
 	    puts SUCCESS
 	}
 	list [catch {gets $f} line] $line
@@ -614,19 +614,19 @@ namespace eval ::tcl::test::main {
 	exec
     } -setup {
 	catch {set f [open "|[list [interpreter]]" w+]}
-	catch {fconfigure $f -blocking 0}
+	catch {chan configure $f -blocking 0}
     } -body {
-	type $f "fconfigure stdin -eofchar \\032
+	type $f "chan configure stdin -eofchar \\032
 	    if 1 \{\n\032"
 	variable wait
-	fileevent $f readable \
+	chan event $f readable \
 		[list set [namespace which -variable wait] "child exit"]
 	set id [after 2000 [list set [namespace which -variable wait] timeout]]
 	vwait [namespace which -variable wait]
 	after cancel $id
 	set wait
     } -cleanup {
-	if {[string equal timeout $wait] && [testConstraint unix]} {
+	if {$wait eq "timeout" && [testConstraint unix]} {
 	    exec kill [pid $f]
 	}
 	close $f
@@ -639,17 +639,17 @@ namespace eval ::tcl::test::main {
     } -setup {
 	set cmd {makeFile "if 1 \{" script}
 	catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]}
-	catch {fconfigure $f -blocking 0}
+	catch {chan configure $f -blocking 0}
     } -body {
 	variable wait
-	fileevent $f readable \
+	chan event $f readable \
 		[list set [namespace which -variable wait] "child exit"]
 	set id [after 2000 [list set [namespace which -variable wait] timeout]]
 	vwait [namespace which -variable wait]
 	after cancel $id
 	set wait
     } -cleanup {
-	if {[string equal timeout $wait] && [testConstraint unix]} {
+	if {$wait eq "timeout" && [testConstraint unix]} {
 	    exec kill [pid $f]
 	}
 	close $f
@@ -756,7 +756,7 @@ namespace eval ::tcl::test::main {
 	exec Tcltest
     } -setup {
 	catch {set f [open "|[list [interpreter]]" w+]}
-	catch {fconfigure $f -blocking 0}
+	catch {chan configure $f -blocking 0}
     } -body {
 	type $f "testsetmainloop
 	         after 2000 testexitmainloop
@@ -991,7 +991,7 @@ namespace eval ::tcl::test::main {
     } -body {
 	exec [interpreter] << {
 		testsetmainloop
-		fconfigure stdin -blocking 0
+		chan configure stdin -blocking 0
 		testexitmainloop
 	} >& result
 	set f [open result]
-- 
cgit v0.12