merge

11 files changed, 729 insertions, 672 deletions

diff --git a/tests/append.test b/tests/append.test
index 3c000df..c6120f2 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -11,16 +11,16 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: append.test,v 1.12 2010/09/01 20:35:33 andreas_kupries Exp $
+# RCS: @(#) $Id: append.test,v 1.12.2.1 2010/12/11 18:39:29 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
-catch {unset x}
-
+unset -nocomplain x
+
 test append-1.1 {append command} {
-    catch {unset x}
+    unset -nocomplain x
     list [append x 1 2 abc "long string"] $x
 } {{12abclong string} {12abclong string}}
 test append-1.2 {append command} {
@@ -52,12 +52,12 @@ test append-3.2 {append errors} -returnCodes error -body {
     append x(0) 44
 } -result {can't set "x(0)": variable isn't array}
 test append-3.3 {append errors} -returnCodes error -body {
-    catch {unset x}
+    unset -nocomplain x
     append x
 } -result {can't read "x": no such variable}
 
 test append-4.1 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     list [lappend x 1 2 abc "long string"] $x
 } {{1 2 abc {long string}} {1 2 abc {long string}}}
 test append-4.2 {lappend command} {
@@ -128,19 +128,19 @@ test append-4.16 {lappend command} {
     lappend x abc
 } "x abc"
 test append-4.17 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     lappend x
 } {}
 test append-4.18 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     lappend x {}
 } {{}}
 test append-4.19 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     lappend x(0)
 } {}
 test append-4.20 {lappend command} {
-    catch {unset x}
+    unset -nocomplain x
     lappend x(0) abc
 } {abc}
 unset -nocomplain x
@@ -154,7 +154,7 @@ test append-4.22 {lappend command} -returnCodes error -body {
 } -result {unmatched open quote in list}
 
 test append-5.1 {long lappends} -setup {
-    catch {unset x}
+    unset -nocomplain x
     proc check {var size} {
 	set l [llength $var]
 	if {$l != $size} {
@@ -188,7 +188,7 @@ test append-6.2 {lappend errors} -returnCodes error -body {
 
 test append-7.1 {lappend-created var and error in trace on that var} -setup {
     catch {rename foo ""}
-    catch {unset x}
+    unset -nocomplain x
 } -body {
     trace variable x w foo
     proc foo {} {global x; unset x}
@@ -200,8 +200,8 @@ test append-7.1 {lappend-created var and error in trace on that var} -setup {
     list [info exists x] [catch {set x} msg] $msg
 } -result {0 1 {can't read "x": no such variable}}
 test append-7.2 {lappend var triggers read trace} -setup {
-    catch {unset myvar}
-    catch {unset ::result}
+    unset -nocomplain myvar
+    unset -nocomplain ::result
 } -body {
     trace variable myvar r foo
     proc foo {args} {append ::result $args}
@@ -209,8 +209,8 @@ test append-7.2 {lappend var triggers read trace} -setup {
     return $::result
 } -result {myvar {} r}
 test append-7.3 {lappend var triggers read trace, array var} -setup {
-    catch {unset myvar}
-    catch {unset ::result}
+    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.
@@ -220,8 +220,8 @@ test append-7.3 {lappend var triggers read trace, array var} -setup {
     return $::result
 } -result {myvar b r}
 test append-7.4 {lappend var triggers read trace, array var exists} -setup {
-    catch {unset myvar}
-    catch {unset ::result}
+    unset -nocomplain myvar
+    unset -nocomplain ::result
 } -body {
     set myvar(0) 1
     trace variable myvar r foo
@@ -230,8 +230,8 @@ test append-7.4 {lappend var triggers read trace, array var exists} -setup {
     return $::result
 } -result {myvar b r}
 test append-7.5 {append var does not trigger read trace} -setup {
-    catch {unset myvar}
-    catch {unset ::result}
+    unset -nocomplain myvar
+    unset -nocomplain ::result
 } -body {
     trace variable myvar r foo
     proc foo {args} {append ::result $args}
@@ -239,15 +239,16 @@ test append-7.5 {append var does not trigger read trace} -setup {
     info exists ::result
 } -result {0}
 
+# THERE ARE NO append-8.* TESTS
 
+# New tests for bug 3057639 to show off the more consistent behaviour of
+# lappend in both direct-eval and bytecompiled code paths (see appendComp.test
+# for the compiled variants). lappend now behaves like append. 9.0/1 lappend -
+# 9.2/3 append
 
-# New tests for bug 3057639 to show off the more consistent behaviour
-# of lappend in both direct-eval and bytecompiled code paths (see
-# appendComp.test for the compiled variants). lappend now behaves like
-# append. 9.0/1 lappend - 9.2/3 append
-
-test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} {
-    catch {unset myvar}
+test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing array variable element} -setup {
+    unset -nocomplain myvar
+} -body {
     array set myvar {}
     proc nonull {var key val} {
 	upvar 1 $var lvar
@@ -259,17 +260,19 @@ test append-9.0 {bug 3057639, lappend direct eval, read trace on non-existing ar
     list [catch {
 	lappend myvar(key) "new value"
     } msg] $msg
-} {0 {{new value}}}
-
-test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} {
-    catch {unset ::env(__DUMMY__)}
+} -result {0 {{new value}}}
+test append-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup {
+    unset -nocomplain ::env(__DUMMY__)
+} -body {
     list [catch {
 	lappend ::env(__DUMMY__) "new value"
     } msg] $msg
-} {0 {{new value}}}
-
-test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} {
-    catch {unset myvar}
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {{new value}}}
+test append-9.2 {bug 3057639, append direct eval, read trace on non-existing array variable element} -setup {
+    unset -nocomplain myvar
+} -body {
     array set myvar {}
     proc nonull {var key val} {
 	upvar 1 $var lvar
@@ -281,19 +284,25 @@ test append-9.2 {bug 3057639, append direct eval, read trace on non-existing arr
     list [catch {
 	append myvar(key) "new value"
     } msg] $msg
-} {0 {new value}}
-
-test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} {
-    catch {unset ::env(__DUMMY__)}
+} -result {0 {new value}}
+test append-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup {
+    unset -nocomplain ::env(__DUMMY__)
+} -body {
     list [catch {
 	append ::env(__DUMMY__) "new value"
     } msg] $msg
-} {0 {new value}}
-
-
-catch {unset i x result y}
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
+unset -nocomplain i x result y
 catch {rename foo ""}
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/appendComp.test b/tests/appendComp.test
index 9523d2d..93323fb 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -11,19 +11,20 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: appendComp.test,v 1.13 2010/09/01 20:35:33 andreas_kupries Exp $
+# RCS: @(#) $Id: appendComp.test,v 1.13.2.1 2010/12/11 18:39:30 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 catch {unset x}
-
-test appendComp-1.1 {append command} {
-    catch {unset x}
+
+test appendComp-1.1 {append command} -setup {
+    unset -nocomplain x
+} -body {
     proc foo {} {append ::x 1 2 abc "long string"}
     list [foo] $x
-} {{12abclong string} {12abclong string}}
+} -result {{12abclong string} {12abclong string}}
 test appendComp-1.2 {append command} {
     proc foo {} {
 	set x ""
@@ -67,7 +68,7 @@ test appendComp-3.2 {append errors} -returnCodes error -body {
 } -result {can't set "x(0)": variable isn't array}
 test appendComp-3.3 {append errors} -returnCodes error -body {
     proc foo {} {
-	catch {unset x}
+	unset -nocomplain x
 	append x
     }
     foo
@@ -76,7 +77,7 @@ test appendComp-3.3 {append errors} -returnCodes error -body {
 test appendComp-4.1 {lappend command} {
     proc foo {} {
 	global x
-	catch {unset x}
+	unset -nocomplain x
 	lappend x 1 2 abc "long string"
     }
     list [foo] $x
@@ -207,27 +208,31 @@ test appendComp-4.20 {lappend command} {
     foo
 } {abc}
 
-proc check {var size} {
-    set l [llength $var]
-    if {$l != $size} {
-	return "length mismatch: should have been $size, was $l"
-    }
-    for {set i 0} {$i < $size} {set i [expr $i+1]} {
-	set j [lindex $var $i]
-	if {$j != "item $i"} {
-	    return "element $i should have been \"item $i\", was \"$j\""
+test appendComp-5.1 {long lappends} -setup {
+    unset -nocomplain x
+    proc check {var size} {
+	set l [llength $var]
+	if {$l != $size} {
+	    return "length mismatch: should have been $size, was $l"
 	}
+	for {set i 0} {$i < $size} {incr i} {
+	    set j [lindex $var $i]
+	    if {$j ne "item $i"} {
+		return "element $i should have been \"item $i\", was \"$j\""
+	    }
+	}
+	return ok
     }
-    return ok
-}
-test appendComp-5.1 {long lappends} {
-    catch {unset x}
+} -body {
     set x ""
     for {set i 0} {$i < 300} {set i [expr $i+1]} {
 	lappend x "item $i"
     }
     check $x 300
-} ok
+} -cleanup {
+    unset -nocomplain x
+    catch {rename check ""}
+} -result ok
 
 test appendComp-6.1 {lappend errors} -returnCodes error -body {
     proc foo {} {lappend}
@@ -243,7 +248,7 @@ test appendComp-6.2 {lappend errors} -returnCodes error -body {
 
 test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
     catch {rename foo ""}
-    catch {unset x}
+    unset -nocomplain x
 } -body {
     proc bar {} {
 	global x
@@ -259,7 +264,7 @@ test appendComp-7.1 {lappendComp-created var and error in trace on that var} -se
     bar
 } -result {0 1 {can't read "x": no such variable}}
 test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
-    catch {unset ::result}
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	trace variable myvar r foo
@@ -282,7 +287,7 @@ test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
     bar
 } -result {::myvar {} r} -constraints {bug-3057639}
 test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
-    catch {unset ::result}
+    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.
@@ -295,7 +300,7 @@ test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
     bar
 } -result {myvar b r} -constraints {bug-3057639}
 test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
-    catch {unset ::result}
+    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.
@@ -308,7 +313,7 @@ test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
     bar
 } -result {myvar b r}
 test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
-    catch {unset ::result}
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	set myvar(0) 1
@@ -320,8 +325,8 @@ test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
     bar
 } -result {myvar b r} -constraints {bug-3057639}
 test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
-    catch {unset ::myvar}
-    catch {unset ::result}
+    unset -nocomplain ::myvar
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	trace variable ::myvar r foo
@@ -332,8 +337,8 @@ test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
     bar
 } -result {::myvar b r} -constraints {bug-3057639}
 test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
-    catch {unset ::myvar}
-    catch {unset ::result}
+    unset -nocomplain ::myvar
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	trace variable ::myvar r foo
@@ -344,7 +349,7 @@ test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
     bar
 } -result {::myvar b r}
 test appendComp-7.9 {append var does not trigger read trace} -setup {
-    catch {unset ::result}
+    unset -nocomplain ::result
 } -body {
     proc bar {} {
 	trace variable myvar r foo
@@ -369,25 +374,24 @@ test appendComp-8.1 {defer error to runtime} -setup {
     interp delete slave
 } -result {}
 
+# New tests for bug 3057639 to show off the more consistent behaviour of
+# lappend in both direct-eval and bytecompiled code paths (see append.test for
+# the direct-eval variants). lappend now behaves like append. 9.0/1 lappend -
+# 9.2/3 append.
 
-# New tests for bug 3057639 to show off the more consistent behaviour
-# of lappend in both direct-eval and bytecompiled code paths (see
-# append.test for the direct-eval variants). lappend now behaves like
-# append. 9.0/1 lappend - 9.2/3 append.
-
-# Note also the tests above now constrained by bug-3057639, these
-# changed behaviour with the triggering of read traces in bc mode
-# gone.
+# Note also the tests above now constrained by bug-3057639, these changed
+# behaviour with the triggering of read traces in bc mode gone.
 
-# Going back to the tests below. The direct-eval tests are ok before
-# and after patch (no read traces run for lappend, append). The
-# compiled tests are failing for lappend (9.0/1) before the patch,
-# showing how it invokes read traces in the compiled path. The append
-# tests are good (9.2/3). After the patch the failues are gone.
+# Going back to the tests below. The direct-eval tests are ok before and after
+# patch (no read traces run for lappend, append). The compiled tests are
+# failing for lappend (9.0/1) before the patch, showing how it invokes read
+# traces in the compiled path. The append tests are good (9.2/3). After the
+# patch the failues are gone.
 
-test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} {
-    catch {unset myvar}
+test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing array variable element} -setup {
+    unset -nocomplain myvar
     array set myvar {}
+} -body {
     proc nonull {var key val} {
 	upvar 1 $var lvar
 	if {![info exists lvar($key)]} {
@@ -399,22 +403,21 @@ test appendComp-9.0 {bug 3057639, lappend compiled, read trace on non-existing a
 	lappend ::myvar(key) "new value"
     }
     list [catch { foo } msg] $msg
-} {0 {{new value}}}
-
-
-test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} {
-    catch {unset ::env(__DUMMY__)}
+} -result {0 {{new value}}}
+test appendComp-9.1 {bug 3057639, lappend direct eval, read trace on non-existing env element} -setup {
+    unset -nocomplain ::env(__DUMMY__)
+} -body {
     proc foo {} {
 	lappend ::env(__DUMMY__) "new value"
     }
     list [catch { foo } msg] $msg
-} {0 {{new value}}}
-
-
-
-test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} {
-    catch {unset myvar}
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {{new value}}}
+test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing array variable element} -setup {
+    unset -nocomplain myvar
     array set myvar {}
+} -body {
     proc nonull {var key val} {
 	upvar 1 $var lvar
 	if {![info exists lvar($key)]} {
@@ -426,18 +429,18 @@ test appendComp-9.2 {bug 3057639, append compiled, read trace on non-existing ar
 	append ::myvar(key) "new value"
     }
     list [catch { foo } msg] $msg
-} {0 {new value}}
-
-
-test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} {
-    catch {unset ::env(__DUMMY__)}
+} -result {0 {new value}}
+test appendComp-9.3 {bug 3057639, append direct eval, read trace on non-existing env element} -setup {
+    unset -nocomplain ::env(__DUMMY__)
+} -body {
     proc foo {} {
 	append ::env(__DUMMY__) "new value"
     }
     list [catch { foo } msg] $msg
-} {0 {new value}}
-
-
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
 catch {unset i x result y}
 catch {rename foo ""}
 catch {rename bar ""}
@@ -447,3 +450,8 @@ catch {rename bar {}}
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index f7ba584..2213c57 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdAH.test,v 1.68 2010/02/05 14:33:09 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.68.4.1 2010/12/11 18:39:30 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -218,10 +218,10 @@ test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
 
 test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
     file
-} -result {wrong # args: should be "file option ?arg ...?"}
+} -result {wrong # args: should be "file subcommand ?arg ...?"}
 test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
     file x
-} -result {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
+} -result {unknown or ambiguous subcommand "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
 test cmdAH-5.3 {Tcl_FileObjCmd} -returnCodes error -body {
     file exists
 } -result {wrong # args: should be "file exists name"}
@@ -242,7 +242,7 @@ test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {unix} {
 } {0}
 test cmdAH-6.4 {Tcl_FileObjCmd: volumes} win {
     set volumeList [string tolower [file volumes]]
-    list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
+    list [catch {lsearch $volumeList "c:/"} element] [expr {$element != -1}] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
 } {0 1 0}
 
 # attributes
@@ -1415,25 +1415,25 @@ test cmdAH-29.5 {Tcl_FileObjCmd: type} {
 # Error conditions
 test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
     file gorp x
-} -result {bad option "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
+} -result {unknown or ambiguous subcommand "gorp": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mkdir, mtime, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, tempfile, type, volumes, or writable}
 test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
     file ex x
-} -match glob -result {ambiguous option "ex": must be *}
+} -match glob -result {unknown or ambiguous subcommand "ex": must be *}
 test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
     file is x
-} -match glob -result {ambiguous option "is": must be *}
+} -match glob -result {unknown or ambiguous subcommand "is": must be *}
 test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
     file z x
-} -match glob -result {bad option "z": must be *}
+} -match glob -result {unknown or ambiguous subcommand "z": must be *}
 test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
     file read x
-} -match glob -result {ambiguous option "read": must be *}
+} -match glob -result {unknown or ambiguous subcommand "read": must be *}
 test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
     file s x
-} -match glob -result {ambiguous option "s": must be *}
+} -match glob -result {unknown or ambiguous subcommand "s": must be *}
 test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
     file t x
-} -match glob -result {ambiguous option "t": must be *}
+} -match glob -result {unknown or ambiguous subcommand "t": must be *}
 test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
     file dirname ~woohgy
 } -result {user "woohgy" doesn't exist}
@@ -1445,7 +1445,7 @@ test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
 interp create simpleInterp
 interp create -safe safeInterp
 interp create
-safeInterp expose file file
+catch {safeInterp expose file file}
 
 test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} -body {
     file channels a b
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 1436a28..09e2622 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -10,10 +10,10 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: fCmd.test,v 1.70 2009/11/24 00:08:27 patthoyts Exp $
+# RCS: @(#) $Id: fCmd.test,v 1.70.4.1 2010/12/11 18:39:30 kennykb Exp $
 #
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
@@ -22,16 +22,16 @@ testConstraint testsetplatform [llength [info commands testsetplatform]]
 testConstraint testchmod [llength [info commands testchmod]]
 testConstraint winVista 0
 testConstraint win2000orXP 0
-testConstraint winOlderThan2000 0
 # Don't know how to determine this constraint correctly
 testConstraint notNetworkFilesystem 0
-testConstraint 95or98 [expr {[testConstraint 95] || [testConstraint 98]}]
-testConstraint 2000orNewer [expr {[testConstraint win] && ![testConstraint 95or98]}]
 testConstraint reg 0
 if {[testConstraint win]} {
     catch {
 	# Is the registry extension already static to this shell?
-	if [catch {load {} Registry; set ::reglib {}}] {
+	try {
+	    load {} Registry
+	    set ::reglib {}
+	} on error {} {
 	    # try the location given to use on the commandline to tcltest
 	    ::tcltest::loadTestedCommands
 	    load $::reglib Registry
@@ -52,7 +52,7 @@ if {[testConstraint unix]} {
 }
 
 # Also used in winFCmd...
-if {[testConstraint winOnly]} {
+if {[testConstraint win]} {
     set major [string index $tcl_platform(osVersion) 0]
     if {[testConstraint nt] && $major > 4} {
         if {$major > 5} {
@@ -60,15 +60,14 @@ if {[testConstraint winOnly]} {
         } elseif {$major == 5} {
             testConstraint win2000orXP 1
         }
-    } else {
-        testConstraint winOlderThan2000 1
     }
 }
 
-testConstraint darwin9 [expr {[testConstraint unix] &&
-	$tcl_platform(os) eq "Darwin" &&
-	int([string range $tcl_platform(osVersion) 0 \
-	[string first . $tcl_platform(osVersion)]]) >= 9}]
+testConstraint darwin9 [expr {
+    [testConstraint unix]
+    && $tcl_platform(os) eq "Darwin"
+    && [package vsatisfies 1.$tcl_platform(osVersion) 1.9]
+}]
 testConstraint notDarwin9 [expr {![testConstraint darwin9]}]
 
 testConstraint fileSharing 0
@@ -106,11 +105,11 @@ proc createfile {file {string a}} {
 #  if the file does not exist, or has a different content
 #
 proc checkcontent {file matchString} {
-    if {[catch {
+    try {
 	set f [open $file]
 	set fileString [read $f]
 	close $f
-    }]} then {
+    } on error {} {
 	return 0
     }
     return [string match $matchString $fileString]
@@ -163,8 +162,8 @@ testConstraint xdev [expr {[testConstraint unix] && ([dev .] != [dev /tmp])}]
 
 set root [lindex [file split [pwd]] 0]
 
-# A really long file name
-# length of long is 1216 chars, which should be greater than any static buffer
+# A really long file name.
+# Length of long is 1216 chars, which should be greater than any static buffer
 # or allowable filename.
 
 set long "abcdefghihjllmnopqrstuvwxyz01234567890"
@@ -173,7 +172,7 @@ append long $long
 append long $long
 append long $long
 append long $long
-
+
 test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup {
     cleanup
 } -body {
@@ -192,7 +191,7 @@ test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup {
 
 test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
     file rename -xyz
-} -returnCodes error -result {bad option "-xyz": should be -force or --}
+} -returnCodes error -result {bad option "-xyz": must be -force or --}
 test fCmd-3.2 {FileCopyRename: not enough args} -constraints {notRoot} -body {
     file rename xyz
 } -returnCodes error -result {wrong # args: should be "file rename ?-option value ...? source ?source ...? target"}
@@ -390,7 +389,7 @@ test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
 
 test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
     file delete -xyz
-} -returnCodes error -result {bad option "-xyz": should be -force or --}
+} -returnCodes error -result {bad option "-xyz": must be -force or --}
 test fCmd-5.2 {TclFileDeleteCmd: accept 0 files (TIP 323)} -body {
     file delete -force -force
 } -result {}
@@ -737,7 +736,7 @@ test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
     file delete -tf1
 } -returnCodes error -cleanup {
     file delete -- -tf1
-} -result {bad option "-tf1": should be -force or --}
+} -result {bad option "-tf1": must be -force or --}
 test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
     cleanup
 } -constraints {notRoot} -returnCodes error -body {
@@ -791,9 +790,20 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
     file rename tf2 tf4
     list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
 } -result {{tf3 tf4} 1 0}
-test fCmd-9.4 {file rename: comprehensive: dir to new name} -setup {
+test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup {
+    cleanup
+} -constraints {win win2000orXP testchmod} -body {
+    file mkdir td1 td2
+    testchmod 555 td2
+    file rename td1 td3
+    file rename td2 td4
+    list [lsort [glob td*]] [file writable td3] [file writable td4]
+} -cleanup {
+    cleanup
+} -result {{td3 td4} 1 0}
+test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup {
     cleanup
-} -constraints {unixOrPc notRoot testchmod notDarwin9 win2000orXP} -body {
+} -constraints {unix notRoot testchmod notDarwin9} -body {
     file mkdir td1 td2
     testchmod 555 td2
     file rename td1 td3
@@ -812,9 +822,19 @@ test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
     file rename -force tf2 tf2
     list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
 } -result {tf1 tf2 1 0}
-test fCmd-9.6 {file rename: comprehensive: dir to self} -setup {
+test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
     cleanup
-} -constraints {notRoot unixOrPc testchmod win2000orXP} -body {
+} -constraints {win win2000orXP testchmod} -body {
+    file mkdir td1
+    file mkdir td2
+    testchmod 555 td2
+    file rename -force td1 .
+    file rename -force td2 .
+    list [lsort [glob td*]] [file writable td1] [file writable td2]
+} -result {{td1 td2} 1 0}
+test fCmd-9.6.b {file rename: comprehensive: dir to self} -setup {
+    cleanup
+} -constraints {unix notRoot testchmod} -body {
     file mkdir td1
     file mkdir td2
     testchmod 555 td2
@@ -1022,7 +1042,7 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} -setup {
 } -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
 test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
     cleanup
-} -constraints {notRoot unixOrPc 95or98 testchmod} -body {
+} -constraints {unix notRoot testchmod} -body {
     file mkdir [file join td1 tdx]
     file mkdir [file join td2 tdy]
     testchmod 555 td2
@@ -1036,7 +1056,7 @@ test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
 } -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0]
 test fCmd-10.3.1 {file copy: comprehensive: dir to new name} -setup {
     cleanup
-} -constraints {notRoot 2000orNewer testchmod} -body {
+} -constraints {win notRoot testchmod} -body {
     # On Windows with ACLs, copying a directory is defined like this
     file mkdir [file join td1 tdx]
     file mkdir [file join td2 tdy]
@@ -1123,7 +1143,7 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
 } -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
 test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
     cleanup
-} -constraints {notRoot unixOrPc 95or98 testchmod} -body {
+} -constraints {unix notRoot testchmod} -body {
     file mkdir td1
     file mkdir td2
     file mkdir td3
@@ -1135,7 +1155,7 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
 } -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
 test fCmd-10.8.1 {file rename: comprehensive: dir to new name and dir} -setup {
     cleanup
-} -constraints {notRoot 2000orNewer testchmod} -body {
+} -constraints {win notRoot testchmod} -body {
     # On Windows with ACLs, copying a directory is defined like this
     file mkdir td1
     file mkdir td2
@@ -1529,8 +1549,7 @@ test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {
     set ::env(HOME) $temp
 } -result {1}
 #
-# Can Tcl_SplitPath return argc == 0? If so them we need a
-# test for that code.
+# Can Tcl_SplitPath return argc == 0? If so them we need a test for that code.
 #
 test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup {
     catch {file delete -force -- tfa}
@@ -1710,7 +1729,6 @@ test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
 #
 # Functionality tests for TclFileRenameCmd()
 #
-
 test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
 	-setup {
     catch {file delete -force -- tfad}
@@ -1918,7 +1936,6 @@ test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
 #
 # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
 #
-
 test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup {
     catch {file delete -force -- tfa}
 } -constraints {unix notRoot} -body {
@@ -2150,7 +2167,6 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup {
 # TclMacRmdir
 # Error cases are not covered.
 #
-
 test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} -setup {
     catch {file delete -force -- tfad}
 } -constraints {notRoot} -body {
@@ -2212,7 +2228,6 @@ test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup
 #
 # Functionality tests for TclDeleteFilesCmd
 #
-
 test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} -setup {
     catch {file delete -force -- tfad1 tfad2}
 } -constraints {unix notRoot} -body {
@@ -2405,7 +2420,7 @@ test fCmd-28.12 {file link: cd into a link} -setup {
     cd ..
     set up [pwd]
     cd $orig
-    # now '$up' should be either $orig or [file dirname abc.dir], depending on
+    # Now '$up' should be either $orig or [file dirname abc.dir], depending on
     # whether 'cd' actually moves to the destination of a link, or simply
     # treats the link as a directory. (On windows the former, on unix the
     # latter, I believe)
@@ -2530,35 +2545,35 @@ test fCmd-28.22 {file link: relative paths} -setup {
     catch {file delete -force d1}
     cd [workingDirectory]
 } -result d2/d3
-
-test fCmd-29.1 {weird memory corruption fault} -body {
-    open [file join ~a_totally_bogus_user_id/foo bar]
-} -returnCodes error -match glob -result *
-
-cd [temporaryDirectory]
-file delete -force abc.link
-file delete -force d1/d2
-file delete -force d1
-cd [workingDirectory]
-
+try {
+    cd [temporaryDirectory]
+    file delete -force abc.link
+    file delete -force d1/d2
+    file delete -force d1
+} finally {
+    cd [workingDirectory]
+}
 removeFile abc2.file
 removeFile abc.file
 removeDirectory abc2.dir
 removeDirectory abc.dir
 
+test fCmd-29.1 {weird memory corruption fault} -body {
+    open [file join ~a_totally_bogus_user_id/foo bar]
+} -returnCodes error -match glob -result *
+
 test fCmd-30.1 {file writable on 'My Documents'} -setup {
     # Get the localized version of the folder name by looking in the registry.
     set mydocsname [registry get {HKEY_CURRENT_USER\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} Personal]
-} -constraints {2000orNewer reg} -body {
+} -constraints {win reg} -body {
     file writable $mydocsname
 } -result 1
-test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {2000orNewer} -body {
+test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body {
     expr {[info exists env(USERPROFILE)]
           && [file exists $env(USERPROFILE)/NTUSER.DAT]
           && [file readable $env(USERPROFILE)/NTUSER.DAT]}
-
 } -result {1}
-test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {2000orNewer} -body {
+test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {win} -body {
     set r {}
     if {[info exists env(SystemDrive)]} {
         set path $env(SystemDrive)/pagefile.sys
@@ -2568,7 +2583,7 @@ test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {2000orNewer} -bod
     }
     return $r
 } -result {exists 1 readable 0 stat 0 {}}
-
+
 # cleanup
 cleanup
 ::tcltest::cleanupTests
@@ -2576,4 +2591,5 @@ return
 
 # Local Variables:
 # mode: tcl
+# fill-column: 78
 # End:
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 2fe13d7..1691eb5 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -600,14 +600,14 @@ test filesystem-6.25 {empty file name} -returnCodes error -body {
 test filesystem-6.26 {empty file name} {file rootname ""} {}
 test filesystem-6.27 {empty file name} -returnCodes error -body {
     file separator ""
-} -result {Unrecognised path}
+} -result {unrecognised path}
 test filesystem-6.28 {empty file name} -returnCodes error -body {
     file size ""
 } -result {could not read "": no such file or directory}
 test filesystem-6.29 {empty file name} {file split ""} {}
 test filesystem-6.30 {empty file name} -returnCodes error -body {
     file system ""
-} -result {Unrecognised path}
+} -result {unrecognised path}
 test filesystem-6.31 {empty file name} {file tail ""} {}
 test filesystem-6.32 {empty file name} -returnCodes error -body {
     file type ""
diff --git a/tests/interp.test b/tests/interp.test
index 6c35cfd..b401dcf 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: interp.test,v 1.68.4.1 2010/12/01 16:42:37 kennykb Exp $
+# RCS: @(#) $Id: interp.test,v 1.68.4.2 2010/12/11 18:39:30 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 
 testConstraint testinterpdelete [llength [info commands testinterpdelete]]
 
-set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source unload}
+set hidden_cmds {cd encoding exec exit fconfigure glob load open pwd socket source tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload}
 
 foreach i [interp slaves] {
   interp delete $i
@@ -1607,67 +1607,73 @@ test interp-21.1 {interp hidden} {
 test interp-21.2 {interp hidden} {
     interp hidden
 } ""
-test interp-21.3 {interp hidden vs interp hide, interp expose} {
+test interp-21.3 {interp hidden vs interp hide, interp expose} -setup {
     set l ""
+} -body {
     lappend l [interp hidden]
     interp hide {} pwd
     lappend l [interp hidden]
     interp expose {} pwd
     lappend l [interp hidden]
-    set l
-} {{} pwd {}}
-test interp-21.4 {interp hidden} {
+} -result {{} pwd {}}
+test interp-21.4 {interp hidden} -setup {
     catch {interp delete a}
+} -body {
     interp create a
-    set l [interp hidden a]
+    interp hidden a
+} -cleanup {
     interp delete a
-    set l
-} ""
-test interp-21.5 {interp hidden} {
+} -result ""
+test interp-21.5 {interp hidden} -setup {
     catch {interp delete a}
+} -body {
     interp create -safe a
-    set l [lsort [interp hidden a]]
+    lsort [interp hidden a]
+} -cleanup {
     interp delete a
-    set l
-} $hidden_cmds 
-test interp-21.6 {interp hidden vs interp hide, interp expose} {
+} -result $hidden_cmds 
+test interp-21.6 {interp hidden vs interp hide, interp expose} -setup {
     catch {interp delete a}
-    interp create a
     set l ""
+} -body {
+    interp create a
     lappend l [interp hidden a]
     interp hide a pwd
     lappend l [interp hidden a]
     interp expose a pwd
     lappend l [interp hidden a]
+} -cleanup {
     interp delete a
-    set l
-} {{} pwd {}}
-test interp-21.7 {interp hidden} {
+} -result {{} pwd {}}
+test interp-21.7 {interp hidden} -setup {
     catch {interp delete a}
+} -body {
     interp create a
-    set l [a hidden]
+    a hidden
+} -cleanup {
     interp delete a
-    set l
-} ""
-test interp-21.8 {interp hidden} {
+} -result ""
+test interp-21.8 {interp hidden} -setup {
     catch {interp delete a}
+} -body {
     interp create a -safe
-    set l [lsort [a hidden]]
+    lsort [a hidden]
+} -cleanup {
     interp delete a
-    set l
-} $hidden_cmds
-test interp-21.9 {interp hidden vs interp hide, interp expose} {
+} -result $hidden_cmds
+test interp-21.9 {interp hidden vs interp hide, interp expose} -setup {
     catch {interp delete a}
-    interp create a
     set l ""
+} -body {
+    interp create a
     lappend l [a hidden]
     a hide pwd
     lappend l [a hidden]
     a expose pwd
     lappend l [a hidden]
+} -cleanup {
     interp delete a
-    set l
-} {{} pwd {}}
+} -result {{} pwd {}}
 
 test interp-22.1 {testing interp marktrusted} {
     catch {interp delete a}
@@ -1767,183 +1773,161 @@ test interp-22.9 {testing interp marktrusted} {
     set l
 } {1 1 1 0 0}
 
-test interp-23.1 {testing hiding vs aliases} {
+test interp-23.1 {testing hiding vs aliases: unsafe interp} -setup {
     catch {interp delete a}
-    interp create a
     set l ""
+} -body {
+    interp create a
     lappend l [interp hidden a]
     a alias bar bar
-    lappend l [interp aliases a]
-    lappend l [interp hidden a]
+    lappend l [interp aliases a] [interp hidden a]
     a hide bar
-    lappend l [interp aliases a]
-    lappend l [interp hidden a]
+    lappend l [interp aliases a] [interp hidden a]
     a alias bar {}
-    lappend l [interp aliases a]
-    lappend l [interp hidden a]
+    lappend l [interp aliases a] [interp hidden a]
+} -cleanup {
     interp delete a
-    set l
-} {{} bar {} bar bar {} {}}
-test interp-23.2 {testing hiding vs aliases} {unixOrPc} {
+} -result {{} bar {} bar bar {} {}}
+test interp-23.2 {testing hiding vs aliases: safe interp} -setup {
     catch {interp delete a}
-    interp create a -safe
     set l ""
+} -constraints {unixOrPc} -body {
+    interp create a -safe
     lappend l [lsort [interp hidden a]]
     a alias bar bar
-    lappend l [lsort [interp aliases a]]
-    lappend l [lsort [interp hidden a]]
+    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
     a hide bar
-    lappend l [lsort [interp aliases a]]
-    lappend l [lsort [interp hidden a]]
+    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
     a alias bar {}
-    lappend l [lsort [interp aliases a]]
-    lappend l [lsort [interp hidden a]]
+    lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
+} -cleanup {
     interp delete a
-    set l
-} {{cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source unload} {::tcl::mathfunc::max ::tcl::mathfunc::min clock} {cd encoding exec exit fconfigure file glob load open pwd socket source unload}} 
+} -result [list $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} [lsort [concat $hidden_cmds bar]] {::tcl::mathfunc::max ::tcl::mathfunc::min clock} $hidden_cmds]
 
-test interp-24.1 {result resetting on error} {
+test interp-24.1 {result resetting on error} -setup {
     catch {interp delete a}
+} -body {
     interp create a
-    proc foo args {error $args}
-    interp alias a foo {} foo
-    set l [interp eval a {
-	set l {}
-	lappend l [catch {foo 1 2 3} msg]
-	lappend l $msg
-	lappend l [catch {foo 3 4 5} msg]
-	lappend l $msg
-	set l
-    }]
+    interp alias a foo {} apply {args {error $args}}
+    interp eval a {
+	lappend l [catch {foo 1 2 3} msg] $msg
+	lappend l [catch {foo 3 4 5} msg] $msg
+    }
+} -cleanup {
     interp delete a
-    rename foo {}
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.2 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.2 {result resetting on error} -setup {
     catch {interp delete a}
+} -body {
     interp create a -safe
-    proc foo args {error $args}
-    interp alias a foo {} foo
-    set l [interp eval a {
-	set l {}
-	lappend l [catch {foo 1 2 3} msg]
-	lappend l $msg
-	lappend l [catch {foo 3 4 5} msg]
-	lappend l $msg
-	set l
-    }]
+    interp alias a foo {} apply {args {error $args}}
+    interp eval a {
+	lappend l [catch {foo 1 2 3} msg] $msg
+	lappend l [catch {foo 3 4 5} msg] $msg
+    }
+} -cleanup {
     interp delete a
-    rename foo {}
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.3 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.3 {result resetting on error} -setup {
     catch {interp delete a}
+} -body {
     interp create a
     interp create {a b}
     interp eval a {
 	proc foo args {error $args}
     }
     interp alias {a b} foo a foo
-    set l [interp eval {a b} {
-	set l {}
-	lappend l [catch {foo 1 2 3} msg]
-	lappend l $msg
-	lappend l [catch {foo 3 4 5} msg]
-	lappend l $msg
-	set l
-    }]
+    interp eval {a b} {
+	lappend l [catch {foo 1 2 3} msg] $msg
+	lappend l [catch {foo 3 4 5} msg] $msg
+    }
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.4 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.4 {result resetting on error} -setup {
     catch {interp delete a}
+} -body {
     interp create a -safe
     interp create {a b}
     interp eval a {
 	proc foo args {error $args}
     }
     interp alias {a b} foo a foo
-    set l [interp eval {a b} {
-	set l {}
+    interp eval {a b} {
 	lappend l [catch {foo 1 2 3} msg]
 	lappend l $msg
 	lappend l [catch {foo 3 4 5} msg]
 	lappend l $msg
-	set l
-    }]
+    }
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.5 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.5 {result resetting on error} -setup {
     catch {interp delete a}
     catch {interp delete b}
+} -body {
     interp create a
     interp create b
     interp eval a {
 	proc foo args {error $args}
     }
     interp alias b foo a foo
-    set l [interp eval b {
-	set l {}
-	lappend l [catch {foo 1 2 3} msg]
-	lappend l $msg
-	lappend l [catch {foo 3 4 5} msg]
-	lappend l $msg
-	set l
-    }]
+    interp eval b {
+	lappend l [catch {foo 1 2 3} msg] $msg
+	lappend l [catch {foo 3 4 5} msg] $msg
+    }
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.6 {result resetting on error} {
+    interp delete b
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.6 {result resetting on error} -setup {
     catch {interp delete a}
     catch {interp delete b}
+} -body {
     interp create a -safe
     interp create b -safe
     interp eval a {
 	proc foo args {error $args}
     }
     interp alias b foo a foo
-    set l [interp eval b {
-	set l {}
-	lappend l [catch {foo 1 2 3} msg]
-	lappend l $msg
-	lappend l [catch {foo 3 4 5} msg]
-	lappend l $msg
-	set l
-    }]
+    interp eval b {
+	lappend l [catch {foo 1 2 3} msg] $msg
+	lappend l [catch {foo 3 4 5} msg] $msg
+    }
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.7 {result resetting on error} {
+    interp delete b
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.7 {result resetting on error} -setup {
     catch {interp delete a}
+    set l {}
+} -body {
     interp create a
     interp eval a {
 	proc foo args {error $args}
     }
-    set l {}
-    lappend l [catch {interp eval a foo 1 2 3} msg]
-    lappend l $msg
-    lappend l [catch {interp eval a foo 3 4 5} msg]
-    lappend l $msg
+    lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+    lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.8 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.8 {result resetting on error} -setup {
     catch {interp delete a}
+    set l {}
+} -body {
     interp create a -safe
     interp eval a {
 	proc foo args {error $args}
     }
-    set l {}
-    lappend l [catch {interp eval a foo 1 2 3} msg]
-    lappend l $msg
-    lappend l [catch {interp eval a foo 3 4 5} msg]
-    lappend l $msg
+    lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+    lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.9 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.9 {result resetting on error} -setup {
     catch {interp delete a}
+    set l {}
+} -body {
     interp create a
     interp create {a b}
     interp eval {a b} {
@@ -1954,16 +1938,15 @@ test interp-24.9 {result resetting on error} {
 	    eval interp eval b foo $args
 	}
     }
-    set l {}
-    lappend l [catch {interp eval a foo 1 2 3} msg]
-    lappend l $msg
-    lappend l [catch {interp eval a foo 3 4 5} msg]
-    lappend l $msg
+    lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+    lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.10 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.10 {result resetting on error} -setup {
     catch {interp delete a}
+    set l {}
+} -body {
     interp create a -safe
     interp create {a b}
     interp eval {a b} {
@@ -1974,16 +1957,14 @@ test interp-24.10 {result resetting on error} {
 	    eval interp eval b foo $args
 	}
     }
-    set l {}
-    lappend l [catch {interp eval a foo 1 2 3} msg]
-    lappend l $msg
-    lappend l [catch {interp eval a foo 3 4 5} msg]
-    lappend l $msg
+    lappend l [catch {interp eval a foo 1 2 3} msg] $msg
+    lappend l [catch {interp eval a foo 3 4 5} msg] $msg
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {3 4 5}}
-test interp-24.11 {result resetting on error} {
+} -result {1 {1 2 3} 1 {3 4 5}}
+test interp-24.11 {result resetting on error} -setup {
     catch {interp delete a}
+} -body {
     interp create a
     interp create {a b}
     interp eval {a b} {
@@ -1991,20 +1972,17 @@ test interp-24.11 {result resetting on error} {
     }
     interp eval a {
 	proc foo args {
-	    set l {}
-	    lappend l [catch {eval interp eval b foo $args} msg]
-	    lappend l $msg
-	    lappend l [catch {eval interp eval b foo $args} msg]
-	    lappend l $msg
-	    set l
+	    lappend l [catch {eval interp eval b foo $args} msg] $msg
+	    lappend l [catch {eval interp eval b foo $args} msg] $msg
 	}
     }
-    set l [interp eval a foo 1 2 3]
+    interp eval a foo 1 2 3
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {1 2 3}}
-test interp-24.12 {result resetting on error} {
+} -result {1 {1 2 3} 1 {1 2 3}}
+test interp-24.12 {result resetting on error} -setup {
     catch {interp delete a}
+} -body {
     interp create a -safe
     interp create {a b}
     interp eval {a b} {
@@ -2012,27 +1990,22 @@ test interp-24.12 {result resetting on error} {
     }
     interp eval a {
 	proc foo args {
-	    set l {}
-	    lappend l [catch {eval interp eval b foo $args} msg]
-	    lappend l $msg
-	    lappend l [catch {eval interp eval b foo $args} msg]
-	    lappend l $msg
-	    set l
+	    lappend l [catch {eval interp eval b foo $args} msg] $msg
+	    lappend l [catch {eval interp eval b foo $args} msg] $msg
 	}
     }
-    set l [interp eval a foo 1 2 3]
+    interp eval a foo 1 2 3
+} -cleanup {
     interp delete a
-    set l
-} {1 {1 2 3} 1 {1 2 3}}
+} -result {1 {1 2 3} 1 {1 2 3}}
 
-unset hidden_cmds
-
-test interp-25.1 {testing aliasing of string commands} {
+test interp-25.1 {testing aliasing of string commands} -setup {
     catch {interp delete a}
+} -body {
     interp create a
     a alias exec foo		;# Relies on exec being a string command!
     interp delete a
-} ""
+} -result ""
 
 #
 # Interps result transmission
@@ -3058,7 +3031,7 @@ test interp-31.1 {alias invocation scope} {
 	myNewSet a $value
 	return $a
     }
-    catch {unset a}
+    unset -nocomplain a
     set result [testMyNewSet "ok"]
     rename testMyNewSet {}
     rename mySet {}
@@ -3580,7 +3553,7 @@ test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
     set result
 } -cleanup {
     variable result {}
-    unset result
+    unset -nocomplain result
     interp delete slave
 } -result foo
 
@@ -3593,7 +3566,7 @@ test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
     lappend result [interp eval a {expr min(5,2,3)*max(7,13,11)}]
     lappend result [interp eval {a b} {expr min(5,2,3)*max(7,13,11)}]
 } -cleanup {
-    unset result
+    unset -nocomplain result
     interp delete a
 } -result {26 26}
 
@@ -3614,7 +3587,7 @@ test interp-38.2 {interp debug env var} -setup {
 } -body {
     interp debug a
 } -cleanup {
-    unset ::env(TCL_INTERP_DEBUG_FRAME)
+    unset -nocomplain ::env(TCL_INTERP_DEBUG_FRAME)
     interp delete a
 } -result {-frame 1}
 test interp-38.3 {interp debug wrong args} -body {
@@ -3642,6 +3615,7 @@ test interp-38.8 {interp debug basic setup} -body {
 
 
 # cleanup
+unset -nocomplain hidden_cmds
 foreach i [interp slaves] {
     interp delete $i
 }
diff --git a/tests/io.test b/tests/io.test
index c69bff9..2077e1c 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: io.test,v 1.96 2010/02/07 08:03:11 dkf Exp $
+# RCS: @(#) $Id: io.test,v 1.96.4.1 2010/12/11 18:39:30 kennykb Exp $
 
 if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
@@ -7007,6 +7007,44 @@ test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof}
     removeFile foo
     removeFile bar
 } -result {1 sync/OK {CMD 0}}
+test io-53.8b {CopyData: async callback and -size 0} -setup {
+    # copy progress callback. errors out intentionally
+    proc ::cmd args {
+	lappend ::RES "CMD $args"
+	set ::forever has-been-reached
+	return
+    }
+    # Files we use for our channels
+    set foo [makeFile ashgdfashdgfasdhgfasdhgf foo]
+    set bar [makeFile {} bar]
+    # Channels to copy between
+    set f [open $foo r] ; fconfigure $f -translation binary
+    set g [open $bar w] ; fconfigure $g -translation binary -buffering none
+} -constraints {stdio openpipe fcopy} -body {
+	set ::RES {}
+    # Run the copy. Should not invoke -command now.
+    fcopy $f $g -size 0 -command ::cmd
+    # Check that -command was not called synchronously
+    lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}]
+    # Now let the async part happen. Should capture the eof in cmd
+    # If not break the event loop via timer.
+    set token [after 1000 {
+	lappend ::RES {cmd/FAIL timeout}
+	set ::forever has-been-reached
+    }]
+    vwait ::forever
+    catch {after cancel $token}
+    # Report
+    set ::RES
+} -cleanup {
+    close $f
+    close $g
+    catch {unset ::RES}
+    catch {unset ::forever}
+    rename ::cmd {}
+    removeFile foo
+    removeFile bar
+} -result {sync/OK {CMD 0}}
 test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
     set out [makeFile {} out]
     set err [makeFile {} err]
diff --git a/tests/safe.test b/tests/safe.test
index ee2ecc3..51d2f7e 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: safe.test,v 1.34.2.1 2010/11/03 00:18:57 kennykb Exp $
+# RCS: @(#) $Id: safe.test,v 1.34.2.2 2010/12/11 18:39:30 kennykb Exp $
 
 package require Tcl 8.5
 
@@ -31,6 +31,11 @@ set ::auto_path [info library]
 catch {safe::interpConfigure}
 
 proc equiv {x} {return $x}
+
+# testing that nested and statics do what is advertised (we use a static
+# package - Tcltest - but it might be absent if we're in standard tclsh)
+
+testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
 
 test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
     safe::interpConfigure
@@ -166,27 +171,24 @@ test safe-6.2 {test safe interpreters knowledge of the world} {
     SafeEval {info script}
 } {}
 test safe-6.3 {test safe interpreters knowledge of the world} {
-    set r [lsort [SafeEval {array names tcl_platform}]]
+    set r [SafeEval {array names tcl_platform}]
     # If running a windows-debug shell, remove the "debug" element from r.
-    if {[testConstraint win] && ("debug" in $r)} {
-	set r [lreplace $r 1 1]
-    }
-    set threaded [lsearch $r "threaded"]
-    if {$threaded != -1} {
-	set r [lreplace $r $threaded $threaded]
+    if {[testConstraint win]} {
+	set r [lsearch -all -inline -not -exact $r "debug"]
     }
-    set r
+    set r [lsearch -all -inline -not -exact $r "threaded"]
+    lsort $r
 } {byteOrder pathSeparator platform pointerSize wordSize}
 
-# more test should be added to check that hostname, nameofexecutable,
-# aren't leaking infos, but they still do...
+# More test should be added to check that hostname, nameofexecutable, aren't
+# leaking infos, but they still do...
 
 # high level general test
 test safe-7.1 {tests that everything works at high level} {
     set i [safe::interpCreate]
     # no error shall occur:
-    # (because the default access_path shall include 1st level sub dirs
-    #  so package require in a slave works like in the master)
+    # (because the default access_path shall include 1st level sub dirs so
+    #  package require in a slave works like in the master)
     set v [interp eval $i {package require http 1}]
     # no error shall occur:
     interp eval $i {http_config}
@@ -400,17 +402,7 @@ test safe-9.6 {interpConfigure widget like behaviour} -body {
 	 safe::interpConfigure $i]
 } -match glob -result {{-accessPath * -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath *} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath * -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath * -statics 0 -nested 0 -deleteHook toto}}
 
-# testing that nested and statics do what is advertised (we use a static
-# package : Tcltest)
-try {
-    package require Tcltest
-    testConstraint TcltestPackage 1
-    # we use the Tcltest package , which has no Safe_Init
-} on error {} {
-    testConstraint TcltestPackage 0
-}
-
-teststaticpkg Safepkg1 0 0
+catch {teststaticpkg Safepkg1 0 0}
 test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
     set i [safe::interpCreate]
 } -body {
diff --git a/tests/uplevel.test b/tests/uplevel.test
index f676290..2f725bc 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -1,17 +1,17 @@
 # Commands covered:  uplevel
 #
-# This file contains a collection of tests for one or more of the Tcl
-# built-in commands.  Sourcing this file into Tcl runs the tests and
-# generates output for errors.  No output means no errors were found.
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands.  Sourcing this file into Tcl runs the tests and generates output
+# for errors.  No output means no errors were found.
 #
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: uplevel.test,v 1.9 2008/06/08 03:21:33 msofer Exp $
+# RCS: @(#) $Id: uplevel.test,v 1.9.6.1 2010/12/11 18:39:30 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -26,7 +26,7 @@ proc newset {name value} {
     uplevel set $name $value
     uplevel 1 {uplevel 1 {set xyz 22}}
 }
-
+
 test uplevel-1.1 {simple operation} {
     set xyz 0
     a 22 33
@@ -85,20 +85,24 @@ test uplevel-3.4 {uplevel to same level} {
     a1
 } 55
 
-test uplevel-4.1 {error: non-existent level} {
-    list [catch c1 msg] $msg
-} {1 {bad level "#2"}}
-test uplevel-4.2 {error: non-existent level} {
-    proc c2 {} {uplevel 3 {set a b}}
-    list [catch c2 msg] $msg
-} {1 {bad level "3"}}
-test uplevel-4.3 {error: not enough args} {
-    list [catch uplevel msg] $msg
-} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
-test uplevel-4.4 {error: not enough args} {
-    proc upBug {} {uplevel 1}
-    list [catch upBug msg] $msg
-} {1 {wrong # args: should be "uplevel ?level? command ?arg ...?"}}
+test uplevel-4.1 {error: non-existent level} -returnCodes error -body {
+    apply {{} {
+	uplevel #2 {set y 222}
+    }}
+} -result {bad level "#2"}
+test uplevel-4.2 {error: non-existent level} -returnCodes error -body {
+    apply {{} {
+	uplevel 3 {set a b}
+    }}
+} -result {bad level "3"}
+test uplevel-4.3 {error: not enough args} -returnCodes error -body {
+    uplevel
+} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
+test uplevel-4.4 {error: not enough args} -returnCodes error -body {
+    apply {{} {
+	uplevel 1
+    }}
+} -result {wrong # args: should be "uplevel ?level? command ?arg ...?"}
 
 proc a2 {} {
     uplevel a3
@@ -193,7 +197,12 @@ test uplevel-7.3 {var access, LVT in upper level} -setup {
     rename foo {}
     rename moo {}
 } -result {3 3 3}
-
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/upvar.test b/tests/upvar.test
index dbf6dd5..d181043 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: upvar.test,v 1.20 2010/02/10 23:28:39 dkf Exp $
+# RCS: @(#) $Id: upvar.test,v 1.20.4.1 2010/12/11 18:39:30 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -427,116 +427,103 @@ namespace eval test_ns_0 {
 }
 set ::x test_global
 
-test upvar-NS-1.1 {nsupvar links to correct variable} \
-    -body {
-	namespace eval test_ns_1 {
+test upvar-NS-1.1 {nsupvar links to correct variable} -body {
+    namespace eval test_ns_1 {
+	namespace upvar ::test_ns_0 x w
+	set w
+    }
+} -result {test_ns_0} -cleanup {
+    namespace delete test_ns_1
+}
+test upvar-NS-1.2 {nsupvar links to correct variable} -body {
+    namespace eval test_ns_1 {
+	proc a {} {
 	    namespace upvar ::test_ns_0 x w
 	    set w
 	}
-    } \
-    -result {test_ns_0} \
-    -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.2 {nsupvar links to correct variable} \
-    -body {
-	namespace eval test_ns_1 {
-	    proc a {} {
-		namespace upvar ::test_ns_0 x w
-		set w
-	    }
-	    return [a]
-	}
-    } \
-    -result {test_ns_0} \
-    -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.3 {nsupvar links to correct variable} \
-    -body {
-	namespace eval test_ns_1 {
+	return [a]
+    }
+} -result {test_ns_0} -cleanup {
+    namespace delete test_ns_1
+}
+test upvar-NS-1.3 {nsupvar links to correct variable} -body {
+    namespace eval test_ns_1 {
+	namespace upvar test_ns_0 x w
+	set w
+    }
+} -returnCodes error -cleanup {
+    namespace delete test_ns_1
+} -result {namespace "test_ns_0" not found in "::test_ns_1"}
+test upvar-NS-1.4 {nsupvar links to correct variable} -body {
+    namespace eval test_ns_1 {
+	proc a {} {
 	    namespace upvar test_ns_0 x w
 	    set w
 	}
-    } \
-    -result {namespace "test_ns_0" not found in "::test_ns_1"} \
-    -returnCodes error \
-    -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.4 {nsupvar links to correct variable} \
-    -body {
-	namespace eval test_ns_1 {
-	    proc a {} {
-		namespace upvar test_ns_0 x w
-		set w
-	    }
-	    return [a]
-	}
-    } \
-    -result {namespace "test_ns_0" not found in "::test_ns_1"} \
-    -returnCodes error \
-    -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.5 {nsupvar links to correct variable} \
-    -body {
-	namespace eval test_ns_1 {
-	    namespace eval test_ns_0 {}
+	return [a]
+    }
+} -returnCodes error -cleanup {
+    namespace delete test_ns_1
+} -result {namespace "test_ns_0" not found in "::test_ns_1"}
+    
+test upvar-NS-1.5 {nsupvar links to correct variable} -body {
+    namespace eval test_ns_1 {
+	namespace eval test_ns_0 {}
+	namespace upvar test_ns_0 x w
+	set w
+    }
+} -cleanup {
+    namespace delete test_ns_1
+} -result {can't read "w": no such variable} -returnCodes error
+test upvar-NS-1.6 {nsupvar links to correct variable} -body {
+    namespace eval test_ns_1 {
+	namespace eval test_ns_0 {}
+	proc a {} {
 	    namespace upvar test_ns_0 x w
 	    set w
 	}
-    } \
-    -result {can't read "w": no such variable} \
-    -returnCodes error \
-    -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.6 {nsupvar links to correct variable} \
-    -body {
-	namespace eval test_ns_1 {
-	    namespace eval test_ns_0 {}
-	    proc a {} {
-		namespace upvar test_ns_0 x w
-		set w
-	    }
-	    return [a]
+	return [a]
+    }
+} -cleanup {
+    namespace delete test_ns_1
+} -result {can't read "w": no such variable} -returnCodes error
+test upvar-NS-1.7 {nsupvar links to correct variable} -body {
+    namespace eval test_ns_1 {
+	namespace eval test_ns_0 {
+	    variable x test_ns_1::test_ns_0
+	}
+	namespace upvar test_ns_0 x w
+	set w
+    }
+} -cleanup {
+    namespace delete test_ns_1
+} -result {test_ns_1::test_ns_0}
+test upvar-NS-1.8 {nsupvar links to correct variable} -body {
+    namespace eval test_ns_1 {
+	namespace eval test_ns_0 {
+	    variable x test_ns_1::test_ns_0
 	}
-    } \
-    -result {can't read "w": no such variable} \
-    -returnCodes error \
-    -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.7 {nsupvar links to correct variable} \
-    -body {
-	namespace eval test_ns_1 {
-	    namespace eval test_ns_0 {
-		variable x test_ns_1::test_ns_0
-	    }
+	proc a {} {
 	    namespace upvar test_ns_0 x w
 	    set w
 	}
-    } \
-    -result {test_ns_1::test_ns_0} \
-    -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.8 {nsupvar links to correct variable} \
-    -body {
-	namespace eval test_ns_1 {
-	    namespace eval test_ns_0 {
-		variable x test_ns_1::test_ns_0
-	    }
-	    proc a {} {
-		namespace upvar test_ns_0 x w
-		set w
-	    }
-	    return [a]
-	}
-    } \
-    -result {test_ns_1::test_ns_0} \
-    -cleanup {namespace delete test_ns_1}
-test upvar-NS-1.9 {nsupvar links to correct variable} \
-    -body {
-	namespace eval test_ns_1 {
-	    variable x test_ns_1
-	    proc a {} {
-		namespace upvar test_ns_0 x w
-		set w
-	    }
-	    return [a]
+	return [a]
+    }
+} -cleanup {
+    namespace delete test_ns_1
+} -result {test_ns_1::test_ns_0}
+test upvar-NS-1.9 {nsupvar links to correct variable} -body {
+    namespace eval test_ns_1 {
+	variable x test_ns_1
+	proc a {} {
+	    namespace upvar test_ns_0 x w
+	    set w
 	}
-    } \
-    -result {namespace "test_ns_0" not found in "::test_ns_1"} \
-    -returnCodes error \
-    -cleanup {namespace delete test_ns_1}
+	return [a]
+    }
+} -returnCodes error -cleanup {
+    namespace delete test_ns_1
+} -result {namespace "test_ns_0" not found in "::test_ns_1"}
 
 test upvar-NS-2.1 {TIP 323} -returnCodes error -body {
     namespace upvar
diff --git a/tests/var.test b/tests/var.test
index dd9483b..f2a858c 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -1,23 +1,23 @@
-# This file contains tests for the tclVar.c source file. Tests appear in
-# the same order as the C code that they test. The set of tests is
-# currently incomplete since it currently includes only new tests for
-# code changed for the addition of Tcl namespaces. Other variable-
-# related tests appear in several other test files including
-# namespace.test, set.test, trace.test, and upvar.test.
+# This file contains tests for the tclVar.c source file. Tests appear in the
+# same order as the C code that they test. The set of tests is currently
+# incomplete since it currently includes only new tests for code changed for
+# the addition of Tcl namespaces. Other variable-related tests appear in
+# several other test files including namespace.test, set.test, trace.test, and
+# upvar.test.
 #
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
 #
 # Copyright (c) 1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: var.test,v 1.36 2010/08/03 17:25:13 andreas_kupries Exp $
+# RCS: @(#) $Id: var.test,v 1.36.2.1 2010/12/11 18:39:30 kennykb Exp $
 #
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2.2
     namespace import -force ::tcltest::*
 }
@@ -35,13 +35,14 @@ catch {unset i}
 catch {unset a}
 catch {unset arr}
 
-test var-1.1 {TclLookupVar, Array handling} {
+test var-1.1 {TclLookupVar, Array handling} -setup {
     catch {unset a}
+} -body {
     set x "incr"  ;# force no compilation and runtime call to Tcl_IncrCmd 
     set i 10
     set arr(foo) 37
     list [$x i] $i [$x arr(foo)] $arr(foo)
-} {11 11 38 38}
+} -result {11 11 38 38}
 test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
     set x "global value"
     namespace eval test_ns_var {
@@ -71,34 +72,35 @@ test var-1.5 {TclLookupVar, active call frame pushed for namespace eval implies
 test var-1.6 {TclLookupVar, name starts with :: implies some namespace var} {
     namespace eval test_ns_var {set ::x}
 } {global value}
-test var-1.7 {TclLookupVar, error finding namespace var} {
-    list [catch {set a:::b} msg] $msg
-} {1 {can't read "a:::b": no such variable}}
-test var-1.8 {TclLookupVar, error finding namespace var} {
-    list [catch {set ::foobarfoo} msg] $msg
-} {1 {can't read "::foobarfoo": no such variable}}
+test var-1.7 {TclLookupVar, error finding namespace var} -body {
+    set a:::b
+} -returnCodes error -result {can't read "a:::b": no such variable}
+test var-1.8 {TclLookupVar, error finding namespace var} -body {
+    set ::foobarfoo
+} -returnCodes error -result {can't read "::foobarfoo": no such variable}
 test var-1.9 {TclLookupVar, create new namespace var} {
     namespace eval test_ns_var {
         set v hello
     }
 } {hello}
-test var-1.10 {TclLookupVar, create new namespace var} {
+test var-1.10 {TclLookupVar, create new namespace var} -setup {
     catch {unset y}
+} -body {
     namespace eval test_ns_var {
         set ::y 789
     }
     set y
-} {789}
-test var-1.11 {TclLookupVar, error creating new namespace var} {
+} -result {789}
+test var-1.11 {TclLookupVar, error creating new namespace var} -body {
     namespace eval test_ns_var {
-        list [catch {set ::test_ns_var::foo::bar 314159} msg] $msg
+        set ::test_ns_var::foo::bar 314159
     }
-} {1 {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}}
-test var-1.12 {TclLookupVar, error creating new namespace var} {
+} -returnCodes error -result {can't set "::test_ns_var::foo::bar": parent namespace doesn't exist}
+test var-1.12 {TclLookupVar, error creating new namespace var} -body {
     namespace eval test_ns_var {
-        list [catch {set ::test_ns_var::foo:: 1997} msg] $msg
+        set ::test_ns_var::foo:: 1997
     }
-} {1 {can't set "::test_ns_var::foo::": parent namespace doesn't exist}}
+} -returnCodes error -result {can't set "::test_ns_var::foo::": parent namespace doesn't exist}
 test var-1.13 {TclLookupVar, new namespace var is created in a particular namespace} {
     catch {unset aNeWnAmEiNnS}
     namespace eval test_ns_var {
@@ -177,24 +179,25 @@ test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array:
 	set result
     }
 } {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
-test var-1.19 {TclLookupVar, right error message when parsing variable name} {
-    list [catch {[format set] thisvar(doesntexist)} msg] $msg
-} {1 {can't read "thisvar(doesntexist)": no such variable}}
+test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
+    [format set] thisvar(doesntexist)
+} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
 
 test var-2.1 {Tcl_LappendObjCmd, create var if new} {
     catch {unset x}
     lappend x 1 2
 } {1 2}
 
-test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} {
+test var-3.1 {MakeUpvar, TCL_NAMESPACE_ONLY not specified for other var} -setup {
     catch {unset x}
+} -body {
     set x 1997
     proc p {} {
         global x  ;# calls MakeUpvar with TCL_NAMESPACE_ONLY for other var x
         return $x
     }
     p
-} {1997}
+} -result {1997}
 test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
     namespace eval test_ns_var {
         catch {unset v}
@@ -206,17 +209,19 @@ test var-3.2 {MakeUpvar, other var has TCL_NAMESPACE_ONLY specified} {
         p
     }
 } {1998}
-test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} testupvar {
+test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup {
     catch {unset a}
+} -constraints testupvar -body {
     set a 123321
     proc p {} {
 	# create global xx linked to global a
 	testupvar 1 a {} xx global 
     }
     list [p] $xx [set xx 789] $a
-} {{} 123321 789 789}
-test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} testupvar {
+} -result {{} 123321 789 789}
+test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
     catch {unset a}
+} -constraints testupvar -body {
     set a 456
     namespace eval test_ns_var {
 	catch {unset ::test_ns_var::vv}
@@ -227,58 +232,64 @@ test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} testupvar {
 	p
     }
     list $test_ns_var::vv [set test_ns_var::vv 123] $a
-} {456 123 123}
-test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} {
+} -result {456 123 123}
+test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
     catch {unset aaaaa}
     catch {unset xxxxx}
+} -body {
     set aaaaa 77777
     upvar #0 aaaaa xxxxx
     list [set xxxxx] [set aaaaa]
-} {77777 77777}
-test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} {
+} -result {77777 77777}
+test var-3.6 {MakeUpvar, active call frame pushed for namespace eval} -setup {
     catch {unset a}
+} -body {
     set a 121212
     namespace eval test_ns_var {
         upvar ::a vvv
         set vvv
     }
-} {121212}
-test var-3.7 {MakeUpvar, my var has ::s} {
+} -result {121212}
+test var-3.7 {MakeUpvar, my var has ::s} -setup {
     catch {unset a}
+} -body {
     set a 789789
     upvar #0 a test_ns_var::lnk
     namespace eval test_ns_var {
         set lnk
     }
-} {789789}
-test var-3.8 {MakeUpvar, my var already exists in global ns} {
+} -result {789789}
+test var-3.8 {MakeUpvar, my var already exists in global ns} -setup {
     catch {unset aaaaa}
     catch {unset xxxxx}
+} -body {
     set aaaaa 456654
     set xxxxx hello
     upvar #0 aaaaa xxxxx
     set xxxxx
-} {hello}
-test var-3.9 {MakeUpvar, my var has invalid ns name} {
+} -result {hello}
+test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
     catch {unset aaaaa}
+} -returnCodes error -body {
     set aaaaa 789789
-    list [catch {upvar #0 aaaaa test_ns_fred::lnk} msg] $msg
-} {1 {can't create "test_ns_fred::lnk": parent namespace doesn't exist}}
-test var-3.10 {MakeUpvar, } {
+    upvar #0 aaaaa test_ns_fred::lnk
+} -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist}
+test var-3.10 {MakeUpvar, between namespaces} -body {
     namespace eval {} {
-	set bar 0
+	variable bar 0
 	namespace eval foo upvar bar bar
 	set foo::bar 1
-	catch {list $bar $foo::bar} msg
-	unset ::aaaaa
-	set msg
+	list $bar $foo::bar
     }
-} {1 1}
-test var-3.11 {MakeUpvar, my var looks like array elem} -body {
+} -cleanup {
+    unset ::aaaaa
+} -result {1 1}
+test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
     catch {unset aaaaa}
+} -returnCodes error -body {
     set aaaaa 789789
     upvar #0 aaaaa foo(bar)
-} -returnCodes 1 -result {bad variable name "foo(bar)": upvar won't create a scalar variable that looks like an array element}
+} -result {bad variable name "foo(bar)": upvar won't create a scalar variable that looks like an array element}
 
 test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
     catch {unset a}
@@ -291,17 +302,19 @@ test var-4.2 {Tcl_GetVariableName, namespace variable} testgetvarfullname {
 	testgetvarfullname george namespace
     }
 } ::test_ns_var::george
-test var-4.3 {Tcl_GetVariableName, variable can't be array element} testgetvarfullname {
+test var-4.3 {Tcl_GetVariableName, variable can't be array element} -setup {
     catch {unset a}
+} -constraints testgetvarfullname -body {
     set a(1) foo
-    list [catch {testgetvarfullname a(1) global} msg] $msg
-} {1 {unknown variable "a(1)"}}
+    testgetvarfullname a(1) global
+} -returnCodes error -result {unknown variable "a(1)"}
 
-test var-5.1 {Tcl_GetVariableFullName, global variable} {
+test var-5.1 {Tcl_GetVariableFullName, global variable} -setup {
     catch {unset a}
+} -body {
     set a bar
     namespace which -variable a
-} {::a}
+} -result {::a}
 test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
     namespace eval test_ns_var {
         variable martha
@@ -316,11 +329,10 @@ test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
     namespace eval test_ns_var {
         variable boeing 777
     }
-    proc p {} {
+    apply {{} {
         global ::test_ns_var::boeing
         set boeing
-    }
-    p
+    }}
 } {777}
 test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
     namespace eval test_ns_var {
@@ -336,11 +348,10 @@ test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
 } {java}
 test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
     set ::test_ns_var::test_ns_nested:: 24
-    proc p {} {
+    apply {{} {
         global ::test_ns_var::test_ns_nested::
         set {}
-    }
-    p
+    }}
 } {24}
 test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} {
     # Test for Tcl Bug 480176
@@ -362,13 +373,14 @@ test var-6.6 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
     p
 } {}
 
-test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} {
+test var-7.1 {Tcl_VariableObjCmd, create and initialize one new ns variable} -setup {
     catch {namespace delete test_ns_var}
+} -body {
     namespace eval test_ns_var {
         variable one 1
     }
     list [info vars test_ns_var::*] [set test_ns_var::one]
-} {::test_ns_var::one 1}
+} -result {::test_ns_var::one 1}
 test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
     set two 2222222
     namespace eval test_ns_var {
@@ -390,10 +402,11 @@ test var-7.4 {Tcl_VariableObjCmd, list of vars} {
     list [lsort [info vars test_ns_var::*]] \
          [namespace eval test_ns_var {expr $three+$four}]
 } [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
-test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
+test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
     catch {unset a}
     catch {unset five}
     catch {unset six}
+} -body {
     set a ""
     set five 555
     set six  666
@@ -403,23 +416,25 @@ test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} {
     }
     lappend a $test_ns_var::five \
         [set test_ns_var::six 6] [set test_ns_var::six] $six
+} -cleanup {
     catch {unset five}
     catch {unset six}
-    set a
-} {5 5 6 6 666}
-catch {unset newvar}
-test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} {
+} -result {5 5 6 6 666}
+test var-7.6 {Tcl_VariableObjCmd, variable name can be qualified} -setup {
+    catch {unset newvar}
+} -body {
     namespace eval test_ns_var {
         variable ::newvar cheers!
     }
-    set newvar
-} {cheers!}
-catch {unset newvar}
-test var-7.7 {Tcl_VariableObjCmd, bad var name} {
+    return $newvar
+} -cleanup {
+    catch {unset newvar}
+} -result {cheers!}
+test var-7.7 {Tcl_VariableObjCmd, bad var name} -returnCodes error -body {
     namespace eval test_ns_var {
-        list [catch {variable sev:::en 7} msg] $msg
+        variable sev:::en 7
     }
-} {1 {can't define "sev:::en": parent namespace doesn't exist}}
+} -result {can't define "sev:::en": parent namespace doesn't exist}
 test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, leave value unchanged} {
     set a ""
     namespace eval test_ns_var {
@@ -430,8 +445,9 @@ test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, l
     }
     set a
 } {8 8}
-test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} {
+test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until namespace is destroyed or var is unset} -setup {
     catch {namespace delete test_ns_var2}
+} -body {
     set a ""
     namespace eval test_ns_var2 {
         variable x 123
@@ -451,8 +467,7 @@ test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until na
     lappend a [info exists test_ns_var2::y] [info exists test_ns_var2::z]
     lappend a [list [catch {unset test_ns_var2::z} msg] $msg]
     lappend a [namespace delete test_ns_var2]
-    set a
-} [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
+} -result [list [lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 1 0 0\
 	{1 {can't read "test_ns_var2::y": no such variable}}\
 	[lsort {::test_ns_var2::x ::test_ns_var2::y ::test_ns_var2::z}] 0 0\
 	hello 1 0\
@@ -496,20 +511,16 @@ test var-7.13 {Tcl_VariableObjCmd, variable named ":"} {
 	p
     }
 } {{My name is ":"} :}
-test var-7.14 {Tcl_VariableObjCmd, array element parameter} {
-    catch {namespace eval test_ns_var { variable arrayvar(1) }} res
-    set res
-} "can't define \"arrayvar(1)\": name refers to an element in an array"
-test var-7.15 {Tcl_VariableObjCmd, array element parameter} {
-    catch {
-	namespace eval test_ns_var { 
-	    variable arrayvar
-	    set arrayvar(1) x
-	    variable arrayvar(1) y
-	}   
-    } res
-    set res
-} "can't define \"arrayvar(1)\": name refers to an element in an array"
+test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
+    namespace eval test_ns_var { variable arrayvar(1) }
+} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
+test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
+    namespace eval test_ns_var { 
+	variable arrayvar
+	set arrayvar(1) x
+	variable arrayvar(1) y
+    }   
+} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
 test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
     variable
 } {}
@@ -519,158 +530,173 @@ test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
     }
 } {}
 
-test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} {
+test var-8.1 {TclDeleteVars, "unset" traces are called with fully-qualified var names} -setup {
     catch {namespace delete test_ns_var}
     catch {unset a}
+} -body {
     namespace eval test_ns_var {
         variable v 123
         variable info ""
-
         proc traceUnset {name1 name2 op} {
             variable info
             set info [concat $info [list $name1 $name2 $op]]
         }
-
         trace var v u [namespace code traceUnset]
     }
     list [unset test_ns_var::v] $test_ns_var::info
-} {{} {test_ns_var::v {} u}}
-
-test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called with fully-qualified var names} {
+} -result {{} {test_ns_var::v {} u}}
+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}
+} -body {
     set info ""
     namespace eval test_ns_var {
         variable v 123 1
         trace var v u ::traceUnset
     }
-
     proc traceUnset {name1 name2 op} {
 	set ::info [concat $::info [list $name1 $name2 $op]]
     }
-
     list [namespace delete test_ns_var] $::info
-} {{} {::test_ns_var::v {} u}}
+} -result {{} {::test_ns_var::v {} u}}
 
-test var-9.1 {behaviour of TclGet/SetVar simple get/set} testsetnoerr {
-    catch {unset u}; catch {unset v}
+test var-9.1 {behaviour of TclGet/SetVar simple get/set} -setup {
+    catch {unset u}
+    catch {unset v}
+} -constraints testsetnoerr -body {
     list \
-       [set u a; testsetnoerr u] \
-       [testsetnoerr v b] \
-       [testseterr u] \
-       [unset v; testseterr v b]
-} [list {before get a} {before set b} {before get a} {before set b}]
-test var-9.2 {behaviour of TclGet/SetVar namespace get/set} testsetnoerr {
+	[set u a; testsetnoerr u] \
+	[testsetnoerr v b] \
+	[testseterr u] \
+	[unset v; testseterr v b]
+} -result [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.2 {behaviour of TclGet/SetVar namespace get/set} -setup {
     catch {namespace delete ns}
+} -constraints testsetnoerr -body {
     namespace eval ns {variable u a; variable v}
     list \
-       [testsetnoerr ns::u] \
-       [testsetnoerr ns::v b] \
-       [testseterr ns::u] \
-       [unset ns::v; testseterr ns::v b]
-} [list {before get a} {before set b} {before get a} {before set b}]
-test var-9.3 {behaviour of TclGetVar no variable} testsetnoerr {
+	[testsetnoerr ns::u] \
+	[testsetnoerr ns::v b] \
+	[testseterr ns::u] \
+	[unset ns::v; testseterr ns::v b]
+} -result [list {before get a} {before set b} {before get a} {before set b}]
+test var-9.3 {behaviour of TclGetVar no variable} -setup {
     catch {unset u}
+} -constraints testsetnoerr -body {
     list \
-       [catch {testsetnoerr u} res] $res \
-       [catch {testseterr u} res] $res
-} {1 {before get} 1 {can't read "u": no such variable}}
-test var-9.4 {behaviour of TclGetVar no namespace variable} testsetnoerr {
+	[catch {testsetnoerr u} res] $res \
+	[catch {testseterr u} res] $res
+} -result {1 {before get} 1 {can't read "u": no such variable}}
+test var-9.4 {behaviour of TclGetVar no namespace variable} -setup {
     catch {namespace delete ns}
+} -constraints testsetnoerr -body {
     namespace eval ns {}
     list \
-       [catch {testsetnoerr ns::w} res] $res \
-       [catch {testseterr ns::w} res] $res
-} {1 {before get} 1 {can't read "ns::w": no such variable}}
-test var-9.5 {behaviour of TclGetVar no namespace} testsetnoerr {
+	[catch {testsetnoerr ns::w} res] $res \
+	[catch {testseterr ns::w} res] $res
+} -result {1 {before get} 1 {can't read "ns::w": no such variable}}
+test var-9.5 {behaviour of TclGetVar no namespace} -setup {
     catch {namespace delete ns}
+} -constraints testsetnoerr -body {
     list \
-       [catch {testsetnoerr ns::u} res] $res \
-       [catch {testseterr ns::v} res] $res
-} {1 {before get} 1 {can't read "ns::v": no such variable}}
-test var-9.6 {behaviour of TclSetVar no namespace} testsetnoerr {
+	[catch {testsetnoerr ns::u} res] $res \
+	[catch {testseterr ns::v} res] $res
+} -result {1 {before get} 1 {can't read "ns::v": no such variable}}
+test var-9.6 {behaviour of TclSetVar no namespace} -setup {
     catch {namespace delete ns}
+} -constraints testsetnoerr -body {
     list \
-       [catch {testsetnoerr ns::v 1} res] $res \
-       [catch {testseterr ns::v 1} res] $res
-} {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
-test var-9.7 {behaviour of TclGetVar array variable} testsetnoerr {
+	[catch {testsetnoerr ns::v 1} res] $res \
+	[catch {testseterr ns::v 1} res] $res
+} -result {1 {before set} 1 {can't set "ns::v": parent namespace doesn't exist}}
+test var-9.7 {behaviour of TclGetVar array variable} -setup {
     catch {unset arr}
-    set arr(1) 1;
+} -constraints testsetnoerr -body {
+    set arr(1) 1
     list \
-       [catch {testsetnoerr arr} res] $res \
-       [catch {testseterr arr} res] $res
-} {1 {before get} 1 {can't read "arr": variable is array}}
-test var-9.8 {behaviour of TclSetVar array variable} testsetnoerr {
+	[catch {testsetnoerr arr} res] $res \
+	[catch {testseterr arr} res] $res
+} -result {1 {before get} 1 {can't read "arr": variable is array}}
+test var-9.8 {behaviour of TclSetVar array variable} -setup {
     catch {unset arr}
+} -constraints testsetnoerr -body {
     set arr(1) 1
     list \
-       [catch {testsetnoerr arr 2} res] $res \
-       [catch {testseterr arr 2} res] $res
-} {1 {before set} 1 {can't set "arr": variable is array}}
-test var-9.9 {behaviour of TclGetVar read trace success} testsetnoerr {
+	[catch {testsetnoerr arr 2} res] $res \
+	[catch {testseterr arr 2} res] $res
+} -result {1 {before set} 1 {can't set "arr": variable is array}}
+test var-9.9 {behaviour of TclGetVar read trace success} -setup {
+    catch {unset u}
+    catch {unset v}
+} -constraints testsetnoerr -body {
     proc resetvar {val name elem op} {upvar 1 $name v; set v $val}
-    catch {unset u}; catch {unset v}
     set u 10
     trace var u r [list resetvar 1]
     trace var v r [list resetvar 2]
     list \
-       [testsetnoerr u] \
-       [testseterr v]
-} {{before get 1} {before get 2}}
+	[testsetnoerr u] \
+	[testseterr v]
+} -result {{before get 1} {before get 2}}
 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
     list \
-       [catch {testsetnoerr v} msg] $msg \
-       [catch {testseterr v} msg] $msg
+	[catch {testsetnoerr v} msg] $msg \
+	[catch {testseterr v} msg] $msg
 } {1 {before get} 1 {can't read "v": write-only}}
-test var-9.11 {behaviour of TclSetVar write trace success} testsetnoerr {
+test var-9.11 {behaviour of TclSetVar write trace success} -setup {
+    catch {unset u}
+    catch {unset v}
+} -constraints testsetnoerr -body {
     proc doubleval {name elem op} {upvar 1 $name v; set v [expr {2 * $v}]}
-    catch {unset u}; catch {unset v}
     set v 1
     trace var v w doubleval
     trace var u w doubleval
     list \
-       [testsetnoerr u 2] \
-       [testseterr v 3]
-} {{before set 4} {before set 6}}
+	[testsetnoerr u 2] \
+	[testseterr v 3]
+} -result {{before set 4} {before set 6}}
 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
     list \
-       [catch {testsetnoerr v 2} msg] $msg $v \
-       [catch {testseterr v 3} msg] $msg $v
+	[catch {testsetnoerr v 2} msg] $msg $v \
+	[catch {testseterr v 3} msg] $msg $v
 } {1 {before set} 2 1 {can't set "v": read-only} 3}
 
-test var-10.1 {can't nest arrays with array set} {
+test var-10.1 {can't nest arrays with array set} -setup {
    catch {unset arr}
-   list [catch {array set arr(x) {a 1 b 2}} res] $res
-} {1 {can't set "arr(x)": variable isn't array}}
-test var-10.2 {can't nest arrays with array set} {
+} -returnCodes error -body {
+   array set arr(x) {a 1 b 2}
+} -result {can't set "arr(x)": variable isn't array}
+test var-10.2 {can't nest arrays with array set} -setup {
    catch {unset arr}
-   list [catch {array set arr(x) {}} res] $res
-} {1 {can't set "arr(x)": variable isn't array}}
+} -returnCodes error -body {
+   array set arr(x) {}
+} -result {can't set "arr(x)": variable isn't array}
 
-test var-11.1 {array unset} {
+test var-11.1 {array unset} -setup {
     catch {unset a}
+} -body {
     array set a { 1,1 a 1,2 b 2,1 c 2,3 d }
     array unset a 1,*
     lsort -dict [array names a]
-} {2,1 2,3}
-test var-11.2 {array unset} {
+} -result {2,1 2,3}
+test var-11.2 {array unset} -setup {
     catch {unset a}
+} -body {
     array set a { 1,1 a 1,2 b }
     array unset a
     array exists a
-} 0
-test var-11.3 {array unset errors} {
+} -result 0
+test var-11.3 {array unset errors} -setup {
     catch {unset a}
+} -returnCodes error -body {
     array set a { 1,1 a 1,2 b }
-    list [catch {array unset a pattern too} msg] $msg
-} {1 {wrong # args: should be "array unset arrayName ?pattern?"}}
+    array unset a pattern too
+} -result {wrong # args: should be "array unset arrayName ?pattern?"}
 
 test var-12.1 {TclFindCompiledLocals, {} array name} {
     namespace eval n {
@@ -687,8 +713,9 @@ test var-12.1 {TclFindCompiledLocals, {} array name} {
     }
 } {0 1 2 2,foo}
 
-test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} {
+test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} -setup {
     catch {unset t}
+} -body {
     proc foo {var ind op} {
 	global t
 	set foo bar
@@ -699,15 +726,14 @@ test var-13.1 {Tcl_UnsetVar2, unset array with trace set on element} {
 	unset t
     }
     set x "If you see this, it worked"
-} "If you see this, it worked"
+} -result "If you see this, it worked"
 
 test var-14.1 {array names syntax} -body {
     array names foo bar baz snafu
 } -returnCodes 1 -match glob -result *
-
 test var-14.2 {array names -glob} -body {
     array names tcl_platform -glob os
-} -returnCodes 0 -match exact -result os
+} -result os
 
 test var-15.1 {segfault in [unset], [Bug 735335]} {
     proc A { name } {
@@ -723,7 +749,6 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
     namespace eval test unset useSomeUnlikelyNameHere
 } {}
 
-
 test var-16.1 {CallVarTraces: save/restore interp error state} {
     trace add variable ::errorCode write " ;#"
     catch {error foo bar baz}
@@ -763,7 +788,6 @@ test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
     unset x already
 } -result 0
 
-
 test var-19.1 {crash when freeing locals hashtable: Bug 3037525} {
     proc foo {} { catch {upvar 0 dummy \$index} }
     foo ; # This crashes without the fix for the bug