155 files changed, 65769 insertions, 19420 deletions

diff --git a/tests/README b/tests/README
index 75a08e7..ce2382e 100644
--- a/tests/README
+++ b/tests/README
@@ -1,7 +1,5 @@
 README -- Tcl test suite design document.
 
-RCS: @(#) $Id: README,v 1.12 2003/04/01 19:17:21 dgp Exp $
-
 Contents:
 ---------
 
diff --git a/tests/all.tcl b/tests/all.tcl
index f83536d..05d3024 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -9,11 +9,11 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-# 
-# RCS: @(#) $Id: all.tcl,v 1.18 2004/10/30 02:16:52 dgp Exp $
 
+package prefer latest
 package require Tcl 8.5
 package require tcltest 2.2
 namespace import tcltest::*
-configure {expand}$argv -testdir [file dir [info script]]
+configure {*}$argv -testdir [file dir [info script]]
 runAllTests
+proc exit args {}
diff --git a/tests/append.test b/tests/append.test
index 58c0de7..69c6381 100644
--- a/tests/append.test
+++ b/tests/append.test
@@ -1,26 +1,24 @@
 # Commands covered:  append lappend
 #
-# 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-1996 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.
-#
-# RCS: @(#) $Id: append.test,v 1.7 2001/07/03 23:39:24 hobbs Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    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} {
@@ -44,37 +42,37 @@ test append-2.1 {long appends} {
     expr {$x == $y}
 } 1
 
-test append-3.1 {append errors} {
-    list [catch {append} msg] $msg
-} {1 {wrong # args: should be "append varName ?value value ...?"}}
-test append-3.2 {append errors} {
+test append-3.1 {append errors} -returnCodes error -body {
+    append
+} -result {wrong # args: should be "append varName ?value ...?"}
+test append-3.2 {append errors} -returnCodes error -body {
     set x ""
-    list [catch {append x(0) 44} msg] $msg
-} {1 {can't set "x(0)": variable isn't array}}
-test append-3.3 {append errors} {
-    catch {unset x}
-    list [catch {append x} msg] $msg
-} {1 {can't read "x": no such variable}}
+    append x(0) 44
+} -result {can't set "x(0)": variable isn't array}
+test append-3.3 {append errors} -returnCodes error -body {
+    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} {
     set x ""
     list [lappend x first] [lappend x second] [lappend x third] $x
 } {first {first second} {first second third} {first second third}}
-test append-4.3 {lappend command} {
+test append-4.3 {lappend command} -body {
     proc foo {} {
 	global x
 	set x old
 	unset x
 	lappend x new
     }
-    set result [foo]
+    foo
+} -cleanup {
     rename foo {}
-    set result
-} {new}
+} -result {new}
 test append-4.4 {lappend command} {
     set x {}
     lappend x \{\  abc
@@ -95,22 +93,22 @@ test append-4.8 {lappend command} {
     set x "\\\{"
     lappend x abc
 } "\\{ abc"
-test append-4.9 {lappend command} {
+test append-4.9 {lappend command} -returnCodes error -body {
     set x " \{"
-    list [catch {lappend x abc} msg] $msg
-} {1 {unmatched open brace in list}}
-test append-4.10 {lappend command} {
+    lappend x abc
+} -result {unmatched open brace in list}
+test append-4.10 {lappend command} -returnCodes error -body {
     set x "	\{"
-    list [catch {lappend x abc} msg] $msg
-} {1 {unmatched open brace in list}}
-test append-4.11 {lappend command} {
+    lappend x abc
+} -result {unmatched open brace in list}
+test append-4.11 {lappend command} -returnCodes error -body {
     set x "\{\{\{"
-    list [catch {lappend x abc} msg] $msg
-} {1 {unmatched open brace in list}}
-test append-4.12 {lappend command} {
+    lappend x abc
+} -result {unmatched open brace in list}
+test append-4.12 {lappend command} -returnCodes error -body {
     set x "x \{\{\{"
-    list [catch {lappend x abc} msg] $msg
-} {1 {unmatched open brace in list}}
+    lappend x abc
+} -result {unmatched open brace in list}
 test append-4.13 {lappend command} {
     set x "x\{\{\{"
     lappend x abc
@@ -128,55 +126,68 @@ 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
+test append-4.21 {lappend command} -returnCodes error -body {
+    set x \"
+    lappend x
+} -result {unmatched open quote in list}
+test append-4.22 {lappend command} -returnCodes error -body {
+    set x \"
+    lappend x abc
+} -result {unmatched open quote in list}
 
-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 append-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} {set i [expr $i+1]} {
+	    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 append-5.1 {long lappends} {
-    catch {unset x}
+} -body {
     set x ""
-    for {set i 0} {$i < 300} {set i [expr $i+1]} {
+    for {set i 0} {$i < 300} {incr i} {
 	lappend x "item $i"
     }
     check $x 300
-} ok
+} -cleanup {
+    rename check {}
+} -result ok
 
-test append-6.1 {lappend errors} {
-    list [catch {lappend} msg] $msg
-} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
-test append-6.2 {lappend errors} {
+test append-6.1 {lappend errors} -returnCodes error -body {
+    lappend
+} -result {wrong # args: should be "lappend varName ?value ...?"}
+test append-6.2 {lappend errors} -returnCodes error -body {
     set x ""
-    list [catch {lappend x(0) 44} msg] $msg
-} {1 {can't set "x(0)": variable isn't array}}
+    lappend x(0) 44
+} -result {can't set "x(0)": variable isn't array}
 
-test append-7.1 {lappend-created var and error in trace on that var} {
+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}
     catch {lappend x 1}
@@ -185,48 +196,111 @@ test append-7.1 {lappend-created var and error in trace on that var} {
     set x
     lappend x 1
     list [info exists x] [catch {set x} msg] $msg
-} {0 1 {can't read "x": no such variable}}
-test append-7.2 {lappend var triggers read trace} {
-    catch {unset myvar}
-    catch {unset ::result}
+} -result {0 1 {can't read "x": no such variable}}
+test append-7.2 {lappend var triggers read trace} -setup {
+    unset -nocomplain myvar
+    unset -nocomplain ::result
+} -body {
     trace variable myvar r foo
     proc foo {args} {append ::result $args}
     lappend myvar a
-    list [catch {set ::result} msg] $msg
-} {0 {myvar {} r}}
-test append-7.3 {lappend var triggers read trace, array var} {
-    # The behavior of read triggers on lappend changed in 8.0 to
-    # not trigger them, and was changed back in 8.4.
-    catch {unset myvar}
-    catch {unset ::result}
+    return $::result
+} -result {myvar {} r}
+test append-7.3 {lappend var triggers read trace, array var} -setup {
+    unset -nocomplain myvar
+    unset -nocomplain ::result
+} -body {
+    # The behavior of read triggers on lappend changed in 8.0 to not trigger
+    # them, and was changed back in 8.4.
     trace variable myvar r foo
     proc foo {args} {append ::result $args}
     lappend myvar(b) a
-    list [catch {set ::result} msg] $msg
-} {0 {myvar b r}}
-test append-7.4 {lappend var triggers read trace, array var exists} {
-    catch {unset myvar}
-    catch {unset ::result}
+    return $::result
+} -result {myvar b r}
+test append-7.4 {lappend var triggers read trace, array var exists} -setup {
+    unset -nocomplain myvar
+    unset -nocomplain ::result
+} -body {
     set myvar(0) 1
     trace variable myvar r foo
     proc foo {args} {append ::result $args}
     lappend myvar(b) a
-    list [catch {set ::result} msg] $msg
-} {0 {myvar b r}}
-test append-7.5 {append var does not trigger read trace} {
-    catch {unset myvar}
-    catch {unset ::result}
+    return $::result
+} -result {myvar b r}
+test append-7.5 {append var does not trigger read trace} -setup {
+    unset -nocomplain myvar
+    unset -nocomplain ::result
+} -body {
     trace variable myvar r foo
     proc foo {args} {append ::result $args}
     append myvar a
     info exists ::result
-} {0}
+} -result {0}
 
+# THERE ARE NO append-8.* TESTS
 
-catch {unset i x result y}
+# 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} -setup {
+    unset -nocomplain myvar
+} -body {
+    array set myvar {}
+    proc nonull {var key val} {
+	upvar 1 $var lvar
+	if {![info exists lvar($key)]} {
+	    return -code error "no such variable"
+	}
+    }
+    trace add variable myvar read nonull
+    list [catch {
+	lappend myvar(key) "new value"
+    } msg] $msg
+} -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
+} -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
+	if {![info exists lvar($key)]} {
+	    return -code error "no such variable"
+	}
+    }
+    trace add variable myvar read nonull
+    list [catch {
+	append myvar(key) "new value"
+    } msg] $msg
+} -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
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
+unset -nocomplain i x result y
 catch {rename foo ""}
-catch {rename check ""}
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/appendComp.test b/tests/appendComp.test
index c946d35..f85c3ba 100644
--- a/tests/appendComp.test
+++ b/tests/appendComp.test
@@ -1,29 +1,28 @@
 # Commands covered:  append lappend
 #
-# 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-1996 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.
-#
-# RCS: @(#) $Id: appendComp.test,v 1.9 2005/05/10 18:34:56 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 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 ""
@@ -54,29 +53,29 @@ test appendComp-2.1 {long appends} {
     foo
 } 1
 
-test appendComp-3.1 {append errors} {
+test appendComp-3.1 {append errors} -returnCodes error -body {
     proc foo {} {append}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "append varName ?value value ...?"}}
-test appendComp-3.2 {append errors} {
+    foo
+} -result {wrong # args: should be "append varName ?value ...?"}
+test appendComp-3.2 {append errors} -returnCodes error -body {
     proc foo {} {
 	set x ""
 	append x(0) 44
     }
-    list [catch {foo} msg] $msg
-} {1 {can't set "x(0)": variable isn't array}}
-test appendComp-3.3 {append errors} {
+    foo
+} -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
     }
-    list [catch {foo} msg] $msg
-} {1 {can't read "x": no such variable}}
+    foo
+} -result {can't read "x": no such variable}
 
 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
@@ -134,34 +133,34 @@ test appendComp-4.8 {lappend command} {
     }
     foo
 } "\\{ abc"
-test appendComp-4.9 {lappend command} {
+test appendComp-4.9 {lappend command} -returnCodes error -body {
     proc foo {} {
 	set x " \{"
-	list [catch {lappend x abc} msg] $msg
+	lappend x abc
     }
     foo
-} {1 {unmatched open brace in list}}
-test appendComp-4.10 {lappend command} {
+} -result {unmatched open brace in list}
+test appendComp-4.10 {lappend command} -returnCodes error -body {
     proc foo {} {
 	set x "	\{"
-	list [catch {lappend x abc} msg] $msg
+	lappend x abc
     }
     foo
-} {1 {unmatched open brace in list}}
-test appendComp-4.11 {lappend command} {
+} -result {unmatched open brace in list}
+test appendComp-4.11 {lappend command} -returnCodes error -body {
     proc foo {} {
 	set x "\{\{\{"
-	list [catch {lappend x abc} msg] $msg
+	lappend x abc
     }
     foo
-} {1 {unmatched open brace in list}}
-test appendComp-4.12 {lappend command} {
+} -result {unmatched open brace in list}
+test appendComp-4.12 {lappend command} -returnCodes error -body {
     proc foo {} {
 	set x "x \{\{\{"
-	list [catch {lappend x abc} msg] $msg
+	lappend x abc
     }
     foo
-} {1 {unmatched open brace in list}}
+} -result {unmatched open brace in list}
 test appendComp-4.13 {lappend command} {
     proc foo {} {
 	set x "x\{\{\{"
@@ -207,45 +206,50 @@ 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} {
+test appendComp-6.1 {lappend errors} -returnCodes error -body {
     proc foo {} {lappend}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "lappend varName ?value value ...?"}}
-test appendComp-6.2 {lappend errors} {
+    foo
+} -result {wrong # args: should be "lappend varName ?value ...?"}
+test appendComp-6.2 {lappend errors} -returnCodes error -body {
     proc foo {} {
 	set x ""
 	lappend x(0) 44
     }
-    list [catch {foo} msg] $msg
-} {1 {can't set "x(0)": variable isn't array}}
+    foo
+} -result {can't set "x(0)": variable isn't array}
 
-test appendComp-7.1 {lappendComp-created var and error in trace on that var} {
+test appendComp-7.1 {lappendComp-created var and error in trace on that var} -setup {
+    catch {rename foo ""}
+    unset -nocomplain x
+} -body {
     proc bar {} {
 	global x
-	catch {rename foo ""}
-	catch {unset x}
 	trace variable x w foo
 	proc foo {} {global x; unset x}
 	catch {lappend x 1}
@@ -256,100 +260,103 @@ test appendComp-7.1 {lappendComp-created var and error in trace on that var} {
 	list [info exists x] [catch {set x} msg] $msg
     }
     bar
-} {0 1 {can't read "x": no such variable}}
-test appendComp-7.2 {lappend var triggers read trace, index var} {
+} -result {0 1 {can't read "x": no such variable}}
+test appendComp-7.2 {lappend var triggers read trace, index var} -setup {
+    unset -nocomplain ::result
+} -body {
     proc bar {} {
-	catch {unset myvar}
-	catch {unset ::result}
 	trace variable myvar r foo
 	proc foo {args} {append ::result $args}
 	lappend myvar a
-	list [catch {set ::result} msg] $msg
+	return $::result
     }
     bar
-} {0 {myvar {} r}}
-test appendComp-7.3 {lappend var triggers read trace, stack var} {
+} -result {myvar {} r} -constraints {bug-3057639}
+test appendComp-7.3 {lappend var triggers read trace, stack var} -setup {
+    unset -nocomplain ::result
+    unset -nocomplain ::myvar
+} -body {
     proc bar {} {
-	catch {unset ::myvar}
-	catch {unset ::result}
 	trace variable ::myvar r foo
 	proc foo {args} {append ::result $args}
 	lappend ::myvar a
-	list [catch {set ::result} msg] $msg
+	return $::result
     }
     bar
-} {0 {::myvar {} r}}
-test appendComp-7.4 {lappend var triggers read trace, array var} {
-    # The behavior of read triggers on lappend changed in 8.0 to
-    # not trigger them.  Maybe not correct, but been there a while.
+} -result {::myvar {} r} -constraints {bug-3057639}
+test appendComp-7.4 {lappend var triggers read trace, array var} -setup {
+    unset -nocomplain ::result
+} -body {
+    # The behavior of read triggers on lappend changed in 8.0 to not trigger
+    # them. Maybe not correct, but been there a while.
     proc bar {} {
-	catch {unset myvar}
-	catch {unset ::result}
 	trace variable myvar r foo
 	proc foo {args} {append ::result $args}
 	lappend myvar(b) a
-	list [catch {set ::result} msg] $msg
+	return $::result
     }
     bar
-} {0 {myvar b r}}
-test appendComp-7.5 {lappend var triggers read trace, array var} {
-    # The behavior of read triggers on lappend changed in 8.0 to
-    # not trigger them.  Maybe not correct, but been there a while.
+} -result {myvar b r} -constraints {bug-3057639}
+test appendComp-7.5 {lappend var triggers read trace, array var} -setup {
+    unset -nocomplain ::result
+} -body {
+    # The behavior of read triggers on lappend changed in 8.0 to not trigger
+    # them. Maybe not correct, but been there a while.
     proc bar {} {
-	catch {unset myvar}
-	catch {unset ::result}
 	trace variable myvar r foo
 	proc foo {args} {append ::result $args}
 	lappend myvar(b) a b
-	list [catch {set ::result} msg] $msg
+	return $::result
     }
     bar
-} {0 {myvar b r}}
-test appendComp-7.6 {lappend var triggers read trace, array var exists} {
+} -result {myvar b r}
+test appendComp-7.6 {lappend var triggers read trace, array var exists} -setup {
+    unset -nocomplain ::result
+} -body {
     proc bar {} {
-	catch {unset myvar}
-	catch {unset ::result}
 	set myvar(0) 1
 	trace variable myvar r foo
 	proc foo {args} {append ::result $args}
 	lappend myvar(b) a
-	list [catch {set ::result} msg] $msg
+	return $::result
     }
     bar
-} {0 {myvar b r}}
-test appendComp-7.7 {lappend var triggers read trace, array stack var} {
+} -result {myvar b r} -constraints {bug-3057639}
+test appendComp-7.7 {lappend var triggers read trace, array stack var} -setup {
+    unset -nocomplain ::myvar
+    unset -nocomplain ::result
+} -body {
     proc bar {} {
-	catch {unset ::myvar}
-	catch {unset ::result}
 	trace variable ::myvar r foo
 	proc foo {args} {append ::result $args}
 	lappend ::myvar(b) a
-	list [catch {set ::result} msg] $msg
+	return $::result
     }
     bar
-} {0 {::myvar b r}}
-test appendComp-7.8 {lappend var triggers read trace, array stack var} {
+} -result {::myvar b r} -constraints {bug-3057639}
+test appendComp-7.8 {lappend var triggers read trace, array stack var} -setup {
+    unset -nocomplain ::myvar
+    unset -nocomplain ::result
+} -body {
     proc bar {} {
-	catch {unset ::myvar}
-	catch {unset ::result}
 	trace variable ::myvar r foo
 	proc foo {args} {append ::result $args}
 	lappend ::myvar(b) a b
-	list [catch {set ::result} msg] $msg
+	return $::result
     }
     bar
-} {0 {::myvar b r}}
-test appendComp-7.9 {append var does not trigger read trace} {
+} -result {::myvar b r}
+test appendComp-7.9 {append var does not trigger read trace} -setup {
+    unset -nocomplain ::result
+} -body {
     proc bar {} {
-	catch {unset myvar}
-	catch {unset ::result}
 	trace variable myvar r foo
 	proc foo {args} {append ::result $args}
 	append myvar a
 	info exists ::result
     }
     bar
-} {0}
+} -result {0}
 
 test appendComp-8.1 {defer error to runtime} -setup {
     interp create slave
@@ -365,6 +372,73 @@ 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.
+
+# 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.
+
+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)]} {
+	    return -code error "BOOM. no such variable"
+	}
+    }
+    trace add variable myvar read nonull
+    proc foo {} {
+	lappend ::myvar(key) "new value"
+    }
+    list [catch { foo } msg] $msg
+} -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
+} -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)]} {
+	    return -code error "BOOM. no such variable"
+	}
+    }
+    trace add variable myvar read nonull
+    proc foo {} {
+	append ::myvar(key) "new value"
+    }
+    list [catch { foo } msg] $msg
+} -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
+} -cleanup {
+    unset -nocomplain ::env(__DUMMY__)
+} -result {0 {new value}}
+
 catch {unset i x result y}
 catch {rename foo ""}
 catch {rename bar ""}
@@ -374,3 +448,8 @@ catch {rename bar {}}
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/apply.test b/tests/apply.test
new file mode 100644
index 0000000..ba19b81
--- /dev/null
+++ b/tests/apply.test
@@ -0,0 +1,321 @@
+# Commands covered:  apply
+#
+# 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-1996 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2005-2006 Miguel Sofer
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.2
+    namespace import -force ::tcltest::*
+}
+
+if {[info commands ::apply] eq {}} {
+    return
+}
+
+testConstraint memory [llength [info commands memory]]
+
+# Tests for wrong number of arguments
+
+test apply-1.1 {too few arguments} -returnCodes error -body {
+    apply
+} -result {wrong # args: should be "apply lambdaExpr ?arg ...?"}
+
+# Tests for malformed lambda
+
+test apply-2.0 {malformed lambda} -returnCodes error -body {
+    set lambda a
+    apply $lambda
+} -result {can't interpret "a" as a lambda expression}
+test apply-2.1 {malformed lambda} -returnCodes error -body {
+    set lambda [list a b c d]
+    apply $lambda
+} -result {can't interpret "a b c d" as a lambda expression}
+test apply-2.2 {malformed lambda} {
+    set lambda [list {{}} boo]
+    list [catch {apply $lambda} msg] $msg $::errorInfo
+} {1 {argument with no name} {argument with no name
+    (parsing lambda expression "{{}} boo")
+    invoked from within
+"apply $lambda"}}
+test apply-2.3 {malformed lambda} {
+    set lambda [list {{a b c}} boo]
+    list [catch {apply $lambda} msg] $msg $::errorInfo
+} {1 {too many fields in argument specifier "a b c"} {too many fields in argument specifier "a b c"
+    (parsing lambda expression "{{a b c}} boo")
+    invoked from within
+"apply $lambda"}}
+test apply-2.4 {malformed lambda} {
+    set lambda [list a(1) boo]
+    list [catch {apply $lambda} msg] $msg $::errorInfo
+} {1 {formal parameter "a(1)" is an array element} {formal parameter "a(1)" is an array element
+    (parsing lambda expression "a(1) boo")
+    invoked from within
+"apply $lambda"}}
+test apply-2.5 {malformed lambda} {
+    set lambda [list a::b boo]
+    list [catch {apply $lambda} msg] $msg $::errorInfo
+} {1 {formal parameter "a::b" is not a simple name} {formal parameter "a::b" is not a simple name
+    (parsing lambda expression "a::b boo")
+    invoked from within
+"apply $lambda"}}
+
+# Tests for runtime errors in the lambda expression
+
+test apply-3.1 {non-existing namespace} -body {
+    apply [list x {set x 1} ::NONEXIST::FOR::SURE] x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+test apply-3.2 {non-existing namespace} -body {
+    namespace eval ::NONEXIST::FOR::SURE {}
+    set lambda [list x {set x 1} ::NONEXIST::FOR::SURE]
+    apply $lambda x
+    namespace delete ::NONEXIST
+    apply $lambda x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+test apply-3.3 {non-existing namespace} -body {
+    apply [list x {set x 1} NONEXIST::FOR::SURE] x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+test apply-3.4 {non-existing namespace} -body {
+    namespace eval ::NONEXIST::FOR::SURE {}
+    set lambda [list x {set x 1} NONEXIST::FOR::SURE]
+    apply $lambda x
+    namespace delete ::NONEXIST
+    apply $lambda x
+} -returnCodes error -result {namespace "::NONEXIST::FOR::SURE" not found}
+
+test apply-4.1 {error in arguments to lambda expression} -body {
+    set lambda [list x {set x 1}]
+    apply $lambda
+} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"}
+test apply-4.2 {error in arguments to lambda expression} -body {
+    set lambda [list x {set x 1}]
+    apply $lambda a b
+} -returnCodes error -result {wrong # args: should be "apply lambdaExpr x"}
+test apply-4.3 {error in arguments to lambda expression} -body {
+    interp alias {} foo {} ::apply [list x {set x 1}]
+    foo a b
+} -cleanup {
+    rename foo {}
+} -returnCodes error -result {wrong # args: should be "foo x"}
+test apply-4.4 {error in arguments to lambda expression} -body {
+    interp alias {} foo {} ::apply [list x {set x 1}] a
+    foo b
+} -cleanup {
+    rename foo {}
+} -returnCodes error -result {wrong # args: should be "foo"}
+test apply-4.5 {error in arguments to lambda expression} -body {
+    set lambda [list x {set x 1}]
+    namespace eval a {
+	namespace ensemble create -command ::bar -map {id {::a::const foo}}
+	proc const val { return $val }
+	proc alias {object slot = command args} {
+	    set map [namespace ensemble configure $object -map]
+	    dict set map $slot [linsert $args 0 $command]
+	    namespace ensemble configure $object -map $map
+	}
+	proc method {object name params body} {
+	    set params [linsert $params 0 self]
+	    alias $object $name = ::apply [list $params $body] $object
+	}
+	method ::bar boo x {return "[expr {$x*$x}] - $self"}
+    }
+    bar boo
+} -cleanup {
+    namespace delete ::a
+} -returnCodes error -result {wrong # args: should be "bar boo x"}
+
+test apply-5.1 {runtime error in lambda expression} {
+    set lambda [list {} {error foo}]
+    set res [catch {apply $lambda}]
+    list $res $::errorInfo
+} {1 {foo
+    while executing
+"error foo"
+    (lambda term "{} {error foo}" line 1)
+    invoked from within
+"apply $lambda"}}
+
+# Tests for correct execution; as the implementation is the same as that for
+# procs, the general functionality is mostly tested elsewhere
+
+test apply-6.1 {info level} {
+    set lev [info level]
+    set lambda [list {} {info level}]
+    expr {[apply $lambda] - $lev}
+} 1
+test apply-6.2 {info level} {
+    set lambda [list {} {info level 0}]
+    apply $lambda
+} {apply {{} {info level 0}}}
+test apply-6.3 {info level} {
+    set lambda [list args {info level 0}]
+    apply $lambda x y
+} {apply {args {info level 0}} x y}
+
+# Tests for correct namespace scope
+
+namespace eval ::testApply {
+    proc testApply args {return testApply}
+}
+
+test apply-7.1 {namespace access} {
+    set ::testApply::x 0
+    set body {set x 1; set x}
+    list [apply [list args $body ::testApply]] $::testApply::x
+} {1 0}
+test apply-7.2 {namespace access} {
+    set ::testApply::x 0
+    set body {variable x; set x}
+    list [apply [list args $body ::testApply]] $::testApply::x
+} {0 0}
+test apply-7.3 {namespace access} {
+    set ::testApply::x 0
+    set body {variable x; set x 1}
+    list [apply [list args $body ::testApply]] $::testApply::x
+} {1 1}
+test apply-7.4 {namespace access} {
+    set ::testApply::x 0
+    set body {testApply}
+    apply [list args $body ::testApply]
+} testApply
+test apply-7.5 {namespace access} {
+    set ::testApply::x 0
+    set body {set x 1; set x}
+    list [apply [list args $body testApply]] $::testApply::x
+} {1 0}
+test apply-7.6 {namespace access} {
+    set ::testApply::x 0
+    set body {variable x; set x}
+    list [apply [list args $body testApply]] $::testApply::x
+} {0 0}
+test apply-7.7 {namespace access} {
+    set ::testApply::x 0
+    set body {variable x; set x 1}
+    list [apply [list args $body testApply]] $::testApply::x
+} {1 1}
+test apply-7.8 {namespace access} {
+    set ::testApply::x 0
+    set body {testApply}
+    apply [list args $body testApply]
+} testApply
+
+# Tests for correct argument treatment
+
+set applyBody {
+    set res {}
+    foreach v [info locals] {
+	if {$v eq "res"} continue
+	lappend res [list $v [set $v]]
+    }
+    set res
+}
+
+test apply-8.1 {args treatment} {
+    apply [list args $applyBody] 1 2 3
+} {{args {1 2 3}}}
+test apply-8.2 {args treatment} {
+    apply [list {x args} $applyBody] 1 2
+} {{x 1} {args 2}}
+test apply-8.3 {args treatment} {
+    apply [list {x args} $applyBody] 1 2 3
+} {{x 1} {args {2 3}}}
+test apply-8.4 {default values} {
+    apply [list {{x 1} {y 2}} $applyBody] 
+} {{x 1} {y 2}}
+test apply-8.5 {default values} {
+    apply [list {{x 1} {y 2}} $applyBody] 3 4
+} {{x 3} {y 4}}
+test apply-8.6 {default values} {
+    apply [list {{x 1} {y 2}} $applyBody] 3
+} {{x 3} {y 2}}
+test apply-8.7 {default values} {
+    apply [list {x {y 2}} $applyBody] 1
+} {{x 1} {y 2}}
+test apply-8.8 {default values} {
+    apply [list {x {y 2}} $applyBody] 1 3
+} {{x 1} {y 3}}
+test apply-8.9 {default values} {
+    apply [list {x {y 2} args} $applyBody] 1
+} {{x 1} {y 2} {args {}}}
+test apply-8.10 {default values} {
+    apply [list {x {y 2} args} $applyBody] 1 3
+} {{x 1} {y 3} {args {}}}
+
+# Tests for leaks
+
+test apply-9.1 {leaking internal rep} -setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+    set lam [list {} {set a 1}]
+} -constraints memory -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	::apply [lrange $lam 0 end]
+	set tmp $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    rename getbytes {}
+    unset -nocomplain lam end i tmp leakedBytes
+} -result 0
+test apply-9.2 {leaking internal rep} -setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+} -constraints memory -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	::apply [list {} {set a 1}]
+	set tmp $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    rename getbytes {}
+    unset -nocomplain end i tmp leakedBytes
+} -result 0
+test apply-9.3 {leaking internal rep} -setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+} -constraints memory -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	set x [list {} {set a 1} ::NS::THAT::DOES::NOT::EXIST]
+	catch {::apply $x}
+	set x {}
+	set tmp $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    rename getbytes {}
+    unset -nocomplain end i x tmp leakedBytes
+} -result 0
+
+# Tests for the avoidance of recompilation
+
+# cleanup
+
+namespace delete testApply
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/assemble.test b/tests/assemble.test
new file mode 100644
index 0000000..b0487e6
--- /dev/null
+++ b/tests/assemble.test
@@ -0,0 +1,3292 @@
+# assemble.test --
+#
+#	Test suite for the 'tcl::unsupported::assemble' command
+#
+# Copyright (c) 2010 by Ozgur Dogan Ugurlu.
+# Copyright (c) 2010 by Kevin B. Kenny.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#-----------------------------------------------------------------------------
+
+# Commands covered: assemble
+
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.2
+    namespace import -force ::tcltest::*
+}
+namespace eval tcl::unsupported {namespace export assemble}
+namespace import tcl::unsupported::assemble
+
+# Procedure to make code that fills the literal and local variable tables, to
+# force instructions to spill to four bytes.
+
+proc fillTables {} {
+    set s {}
+    set sep {}
+    for {set i 0} {$i < 256} {incr i} {
+	append s $sep [list set v$i literal$i]
+	set sep \n
+    }
+    return $s
+}
+
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
+
+# assemble-1 - TclNRAssembleObjCmd
+
+test assemble-1.1 {wrong # args, direct eval} {
+    -body {
+	eval [list assemble]
+    }
+    -returnCodes error
+    -result {wrong # args*}
+    -match glob
+}
+test assemble-1.2 {wrong # args, direct eval} {
+    -body {
+	eval [list assemble too many]
+    }
+    -returnCodes error
+    -result {wrong # args*}
+    -match glob
+}
+test assemble-1.3 {error reporting, direct eval} {
+    -body {
+	list [catch {
+	    eval [list assemble {
+		# bad opcode
+		rubbish
+	    }]
+	} result] $result $errorInfo
+    }
+    -match glob
+    -result {1 {bad instruction "rubbish":*} {bad instruction "rubbish":*
+    while executing
+"rubbish"
+    ("assemble" body, line 3)*}}
+    -cleanup {unset result}
+}
+test assemble-1.4 {simple direct eval} {
+    -body {
+	eval [list assemble {push {this is a test}}]
+    }
+    -result {this is a test}
+}
+
+# assemble-2 - CompileAssembleObj
+
+test assemble-2.1 {bytecode reuse, direct eval} {
+    -body {
+	set x {push "this is a test"}
+	list [eval [list assemble $x]] \
+	    [eval [list assemble $x]]
+    }
+    -result {{this is a test} {this is a test}}
+}
+test assemble-2.2 {bytecode discard, direct eval} {
+    -body {
+	set x {load value}
+	proc p1 {x} {
+	    set value value1
+	    assemble $x
+	}
+	proc p2 {x} {
+	    set a b
+	    set value value2
+	    assemble $x
+	}
+	list [p1 $x] [p2 $x]
+    }
+    -result {value1 value2}
+    -cleanup {
+	unset x
+	rename p1 {}
+	rename p2 {}
+    }
+}
+test assemble-2.3 {null script, direct eval} {
+    -body {
+	set x {}
+	assemble $x
+    }
+    -result {}
+    -cleanup {unset x}
+}
+
+# assemble-3 - TclCompileAssembleCmd
+
+test assemble-3.1 {wrong # args, compiled path} {
+    -body {
+	proc x {} {
+	    assemble
+	}
+	x
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args:*}
+}
+test assemble-3.2 {wrong # args, compiled path} {
+    -body {
+	proc x {} {
+	    assemble too many
+	}
+	x
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args:*}
+    -cleanup {
+	rename x {}
+    }
+}
+
+# assemble-4 - TclAssembleCode mainline
+
+test assemble-4.1 {syntax error} {
+    -body {
+	proc x {} {
+	    assemble {
+		{}extra
+	    }
+	}
+	list [catch x result] $result $::errorInfo
+    }
+    -cleanup {
+	rename x {}
+	unset result
+    }
+    -match glob
+    -result {1 {extra characters after close-brace} {extra characters after close-brace
+    while executing
+"{}e"
+    ("assemble" body, line 2)*}}
+}
+test assemble-4.2 {null command} {
+    -body {
+	proc x {} {
+	    assemble {
+		push hello; pop;;push goodbye
+	    }
+	}
+	x
+    }
+    -result goodbye
+    -cleanup {
+	rename x {}
+    }
+}
+
+# assemble-5 - GetNextOperand off-nominal cases
+
+test assemble-5.1 {unsupported expansion} {
+    -body {
+	proc x {y} {
+	    assemble {
+		{*}$y
+	    }
+	}
+	list [catch {x {push hello}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+    -cleanup {
+	rename x {}
+	unset result
+    }
+}
+test assemble-5.2 {unsupported substitution} {
+    -body {
+	proc x {y} {
+	    assemble {
+		$y
+	    }
+	}
+	list [catch {x {nop}} result] $result $::errorCode
+    }
+    -cleanup {
+	rename x {}
+	unset result
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+test assemble-5.3 {unsupported substitution} {
+    -body {
+	proc x {} {
+	    assemble {
+		[x]
+	    }
+	}
+	list [catch {x} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+test assemble-5.4 {backslash substitution} {
+    -body {
+	proc x {} {
+	    assemble {
+		p\x75sh\
+		    hello\ world
+	    }
+	}
+	x
+    }
+    -cleanup {
+	rename x {}
+    }
+    -result {hello world}
+}
+
+# assemble-6 - ASSEM_PUSH
+
+test assemble-6.1 {push, wrong # args} {
+    -body {
+	assemble push
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-6.2 {push, wrong # args} {
+    -body {
+	assemble {push too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-6.3 {push} {
+    -body {
+	eval [list assemble {push hello}]
+    }
+    -result hello
+}
+test assemble-6.4 {push4} {
+    -body {
+	proc x {} "
+            [fillTables]
+            assemble {push hello}
+        "
+	x
+    }
+    -cleanup {
+	rename x {}
+    }
+    -result hello
+}
+
+# assemble-7 - ASSEM_1BYTE
+
+test assemble-7.1 {add, wrong # args} {
+    -body {
+	assemble {add excess}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-7.2 {add} {
+    -body { 
+	assemble {
+	    push 2
+	    push 2
+	    add
+	} 
+    }
+    -result {4}
+}
+test assemble-7.3 {appendArrayStk} {
+    -body {
+	set a(b) {hello, }
+	assemble {
+	    push a
+	    push b
+	    push world
+	    appendArrayStk
+	}
+	set a(b)
+    }
+    -result {hello, world}
+    -cleanup {unset a}
+}
+test assemble-7.4 {appendStk} {
+    -body {
+	set a {hello, }
+	assemble {
+	    push a
+	    push world
+	    appendStk
+	}
+	set a
+    }
+    -result {hello, world}
+    -cleanup {unset a}
+}
+test assemble-7.5 {bitwise ops} {
+    -body {
+	list \
+	    [assemble {push 0b1100; push 0b1010; bitand}] \
+	    [assemble {push 0b1100; bitnot}] \
+	    [assemble {push 0b1100; push 0b1010; bitor}] \
+	    [assemble {push 0b1100; push 0b1010; bitxor}]
+    }
+    -result {8 -13 14 6}
+}
+test assemble-7.6 {div} {
+    -body {
+	assemble {push 999999; push 7; div} 
+    }
+    -result 142857
+}
+test assemble-7.7 {dup} {
+    -body {
+	assemble {
+	    push 1; dup; dup; add; dup; add; dup; add; add
+	}
+    }
+    -result 9
+}	
+test assemble-7.8 {eq} {
+    -body {
+	list \
+	    [assemble {push able; push baker; eq}] \
+	    [assemble {push able; push able;  eq}]
+    }
+    -result {0 1}
+}
+test assemble-7.9 {evalStk} {
+    -body {
+	assemble {
+	    push {concat test 7.3}
+	    evalStk
+	}
+    }
+    -result {test 7.3}
+}
+test assemble-7.9a {evalStk, syntax} {
+    -body {
+	assemble {
+	    push {{}bad}
+	    evalStk
+	}
+    }
+    -returnCodes error
+    -result {extra characters after close-brace}
+}
+test assemble-7.9b {evalStk, backtrace} {
+    -body {
+	proc y {z} {
+	    error testing
+	}
+	proc x {} {
+	    assemble {
+		push {
+		    # test error in evalStk
+		    y asd
+		}
+		evalStk
+	    }
+	}
+	list [catch x result] $result $errorInfo
+    }
+    -result {1 testing {testing
+    while executing
+"error testing"
+    (procedure "y" line 2)
+    invoked from within
+"y asd"*}}
+    -match glob
+    -cleanup {
+	rename y {}
+	rename x {}
+    }
+}
+test assemble-7.10 {existArrayStk} {
+    -body {
+	proc x {name key} {
+	    set a(b) c
+	    assemble {
+		load name; load key; existArrayStk
+	    }
+	}
+	list [x a a] [x a b] [x b a] [x b b]
+    }
+    -result {0 1 0 0}
+    -cleanup {rename x {}}
+}
+test assemble-7.11 {existStk} {
+    -body {
+	proc x {name} {
+	    set a b
+	    assemble {
+		load name; existStk
+	    }
+	}
+	list [x a] [x b]
+    }
+    -result {1 0}
+    -cleanup {rename x {}}
+}
+test assemble-7.12 {expon} {
+    -body {
+	assemble {push 3; push 4; expon}
+    }
+    -result 81
+}
+test assemble-7.13 {exprStk} {
+    -body {
+	assemble {
+	    push {acos(-1)}
+	    exprStk
+	}
+    }
+    -result 3.141592653589793
+}
+test assemble-7.13a {exprStk, syntax} {
+    -body {
+	assemble {
+	    push {2+}
+	    exprStk
+	}
+    }
+    -returnCodes error
+    -result {missing operand at _@_
+in expression "2+_@_"}
+}
+test assemble-7.13b {exprStk, backtrace} {
+    -body {
+	proc y {z} {
+	    error testing
+	}
+	proc x {} {
+	    assemble {
+		push {[y asd]}
+		exprStk
+	    }
+	}
+	list [catch x result] $result $errorInfo
+    }
+    -result {1 testing {testing
+    while executing
+"error testing"
+    (procedure "y" line 2)
+    invoked from within
+"y asd"*}}
+    -match glob
+    -cleanup {
+	rename y {}
+	rename x {}
+    }
+}
+test assemble-7.14 {ge gt le lt} {
+    -body {
+	proc x {a b} {
+	    list [assemble {load a; load b; ge}] \
+		[assemble {load a; load b; gt}] \
+		[assemble {load a; load b; le}] \
+		[assemble {load a; load b; lt}]
+	}
+	list [x 0 0] [x 0 1] [x 1 0]
+    }
+    -result {{1 0 1 0} {0 0 1 1} {1 1 0 0}}
+    -cleanup {rename x {}}
+}
+test assemble-7.15 {incrArrayStk} {
+    -body {
+	proc x {} {
+	    set a(b) 5
+	    assemble {
+		push a; push b; push 7; incrArrayStk
+	    }
+	}
+	x
+    }
+    -result 12
+    -cleanup {rename x {}}
+}
+test assemble-7.16 {incrStk} {
+    -body {
+	proc x {} {
+	    set a 5
+	    assemble {
+		push a; push 7; incrStk
+	    }
+	}
+	x
+    }
+    -result 12
+    -cleanup {rename x {}}
+}
+test assemble-7.17 {land/lor} {
+    -body {
+	proc x {a b} {
+	    list \
+		[assemble {load a; load b; land}] \
+		[assemble {load a; load b; lor}]
+	}
+	list [x 0 0] [x 0 23] [x 35 0] [x 47 59]
+    }
+    -result {{0 0} {0 1} {0 1} {1 1}}
+    -cleanup {rename x {}}
+}
+test assemble-7.18 {lappendArrayStk} {
+    -body {
+	proc x {} {
+	    set able(baker) charlie
+	    assemble {
+		push able
+		push baker
+		push dog
+		lappendArrayStk
+	    }
+	}
+	x
+    }
+    -result {charlie dog}
+    -cleanup {rename x {}}
+}
+test assemble-7.19 {lappendStk} {
+    -body {
+	proc x {} {
+	    set able baker
+	    assemble {
+		push able
+		push charlie
+		lappendStk
+	    }
+	}
+	x
+    }
+    -result {baker charlie}
+    -cleanup {rename x {}}
+}
+test assemble-7.20 {listIndex} {
+    -body {
+	assemble {
+	    push {a b c d}
+	    push 2
+	    listIndex
+	}
+    }
+    -result c
+}
+test assemble-7.21 {listLength} {
+    -body {
+	assemble {
+	    push {a b c d}
+	    listLength
+	}
+    }
+    -result 4
+}
+test assemble-7.22 {loadArrayStk} {
+    -body {
+	proc x {} {
+	    set able(baker) charlie
+	    assemble {
+		push able
+		push baker
+		loadArrayStk
+	    }
+	}
+	x
+    }
+    -result charlie
+    -cleanup {rename x {}}
+}
+test assemble-7.23 {loadStk} {
+    -body {
+	proc x {} {
+	    set able baker
+	    assemble {
+		push able
+		loadStk
+	    }
+	}
+	x
+    }
+    -result baker
+    -cleanup {rename x {}}
+}
+test assemble-7.24 {lsetList} {
+    -body {
+	proc x {} {
+	    set l {{a b} {c d} {e f} {g h}}
+	    assemble {
+		push {2 1}; push i; load l; lsetList
+	    }
+	}
+	x
+    }
+    -result {{a b} {c d} {e i} {g h}}
+}
+test assemble-7.25 {lshift} {
+    -body {
+	assemble {push 16; push 4; lshift}
+    } 
+    -result 256
+}
+test assemble-7.26 {mod} {
+    -body {
+	assemble {push 123456; push 1000; mod}
+    }
+    -result 456
+}
+test assemble-7.27 {mult} {
+    -body {
+	assemble {push 12345679; push 9; mult}
+    }
+    -result 111111111
+}
+test assemble-7.28 {neq} {
+    -body {
+	list \
+	    [assemble {push able; push baker; neq}] \
+	    [assemble {push able; push able;  neq}]
+    }
+    -result {1 0}
+}
+test assemble-7.29 {not} {
+    -body {
+	list \
+	    [assemble {push 17; not}] \
+	    [assemble {push 0; not}]
+    }
+    -result {0 1}
+}
+test assemble-7.30 {pop} {
+    -body {
+	assemble {push this; pop; push that}
+    }
+    -result that
+}
+test assemble-7.31 {rshift} {
+    -body {
+	assemble {push 257; push 4; rshift}
+    } 
+    -result 16
+}
+test assemble-7.32 {storeArrayStk} {
+    -body {
+	proc x {} {
+	    assemble {
+		push able; push baker; push charlie; storeArrayStk
+	    }
+	    array get able
+	}
+	x
+    }
+    -result {baker charlie}
+    -cleanup {rename x {}}
+}
+test assemble-7.33 {storeStk} {
+    -body {
+	proc x {} {
+	    assemble {
+		push able; push baker; storeStk
+	    }
+	    set able
+	}
+	x
+    }
+    -result {baker}
+    -cleanup {rename x {}}
+}
+test assemble-7,34 {strcmp} {
+    -body {
+	proc x {a b} {
+	    assemble {
+		load a; load b; strcmp
+	    }
+	}
+	list [x able baker] [x baker able] [x baker baker]
+    }
+    -result {-1 1 0}
+    -cleanup {rename x {}}
+}
+test assemble-7.35 {streq/strneq} {
+    -body {
+	proc x {a b} {
+	    list \
+		[assemble {load a; load b; streq}] \
+		[assemble {load a; load b; strneq}]
+	}
+	list [x able able] [x able baker]
+    }
+    -result {{1 0} {0 1}}
+    -cleanup {rename x {}}
+}
+test assemble-7.36 {strindex} {
+    -body {
+	assemble {push testing; push 4; strindex}
+    }
+    -result i
+}
+test assemble-7.37 {strlen} {
+    -body {
+	assemble {push testing; strlen}
+    }
+    -result 7
+}
+test assemble-7.38 {sub} {
+    -body {
+	assemble {push 42; push 17; sub}
+    }
+    -result 25
+}
+test assemble-7.39 {tryCvtToNumeric} {
+    -body {
+	assemble {
+	    push 42; tryCvtToNumeric
+	}
+    }
+    -result 42
+}
+# assemble-7.40 absent
+test assemble-7.41 {uminus} {
+    -body {
+	assemble {
+	    push 42; uminus
+	}
+    }
+    -result -42
+}
+test assemble-7.42 {uplus} {
+    -body {
+	assemble {
+	    push 42; uplus
+	}
+    }
+    -result 42
+}
+test assemble-7.43 {uplus} {
+    -body {
+	assemble {
+	    push NaN; uplus
+	}
+    }
+    -returnCodes error
+    -result {can't use non-numeric floating-point value as operand of "+"}
+}
+test assemble-7.43.1 {tryCvtToNumeric} {
+    -body {
+	assemble {
+	    push NaN; tryCvtToNumeric
+	}
+    }
+    -returnCodes error
+    -result {domain error: argument not in valid range}
+}
+test assemble-7.44 {listIn} {
+    -body {
+	assemble {
+	    push b; push {a b c}; listIn
+	}
+    }
+    -result 1
+}
+test assemble-7.45 {listNotIn} {
+    -body {
+	assemble {
+	    push d; push {a b c}; listNotIn
+	}
+    }
+    -result 1
+}
+test assemble-7.46 {nop} {
+    -body {
+	assemble { push x; nop; nop; nop}
+    }
+    -result x
+}
+
+# assemble-8 ASSEM_LVT and FindLocalVar
+
+test assemble-8.1 {load, wrong # args} {
+    -body {
+	assemble load
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-8.2 {load, wrong # args} {
+    -body {
+	assemble {load too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-8.3 {nonlocal var} {
+    -body {
+	list [catch {assemble {load ::env}} result] $result $errorCode
+    }
+    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+    -cleanup {unset result}
+}
+test assemble-8.4 {bad context} {
+    -body {
+	set x 1
+	list [catch {assemble {load x}} result] $result $errorCode
+    }
+    -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
+    -cleanup {unset result}
+}
+test assemble-8.5 {bad context} {
+    -body {
+	namespace eval assem {
+	    set x 1
+	    list [catch {assemble {load x}} result] $result $errorCode
+	}
+    }
+    -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
+    -cleanup {namespace delete assem}
+}
+test assemble-8.6 {load1} {
+    -body {
+	proc x {a} {
+	    assemble {
+		load a
+	    }
+	}
+	x able
+    }
+    -result able
+    -cleanup {rename x {}}
+}
+test assemble-8.7 {load4} {
+    -body {
+	proc x {a} "
+	    [fillTables]
+            set b \$a
+            assemble {load b}
+        "
+	x able
+    }
+    -result able
+    -cleanup {rename x {}}
+}
+test assemble-8.8 {loadArray1} {
+    -body {
+	proc x {} {
+	    set able(baker) charlie
+	    assemble {
+		push baker
+		loadArray able
+	    }
+	}
+	x
+    }
+    -result charlie
+    -cleanup {rename x {}}
+}
+test assemble-8.9 {loadArray4} {
+    -body "
+	proc x {} {
+            [fillTables]
+	    set able(baker) charlie
+	    assemble {
+		push baker
+		loadArray able
+	    }
+	}
+	x
+    "
+    -result charlie
+    -cleanup {rename x {}}
+}
+test assemble-8.10 {append1} {
+    -body {
+	proc x {} {
+	    set y {hello, }
+	    assemble {
+		push world; append y
+	    }
+	}
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+test assemble-8.11 {append4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    set y {hello, }
+	    assemble {
+		push world; append y
+	    }
+	"
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+test assemble-8.12 {appendArray1} {
+    -body {
+	proc x {} {
+	    set y(z) {hello, }
+	    assemble {
+		push z; push world; appendArray y
+	    }
+	}
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+test assemble-8.13 {appendArray4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    set y(z) {hello, }
+	    assemble {
+		push z; push world; appendArray y
+	    }
+	"
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+test assemble-8.14 {lappend1} {
+    -body {
+	proc x {} {
+	    set y {hello,}
+	    assemble {
+		push world; lappend y
+	    }
+	}
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+test assemble-8.15 {lappend4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    set y {hello,}
+	    assemble {
+		push world; lappend y
+	    }
+	"
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+test assemble-8.16 {lappendArray1} {
+    -body {
+	proc x {} {
+	    set y(z) {hello,}
+	    assemble {
+		push z; push world; lappendArray y
+	    }
+	}
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+test assemble-8.17 {lappendArray4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    set y(z) {hello,}
+	    assemble {
+		push z; push world; lappendArray y
+	    }
+	"
+	x
+    }
+    -result {hello, world}
+    -cleanup {rename x {}}
+}
+test assemble-8.18 {store1} {
+    -body {
+	proc x {} {
+	    assemble {
+		push test; store y
+	    }
+	    set y
+	}
+	x
+    }
+    -result {test}
+    -cleanup {rename x {}}
+}
+test assemble-8.19 {store4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    assemble {
+		push test; store y
+	    }
+            set y
+	"
+	x
+    }
+    -result test
+    -cleanup {rename x {}}
+}
+test assemble-8.20 {storeArray1} {
+    -body {
+	proc x {} {
+	    assemble {
+		push z; push test; storeArray y
+	    }
+	    set y(z)
+	}
+	x
+    }
+    -result test
+    -cleanup {rename x {}}
+}
+test assemble-8.21 {storeArray4} {
+    -body {
+	proc x {} "
+            [fillTables]
+	    assemble {
+		push z; push test; storeArray y
+	    }
+	"
+	x
+    }
+    -result test
+    -cleanup {rename x {}}
+}
+
+# assemble-9 - ASSEM_CONCAT1, GetIntegerOperand, CheckOneByte
+
+test assemble-9.1 {wrong # args} {
+    -body {assemble concat}
+    -result {wrong # args*}
+    -match glob
+    -returnCodes error
+}
+test assemble-9.2 {wrong # args} {
+    -body {assemble {concat too many}}
+    -result {wrong # args*}
+    -match glob
+    -returnCodes error
+}
+test assemble-9.3 {not a number} {
+    -body {assemble {concat rubbish}}
+    -result {expected integer but got "rubbish"}
+    -returnCodes error
+}
+test assemble-9.4 {too small} {
+    -body {assemble {concat -1}}
+    -result {operand does not fit in one byte}
+    -returnCodes error
+}
+test assemble-9.5 {too small} {
+    -body {assemble {concat 256}}
+    -result {operand does not fit in one byte}
+    -returnCodes error
+}
+test assemble-9.6 {concat} {
+    -body {
+	assemble {push h; push e; push l; push l; push o; concat 5}
+    }
+    -result hello
+}
+test assemble-9.7 {concat} {
+    -body {
+	list [catch {assemble {concat 0}} result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {unset result}
+}
+
+# assemble-10 -- eval and expr
+
+test assemble-10.1 {eval - wrong # args} {
+    -body {
+	assemble {eval}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-10.2 {eval - wrong # args} {
+    -body {
+	assemble {eval too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-10.3 {eval} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 3
+		store n
+		pop
+		eval {expr {3*$n + 1}}
+		push 1
+		add
+	    }
+	}
+	x
+    }
+    -result 11
+    -cleanup {rename x {}}
+}
+test assemble-10.4 {expr} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 3
+		store n
+		pop
+		expr {3*$n + 1}
+		push 1
+		add
+	    }
+	}
+	x
+    }
+    -result 11
+    -cleanup {rename x {}}
+}
+test assemble-10.5 {eval and expr - nonsimple} {
+    -body {
+	proc x {} {
+	    assemble {
+		eval "s\x65t n 3"
+		pop
+		expr "\x33*\$n + 1"
+		push 1
+		add
+	    }
+	}
+	x
+    }
+    -result 11
+    -cleanup {
+	rename x {}
+    }
+}
+test assemble-10.6 {eval - noncompilable} {
+    -body {
+	list [catch {assemble {eval $x}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+test assemble-10.7 {expr - noncompilable} {
+    -body {
+	list [catch {assemble {expr $x}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+}
+
+# assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend,
+#			    nsupvar, variable, upvar)
+		
+test assemble-11.1 {exist - wrong # args} {
+    -body {
+	assemble {exist}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-11.2 {exist - wrong # args} {
+    -body {
+	assemble {exist too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-11.3 {nonlocal var} {
+    -body {
+	list [catch {assemble {exist ::env}} result] $result $errorCode
+    }
+    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+    -cleanup {unset result}
+}
+test assemble-11.4 {exist} {
+    -body {
+	proc x {} {
+	    set y z
+	    list [assemble {exist y}] \
+		[assemble {exist z}]
+	}
+	x
+    }
+    -result {1 0}
+    -cleanup {rename x {}}
+}
+test assemble-11.5 {existArray} {
+    -body {
+	proc x {} {
+	    set a(b) c
+	    list [assemble {push b; existArray a}] \
+		[assemble {push c; existArray a}] \
+		[assemble {push a; existArray b}]
+	}
+	x
+    }
+    -result {1 0 0}
+    -cleanup {rename x {}}
+}
+test assemble-11.6 {dictAppend} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; push 22; dictAppend dict}
+	}
+	x
+    }
+    -result {a 1 b 222 c 3}
+    -cleanup {rename x {}}
+}
+test assemble-11.7 {dictLappend} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; push 2; dictLappend dict}
+	}
+	x
+    }
+    -result {a 1 b {2 2} c 3}
+    -cleanup {rename x {}}
+}
+test assemble-11.8 {upvar} {
+    -body {
+	proc x {v} {
+	    assemble {push 1; load v; upvar w; pop; load w}
+	}
+	proc y {} {
+	    set z 123
+	    x z
+	}
+	y
+    }
+    -result 123
+    -cleanup {rename x {}; rename y {}}
+}
+test assemble-11.9 {nsupvar} {
+    -body {
+	namespace eval q { variable v 123 }
+	proc x {} {
+	    assemble {push q; push v; nsupvar y; pop; load y}
+	}
+	x
+    }
+    -result 123
+    -cleanup {namespace delete q; rename x {}}
+}
+test assemble-11.10 {variable} {
+    -body {
+	namespace eval q { namespace eval r {variable v 123}}
+	proc x {} {
+	    assemble {push q::r::v; variable y; load y}
+	}
+	x
+    }
+    -result 123
+    -cleanup {namespace delete q; rename x {}}
+}
+
+# assemble-12 - ASSEM_LVT1 (incr and incrArray)
+		
+test assemble-12.1 {incr - wrong # args} {
+    -body {
+	assemble {incr}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-12.2 {incr - wrong # args} {
+    -body {
+	assemble {incr too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-12.3 {incr nonlocal var} {
+    -body {
+	list [catch {assemble {incr ::env}} result] $result $errorCode
+    }
+    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+    -cleanup {unset result}
+}
+test assemble-12.4 {incr} {
+    -body {
+	proc x {} {
+	    set y 5
+	    assemble {push 3; incr y}
+	}
+	x
+    }
+    -result 8
+    -cleanup {rename x {}}
+}
+test assemble-12.5 {incrArray} {
+    -body {
+	proc x {} {
+	    set a(b) 5
+	    assemble {push b; push 3; incrArray a}
+	}
+	x
+    }
+    -result 8
+    -cleanup {rename x {}}
+}
+test assemble-12.6 {incr, stupid stack restriction} {
+    -body {
+	proc x {} "
+	    [fillTables]
+            set y 5
+            assemble {push 3; incr y}
+        "
+	list [catch {x} result] $result $errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {unset result; rename x {}}
+}
+
+# assemble-13 -- ASSEM_LVT1_SINT1 - incrImm and incrArrayImm
+
+test assemble-13.1 {incrImm - wrong # args} {
+    -body {
+	assemble {incrImm x}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-13.2 {incrImm - wrong # args} {
+    -body {
+	assemble {incrImm too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-13.3 {incrImm nonlocal var} {
+    -body {
+	list [catch {assemble {incrImm ::env 2}} result] $result $errorCode
+    }
+    -result {1 {variable "::env" is not local} {TCL ASSEM NONLOCAL ::env}}
+    -cleanup {unset result}
+}
+test assemble-13.4 {incrImm not a number} {
+    -body {
+	proc x {} {
+	    assemble {incrImm x rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-13.5 {incrImm too big} {
+    -body {
+	proc x {} {
+	    assemble {incrImm x 0x80}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-13.6 {incrImm too small} {
+    -body {
+	proc x {} {
+	    assemble {incrImm x -0x81}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-13.7 {incrImm} {
+    -body {
+	proc x {} {
+	    set y 1
+	    list [assemble {incrImm y -0x80}] [assemble {incrImm y 0x7f}]
+	}
+	x
+    }
+    -result {-127 0}
+    -cleanup {rename x {}}
+}
+test assemble-13.8 {incrArrayImm} {
+    -body {
+	proc x {} {
+	    set a(b) 5
+	    assemble {push b; incrArrayImm a 3}
+	}
+	x
+    }
+    -result 8
+    -cleanup {rename x {}}
+}
+test assemble-13.9 {incrImm, stupid stack restriction} {
+    -body {
+	proc x {} "
+	    [fillTables]
+            set y 5
+            assemble {incrImm y 3}
+        "
+	list [catch {x} result] $result $errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {unset result; rename x {}}
+}
+
+# assemble-14 -- ASSEM_SINT1 (incrArrayStkImm and incrStkImm)
+
+test assemble-14.1 {incrStkImm - wrong # args} {
+    -body {
+	assemble {incrStkImm}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-14.2 {incrStkImm - wrong # args} {
+    -body {
+	assemble {incrStkImm too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-14.3 {incrStkImm not a number} {
+    -body {
+	proc x {} {
+	    assemble {incrStkImm rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-14.4 {incrStkImm too big} {
+    -body {
+	proc x {} {
+	    assemble {incrStkImm 0x80}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-14.5 {incrStkImm too small} {
+    -body {
+	proc x {} {
+	    assemble {incrStkImm -0x81}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand does not fit in one byte} {TCL ASSEM 1BYTE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-14.6 {incrStkImm} {
+    -body {
+	proc x {} {
+	    set y 1
+	    list [assemble {push y; incrStkImm -0x80}] \
+		[assemble {push y; incrStkImm 0x7f}]
+	}
+	x
+    }
+    -result {-127 0}
+    -cleanup {rename x {}}
+}
+test assemble-14.7 {incrArrayStkImm} {
+    -body {
+	proc x {} {
+	    set a(b) 5
+	    assemble {push a; push b; incrArrayStkImm 3}
+	}
+	x
+    }
+    -result 8
+    -cleanup {rename x {}}
+}
+
+# assemble-15 - listIndexImm
+
+test assemble-15.1 {listIndexImm - wrong # args} {
+    -body {
+	assemble {listIndexImm}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-15.2 {listIndexImm - wrong # args} {
+    -body {
+	assemble {listIndexImm too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-15.3 {listIndexImm - bad substitution} {
+    -body {
+	list [catch {assemble {listIndexImm $foo}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+    -cleanup {unset result}
+}
+test assemble-15.4 {listIndexImm - invalid index} {
+    -body {
+	assemble {listIndexImm rubbish}
+    }
+    -returnCodes error
+    -match glob
+    -result {bad index "rubbish"*}
+}
+test assemble-15.5 {listIndexImm} {
+    -body {
+	assemble {push {a b c}; listIndexImm 2}
+    }
+    -result c
+}
+test assemble-15.6 {listIndexImm} {
+    -body {
+	assemble {push {a b c}; listIndexImm end-1}
+    }
+    -result b
+}
+test assemble-15.7 {listIndexImm} {
+    -body {
+	assemble {push {a b c}; listIndexImm end}
+    }
+    -result c
+}
+
+# assemble-16 - invokeStk
+
+test assemble-16.1 {invokeStk - wrong # args} {
+    -body {
+	assemble {invokeStk}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-16.2 {invokeStk - wrong # args} {
+    -body {
+	assemble {invokeStk too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-16.3 {invokeStk - not a number} {
+    -body {
+	proc x {} {
+	    assemble {invokeStk rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-16.4 {invokeStk - no operands} {
+    -body {
+	proc x {} {
+	    assemble {invokeStk 0}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-16.5 {invokeStk1} {
+    -body {
+	tcl::unsupported::assemble {push concat; push 1; push 2; invokeStk 3}
+    }
+    -result {1 2}
+}
+test assemble-16.6 {invokeStk4} {
+    -body {
+	proc x {n} {
+	    set code {push concat}
+	    set shouldbe {}
+	    for {set i 1} {$i < $n} {incr i} {
+		append code \n {push a} $i
+		lappend shouldbe a$i
+	    }
+	    append code \n {invokeStk} { } $n
+	    set is [assemble $code]
+	    expr {$is eq $shouldbe}
+	}
+	list [x 254] [x 255] [x 256] [x 257]
+    }
+    -result {1 1 1 1}
+    -cleanup {rename x {}}
+}
+
+# assemble-17 -- jumps and labels
+
+test assemble-17.1 {label, wrong # args} {
+    -body {
+	assemble {label}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-17.2 {label, wrong # args} {
+    -body {
+	assemble {label too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-17.3 {label, bad subst} {
+    -body {
+	list [catch {assemble {label $foo}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+    -cleanup {unset result}
+}
+test assemble-17.4 {duplicate label} {
+    -body {
+	list [catch {assemble {label foo; label foo}} result] \
+	    $result $::errorCode
+    }
+    -result {1 {duplicate definition of label "foo"} {TCL ASSEM DUPLABEL foo}}
+}
+test assemble-17.5 {jump, wrong # args} {
+    -body {
+	assemble {jump}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-17.6 {jump, wrong # args} {
+    -body {
+	assemble {jump too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-17.7 {jump, bad subst} {
+    -body {
+	list [catch {assemble {jump $foo}} result] $result $::errorCode
+    }
+    -result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
+    -cleanup {unset result}
+}
+test assemble-17.8 {jump - ahead and back} {
+    -body {
+	assemble {
+	    jump three
+
+	    label one
+	    push a
+	    jump four
+
+	    label two
+	    push b
+	    jump six
+
+	    label three
+	    push c
+	    jump five
+
+	    label four
+	    push d
+	    jump two
+
+	    label five
+	    push e
+	    jump one
+
+	    label six
+	    push f
+	    concat 6
+	}
+    }
+    -result ceadbf
+}
+test assemble-17.9 {jump - resolve a label multiple times} {
+    -body {
+	proc x {} {
+	    set case 0
+	    set result {}
+	    assemble {
+		jump common
+		
+		label zero
+		pop		
+		incrImm case 1
+		pop
+		push a
+		append result
+		pop
+		jump common
+		
+		label one
+		pop
+		incrImm case 1
+		pop
+		push b
+		append result
+		pop
+		jump common
+		
+		label common
+		load case
+		dup
+		push 0
+		eq
+		jumpTrue zero
+		dup
+		push 1
+		eq
+		jumpTrue one
+		dup
+		push 2
+		eq
+		jumpTrue two
+		dup
+		push 3
+		eq
+		jumpTrue three
+		
+		label two
+		pop
+		incrImm case 1
+		pop
+		push c
+		append result
+		pop
+		jump common
+		
+		label three
+		pop
+		incrImm case 1
+		pop
+		push d
+		append result
+	    }
+	}
+	x
+    }
+    -result abcd
+    -cleanup {rename x {}}
+}
+test assemble-17.10 {jump4 needed} {
+    -body {
+	assemble "push x; jump one; label two; [string repeat {dup; pop;} 128]
+	      jump three; label one; jump two; label three"
+    }
+    -result x
+}
+test assemble-17.11 {jumpTrue} {
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpTrue then
+		push no
+		jump else
+		label then
+		push yes
+		label else
+	    }
+	}
+	list [x 0] [x 1]
+    }
+    -result {no yes}
+    -cleanup {rename x {}}
+}
+test assemble-17.12 {jumpFalse} {
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpFalse then
+		push no
+		jump else
+		label then
+		push yes
+		label else
+	    }
+	}
+	list [x 0] [x 1]
+    }
+    -result {yes no}
+    -cleanup {rename x {}}
+}
+test assemble-17.13 {jump to undefined label} {
+    -body {
+	list [catch {assemble {jump nowhere}} result] $result $::errorCode
+    }
+    -result {1 {undefined label "nowhere"} {TCL ASSEM NOLABEL nowhere}}
+}
+test assemble-17.14 {jump to undefined label, line number correct?} {
+    -body {
+	catch {assemble {#1
+	    #2
+	    #3
+	    jump nowhere
+	    #5
+	    #6
+	}}
+	set ::errorInfo
+    }
+    -match glob
+    -result {*"assemble" body, line 4*}
+}
+test assemble-17.15 {multiple passes of code resizing} {
+    -setup {
+	set body {
+	    push -
+	}
+	for {set i 0} {$i < 14} {incr i} {
+	    append body "label a" $i \
+		"; push a; concat 2; nop; nop; jump b" \
+		$i \n
+	}
+	append body {label a14; push a; concat 2; push 1; jumpTrue b14} \n
+	append body {label a15; push a; concat 2; push 0; jumpFalse b15} \n
+	for {set i 0} {$i < 15} {incr i} {
+	    append body "label b" $i \
+		"; push b; concat 2; nop; nop; jump a" \
+		[expr {$i+1}] \n
+	}
+	append body {label c; push -; concat 2; nop; nop; nop; jump d} \n
+	append body {label b15; push b; concat 2; nop; nop; jump c} \n
+	append body {label d}
+	proc x {} [list assemble $body]
+    }	
+    -body {
+	x
+    }
+    -cleanup {
+	catch {unset body}
+	catch {rename x {}}
+    }
+    -result -abababababababababababababababab-
+}
+
+# assemble-18 - lindexMulti
+
+test assemble-18.1 {lindexMulti - wrong # args} {
+    -body {
+	assemble {lindexMulti}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-18.2 {lindexMulti - wrong # args} {
+    -body {
+	assemble {lindexMulti too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-18.3 {lindexMulti - bad subst} {
+    -body {
+	assemble {lindexMulti $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-18.4 {lindexMulti - not a number} {
+    -body {
+	proc x {} {
+	    assemble {lindexMulti rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-18.5 {lindexMulti - bad operand count} {
+    -body {
+	proc x {} {
+	    assemble {lindexMulti 0}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-18.6 {lindexMulti} {
+    -body {
+	assemble {push {{a b c} {d e f} {g h j}}; lindexMulti 1}
+    }
+    -result {{a b c} {d e f} {g h j}}
+}
+test assemble-18.7 {lindexMulti} {
+    -body {
+	assemble {push {{a b c} {d e f} {g h j}}; push 1; lindexMulti 2}
+    }
+    -result {d e f}
+}
+test assemble-18.8 {lindexMulti} {
+    -body {
+	assemble {push {{a b c} {d e f} {g h j}}; push 2; push 1; lindexMulti 3}
+    }
+    -result h
+}
+
+# assemble-19 - list
+
+test assemble-19.1 {list - wrong # args} {
+    -body {
+	assemble {list}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-19.2 {list - wrong # args} {
+    -body {
+	assemble {list too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-19.3 {list - bad subst} {
+    -body {
+	assemble {list $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-19.4 {list - not a number} {
+    -body {
+	proc x {} {
+	    assemble {list rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-19.5 {list - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {list -1}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-19.6 {list - no args} {
+    -body {
+	assemble {list 0}
+    }
+    -result {}
+}
+test assemble-19.7 {list - 1 arg} {
+    -body {
+	assemble {push hello; list 1}
+    }
+    -result hello
+}
+test assemble-19.8 {list - 2 args} {
+    -body {
+	assemble {push hello; push world; list 2}
+    }
+    -result {hello world}
+}
+
+# assemble-20 - lsetFlat
+
+test assemble-20.1 {lsetFlat - wrong # args} {
+    -body {
+	assemble {lsetFlat}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-20.2 {lsetFlat - wrong # args} {
+    -body {
+	assemble {lsetFlat too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-20.3 {lsetFlat - bad subst} {
+    -body {
+	assemble {lsetFlat $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-20.4 {lsetFlat - not a number} {
+    -body {
+	proc x {} {
+	    assemble {lsetFlat rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-20.5 {lsetFlat - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {lsetFlat 1}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be >=2} {TCL ASSEM OPERAND>=2}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-20.6 {lsetFlat} {
+    -body {
+	assemble {push b; push a; lsetFlat 2}
+    } 
+    -result b
+}
+test assemble-20.7 {lsetFlat} {
+    -body {
+	assemble {push 1; push d; push {a b c}; lsetFlat 3}
+    }
+    -result {a d c}
+}
+
+# assemble-21 - over
+
+test assemble-21.1 {over - wrong # args} {
+    -body {
+	assemble {over}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-21.2 {over - wrong # args} {
+    -body {
+	assemble {over too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-21.3 {over - bad subst} {
+    -body {
+	assemble {over $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-21.4 {over - not a number} {
+    -body {
+	proc x {} {
+	    assemble {over rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-21.5 {over - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {over -1}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-21.6 {over} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 1
+		push 2
+		push 3
+		over 0
+		store x
+		pop
+		pop
+		pop
+		pop
+		load x
+	    }
+	}
+	x
+    }
+    -result 3
+    -cleanup {rename x {}}
+}
+test assemble-21.7 {over} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 1
+		push 2
+		push 3
+		over 2
+		store x
+		pop
+		pop
+		pop
+		pop
+		load x
+	    }
+	}
+	x
+    }
+    -result 1
+    -cleanup {rename x {}}
+}
+
+# assemble-22 - reverse
+
+test assemble-22.1 {reverse - wrong # args} {
+    -body {
+	assemble {reverse}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-22.2 {reverse - wrong # args} {
+    -body {
+	assemble {reverse too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+
+test assemble-22.3 {reverse - bad subst} {
+    -body {
+	assemble {reverse $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+
+test assemble-22.4 {reverse - not a number} {
+    -body {
+	proc x {} {
+	    assemble {reverse rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-22.5 {reverse - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {reverse -1}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be nonnegative} {TCL ASSEM NONNEGATIVE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-22.6 {reverse - zero operand count} {
+    -body {
+	proc x {} {
+	    assemble {push 1; reverse 0}
+	}
+	x
+    }
+    -result 1
+    -cleanup {rename x {}}
+}
+test assemble-22.7 {reverse} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 1
+		push 2
+		push 3
+		reverse 1
+		store x
+		pop
+		pop
+		pop
+		load x
+	    }
+	}
+	x
+    }
+    -result 3
+    -cleanup {rename x {}}
+}
+test assemble-22.8 {reverse} {
+    -body {
+	proc x {} {
+	    assemble {
+		push 1
+		push 2
+		push 3
+		reverse 3
+		store x
+		pop
+		pop
+		pop
+		load x
+	    }
+	}
+	x
+    }
+    -result 1
+    -cleanup {rename x {}}
+}
+
+# assemble-23 - ASSEM_BOOL (strmatch, unsetStk, unsetArrayStk)
+
+test assemble-23.1 {strmatch - wrong # args} {
+    -body {
+	assemble {strmatch}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-23.2 {strmatch - wrong # args} {
+    -body {
+	assemble {strmatch too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-23.3 {strmatch - bad subst} {
+    -body {
+	assemble {strmatch $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-23.4 {strmatch - not a boolean} {
+    -body {
+	proc x {} {
+	    assemble {strmatch rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected boolean value but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-23.5 {strmatch} {
+    -body {
+	proc x {a b} {
+	    list [assemble {load a; load b; strmatch 0}] \
+		[assemble {load a; load b; strmatch 1}]
+	}
+	list [x foo*.grill fengbar.grill] [x foo*.grill foobar.grill] [x foo*.grill FOOBAR.GRILL]
+    }
+    -result {{0 0} {1 1} {0 1}}
+    -cleanup {rename x {}}
+}
+test assemble-23.6 {unsetStk} {
+    -body {
+	proc x {} {
+	    set a {}
+	    assemble {push a; unsetStk false}
+	    info exists a
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-23.7 {unsetStk} {
+    -body {
+	proc x {} {
+	    assemble {push a; unsetStk false}
+	    info exists a
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-23.8 {unsetStk} {
+    -body {
+	proc x {} {
+	    assemble {push a; unsetStk true}
+	    info exists a
+	}
+	x
+    }
+    -returnCodes error
+    -result {can't unset "a": no such variable}
+    -cleanup {rename x {}}
+}
+test assemble-23.9 {unsetArrayStk} {
+    -body {
+	proc x {} {
+	    set a(b) {}
+	    assemble {push a; push b; unsetArrayStk false}
+	    info exists a(b)
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-23.10 {unsetArrayStk} {
+    -body {
+	proc x {} {
+	    assemble {push a; push b; unsetArrayStk false}
+	    info exists a(b)
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-23.11 {unsetArrayStk} {
+    -body {
+	proc x {} {
+	    assemble {push a; push b; unsetArrayStk true}
+	    info exists a(b)
+	}
+	x
+    }
+    -returnCodes error
+    -result {can't unset "a(b)": no such variable}
+    -cleanup {rename x {}}
+}
+
+# assemble-24 -- ASSEM_BOOL_LVT4 (unset; unsetArray)
+
+test assemble-24.1 {unset - wrong # args} {
+    -body {
+	assemble {unset one}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-24.2 {unset - wrong # args} {
+    -body {
+	assemble {unset too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-24.3 {unset - bad subst -arg 1} {
+    -body {
+	assemble {unset $foo bar}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-24.4 {unset - not a boolean} {
+    -body {
+	proc x {} {
+	    assemble {unset rubbish trash}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected boolean value but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-24.5 {unset - bad subst - arg 2} {
+    -body {
+	assemble {unset true $bar}
+    }
+    -returnCodes error
+    -result {assembly code may not contain substitutions}
+}
+test assemble-24.6 {unset - nonlocal var} {
+    -body {
+	assemble {unset true ::foo::bar}
+    }
+    -returnCodes error
+    -result {variable "::foo::bar" is not local}
+}
+test assemble-24.7 {unset} {
+    -body {
+	proc x {} {
+	    set a {}
+	    assemble {unset false a}
+	    info exists a
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-24.8 {unset} {
+    -body {
+	proc x {} {
+	    assemble {unset false a}
+	    info exists a
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-24.9 {unset} {
+    -body {
+	proc x {} {
+	    assemble {unset true a}
+	    info exists a
+	}
+	x
+    }
+    -returnCodes error
+    -result {can't unset "a": no such variable}
+    -cleanup {rename x {}}
+}
+test assemble-24.10 {unsetArray} {
+    -body {
+	proc x {} {
+	    set a(b) {}
+	    assemble {push b; unsetArray false a}
+	    info exists a(b)
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-24.11 {unsetArray} {
+    -body {
+	proc x {} {
+	    assemble {push b; unsetArray false a}
+	    info exists a(b)
+	}
+	x
+    }
+    -result 0
+    -cleanup {rename x {}}
+}
+test assemble-24.12 {unsetArray} {
+    -body {
+	proc x {} {
+	    assemble {push b; unsetArray true a}
+	    info exists a(b)
+	}
+	x
+    }
+    -returnCodes error
+    -result {can't unset "a(b)": no such variable}
+    -cleanup {rename x {}}
+}
+
+# assemble-25 - dict get
+
+test assemble-25.1 {dict get - wrong # args} {
+    -body {
+	assemble {dictGet}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-25.2 {dict get - wrong # args} {
+    -body {
+	assemble {dictGet too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-25.3 {dictGet - bad subst} {
+    -body {
+	assemble {dictGet $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-25.4 {dict get - not a number} {
+    -body {
+	proc x {} {
+	    assemble {dictGet rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-25.5 {dictGet - negative operand count} {
+    -body {
+	proc x {} {
+	    assemble {dictGet 0}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-25.6 {dictGet - 1 index} {
+    -body {
+	assemble {push {a 1 b 2}; push a; dictGet 1}
+    }
+    -result 1
+}
+
+# assemble-26 - dict set
+
+test assemble-26.1 {dict set - wrong # args} {
+    -body {
+	assemble {dictSet 1}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-26.2 {dict get - wrong # args} {
+    -body {
+	assemble {dictSet too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-26.3 {dictSet - bad subst} {
+    -body {
+	assemble {dictSet 1 $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-26.4 {dictSet - not a number} {
+    -body {
+	proc x {} {
+	    assemble {dictSet rubbish foo}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-26.5 {dictSet - zero operand count} {
+    -body {
+	proc x {} {
+	    assemble {dictSet 0 foo}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-26.6 {dictSet - bad local} {
+    -body {
+	proc x {} {
+	    assemble {dictSet 1 ::foo::bar}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-26.7 {dictSet} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; push 4; dictSet 1 dict}
+	}
+	x
+    }
+    -result {a 1 b 4 c 3}
+    -cleanup {rename x {}}
+}
+
+# assemble-27 - dictUnset
+
+test assemble-27.1 {dictUnset - wrong # args} {
+    -body {
+	assemble {dictUnset 1}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-27.2 {dictUnset - wrong # args} {
+    -body {
+	assemble {dictUnset too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-27.3 {dictUnset - bad subst} {
+    -body {
+	assemble {dictUnset 1 $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-27.4 {dictUnset - not a number} {
+    -body {
+	proc x {} {
+	    assemble {dictUnset rubbish foo}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-27.5 {dictUnset - zero operand count} {
+    -body {
+	proc x {} {
+	    assemble {dictUnset 0 foo}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-27.6 {dictUnset - bad local} {
+    -body {
+	proc x {} {
+	    assemble {dictUnset 1 ::foo::bar}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-27.7 {dictUnset} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; dictUnset 1 dict}
+	}
+	x
+    }
+    -result {a 1 c 3}
+    -cleanup {rename x {}}
+}
+
+# assemble-28 - dictIncrImm
+
+test assemble-28.1 {dictIncrImm - wrong # args} {
+    -body {
+	assemble {dictIncrImm 1}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-28.2 {dictIncrImm - wrong # args} {
+    -body {
+	assemble {dictIncrImm too many args}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-28.3 {dictIncrImm - bad subst} {
+    -body {
+	assemble {dictIncrImm 1 $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-28.4 {dictIncrImm - not a number} {
+    -body {
+	proc x {} {
+	    assemble {dictIncrImm rubbish foo}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected integer but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-28.5 {dictIncrImm - bad local} {
+    -body {
+	proc x {} {
+	    assemble {dictIncrImm 1 ::foo::bar}
+	}
+	list [catch x result] $result $::errorCode
+    }
+    -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+    -cleanup {rename x {}; unset result}
+}
+test assemble-28.6 {dictIncrImm} {
+    -body {
+	proc x {} {
+	    set dict {a 1 b 2 c 3}
+	    assemble {push b; dictIncrImm 42 dict}
+	}
+	x
+    }
+    -result {a 1 b 44 c 3}
+    -cleanup {rename x {}}
+}
+
+# assemble-29 - ASSEM_REGEXP
+
+test assemble-29.1 {regexp - wrong # args} {
+    -body {
+	assemble {regexp}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-29.2 {regexp - wrong # args} {
+    -body {
+	assemble {regexp too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-29.3 {regexp - bad subst} {
+    -body {
+	assemble {regexp $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-29.4 {regexp - not a boolean} {
+    -body {
+	proc x {} {
+	    assemble {regexp rubbish}
+	}
+	x
+    }
+    -returnCodes error
+    -result {expected boolean value but got "rubbish"}
+    -cleanup {rename x {}}
+}
+test assemble-29.5 {regexp} {
+    -body {
+	assemble {push br.*br; push abracadabra; regexp false}
+    }
+    -result 1
+}
+test assemble-29.6 {regexp} {
+    -body {
+	assemble {push br.*br; push aBRacadabra; regexp false}
+    }
+    -result 0
+}
+test assemble-29.7 {regexp} {
+    -body {
+	assemble {push br.*br; push aBRacadabra; regexp true}
+    }
+    -result 1
+}
+
+# assemble-30 - Catches
+
+test assemble-30.1 {simplest possible catch} {
+    -body {
+	proc x {} {
+	    assemble {
+		beginCatch @bad
+		push error
+		push testing
+		invokeStk 2
+		pop
+		push 0
+		jump @ok
+		label @bad
+		push 1; # should be pushReturnCode
+		label @ok
+		endCatch
+	    }
+	}
+	x
+    }
+    -result 1
+    -cleanup {rename x {}}
+}
+test assemble-30.2 {catch in external catch conntext} {
+    -body {
+	proc x {} {
+	    list [catch {
+		assemble {
+		    beginCatch @bad
+		    push error
+		    push testing
+		    invokeStk 2
+		    pop
+		    push 0
+		    jump @ok
+		    label @bad
+		    pushReturnCode
+		    label @ok
+		    endCatch
+		}
+	    } result] $result
+	}
+	x
+    }
+    -result {0 1}
+    -cleanup {rename x {}}
+}
+test assemble-30.3 {embedded catches} {
+    -body {
+	proc x {} {
+	    list [catch {
+		assemble {
+		    beginCatch @bad
+		    push error
+		    eval { list [catch {error whatever} result] $result }
+		    invokeStk 2
+		    push 0
+		    reverse 2
+		    jump @done
+		    label @bad
+		    pushReturnCode
+		    pushResult
+		    label @done
+		    endCatch
+		    list 2
+		}
+	    } result2] $result2
+	}
+	x
+    }
+    -result {0 {1 {1 whatever}}}
+    -cleanup {rename x {}}
+}
+test assemble-30.4 {throw in wrong context} {
+    -body {
+	proc x {} {
+	    list [catch {
+		assemble {
+		    beginCatch @bad
+		    push error
+		    eval { list [catch {error whatever} result] $result }
+		    invokeStk 2
+		    push 0
+		    reverse 2
+		    jump @done
+
+		    label @bad
+		    load x
+		    pushResult
+
+		    label @done
+		    endCatch
+		    list 2
+		}
+	    } result] $result $::errorCode [split $::errorInfo \n]
+	}
+	x
+    }
+    -match glob
+    -result {1 {"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {TCL ASSEM BADTHROW} {{"loadScalar1" instruction may not appear in a context where an exception has been caught and not disposed of.} {    in assembly code between lines 10 and 15}*}}
+    -cleanup {rename x {}}
+}
+test assemble-30.5 {unclosed catch} {
+    -body {
+	proc x {} {
+	    assemble {
+		beginCatch @error
+		push 0
+		jump @done
+		label @error
+		push 1
+		label @done
+		push ""
+		pop
+	    }
+	}
+	list [catch {x} result] $result $::errorCode $::errorInfo
+    }
+    -match glob
+    -result {1 {catch still active on exit from assembly code} {TCL ASSEM UNCLOSEDCATCH} {catch still active on exit from assembly code
+    ("assemble" body, line 2)*}}
+    -cleanup {rename x {}}
+}
+test assemble-30.6 {inconsistent catch contexts} {
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpTrue @inblock
+		beginCatch @error
+		label @inblock
+		push 0
+		jump @done
+		label @error
+		push 1
+		label @done
+	    }
+	}
+	list [catch {x 2} result] $::errorCode $::errorInfo
+    }
+    -match glob
+    -result {1 {TCL ASSEM BADCATCH} {execution reaches an instruction in inconsistent exception contexts
+    ("assemble" body, line 5)*}}
+    -cleanup {rename x {}}
+}
+
+# assemble-31 - Jump tables
+
+test assemble-31.1 {jumpTable, wrong # args} {
+    -body {
+	assemble {jumpTable}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-31.2 {jumpTable, wrong # args} {
+    -body {
+	assemble {jumpTable too many}
+    }
+    -returnCodes error
+    -match glob
+    -result {wrong # args*}
+}
+test assemble-31.3 {jumpTable - bad subst} {
+    -body {
+	assemble {jumpTable $foo}
+    }
+    -returnCodes error
+    -match glob
+    -result {assembly code may not contain substitutions}
+}
+test assemble-31.4 {jumptable - not a list} {
+    -body {
+	assemble {jumpTable \{rubbish}
+    }
+    -returnCodes error
+    -result {unmatched open brace in list}
+}
+test assemble-31.5 {jumpTable, badly structured} {
+    -body {
+	list [catch {assemble {
+	    # line 2
+	    jumpTable {one two three};# line 3
+	}} result] \
+	    $result $::errorCode $::errorInfo
+    }
+    -match glob
+    -result {1 {jump table must have an even number of list elements} {TCL ASSEM BADJUMPTABLE} {jump table must have an even number of list elements*("assemble" body, line 3)*}}
+}
+test assemble-31.6 {jumpTable, missing symbol} {
+    -body {
+	list [catch {assemble {
+	    # line 2
+	    jumpTable {1 a};# line 3
+	}} result] \
+	    $result $::errorCode $::errorInfo
+    }
+    -match glob
+    -result {1 {undefined label "a"} {TCL ASSEM NOLABEL a} {undefined label "a"*("assemble" body, line 3)*}}
+}
+test assemble-31.7 {jumptable, actual example} {
+    -setup {
+	proc x {} {
+	    set result {}
+	    for {set i 0} {$i < 5} {incr i} {
+		lappend result [assemble {
+		    load i
+		    jumpTable {1 @one 2 @two 3 @three}
+		    push {none of the above}
+		    jump @done
+		    label @one
+		    push one
+		    jump @done
+		    label @two
+		    push two
+		    jump @done
+		    label @three
+		    push three
+		    label @done
+		}]
+	    }
+	    set tcl_traceCompile 2
+	    set result
+	}
+    }
+    -body x
+    -result {{none of the above} one two three {none of the above}}
+    -cleanup {set tcl_traceCompile 0; rename x {}}
+}
+
+test assemble-40.1 {unbalanced stack} {
+    -body {
+	list \
+	    [catch {
+		assemble {
+		    push 3
+		    dup 
+		    mult 
+		    push 4
+		    dup 
+		    mult 
+		    pop 
+		    expon
+		}
+	    } result] $result $::errorInfo
+    }
+    -result {1 {stack underflow} {stack underflow
+    in assembly code between lines 1 and end of assembly code*}}
+    -match glob
+   -returnCodes ok
+}
+test assemble-40.2 {unbalanced stack} {*}{
+    -body {
+	list \
+	    [catch {
+		assemble {
+		    label a
+		    push {}
+		    label b
+		    pop
+		    label c
+		    pop
+		    label d
+		    push {}
+		}
+	    } result] $result $::errorInfo
+    }
+    -result {1 {stack underflow} {stack underflow
+    in assembly code between lines 7 and 9*}}
+    -match glob
+   -returnCodes ok
+}
+
+test assemble-41.1 {Inconsistent stack usage} {*}{
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpFalse else
+		push 0
+		jump then
+	      label else
+		push 1
+		push 2
+	      label then
+		pop
+	    }
+	}
+	catch {x 1}
+	set errorInfo
+    }
+    -match glob
+    -result {inconsistent stack depths on two execution paths
+    ("assemble" body, line 10)*}
+}
+test assemble-41.2 {Inconsistent stack, jumptable and default} {
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpTable {0 else}
+		push 0
+	      label else
+		pop
+	    }
+	}
+	catch {x 1}
+	set errorInfo
+    }
+    -match glob
+    -result {inconsistent stack depths on two execution paths
+    ("assemble" body, line 6)*}
+}
+test assemble-41.3 {Inconsistent stack, two legs of jumptable} {
+    -body {
+	proc x {y} {
+	    assemble {
+		load y
+		jumpTable {0 no 1 yes}
+		label no
+		push 0
+		label yes
+		pop
+	    }
+	}
+	catch {x 1}
+	set errorInfo
+    }
+    -match glob
+    -result {inconsistent stack depths on two execution paths
+    ("assemble" body, line 7)*}
+}
+
+test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
+    -body {
+	proc ulam {n} {
+	    assemble {
+		load n;		# max
+		dup;		# max n
+		jump start;     # max n
+	    
+		label loop;	# max n
+		over 1;         # max n max
+		over 1;		# max in max n
+		ge;             # man n max>=n
+		jumpTrue skip;  # max n
+
+		reverse 2;      # n max
+		pop;            # n
+		dup;            # n n
+	    
+		label skip;	# max n
+		dup;            # max n n
+		push 2;         # max n n 2
+		mod;            # max n n%2
+		jumpTrue odd;   # max n
+	    
+		push 2;         # max n 2
+		div;            # max n/2 -> max n
+		jump start;     # max n
+	     
+		label odd;	# max n
+		push 3;         # max n 3
+		mult;           # max 3*n
+		push 1;         # max 3*n 1
+		add;            # max 3*n+1
+	    
+		label start;	# max n
+		dup;		# max n n
+		push 1;		# max n n 1
+		neq;		# max n n>1
+		jumpTrue loop;	# max n
+	    
+		pop;		# max
+	    }
+	}
+	set result {}
+	for {set i 1} {$i < 30} {incr i} {
+	    lappend result [ulam $i]
+	}
+	set result
+    }
+    -result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88}
+}
+
+test assemble-51.1 {memory leak testing} memory {
+    leaktest {
+	apply {{} {assemble {push hello}}}
+    }
+} 0
+test assemble-51.2 {memory leak testing} memory {
+    leaktest {
+	apply {{{x 0}} {assemble {incrImm x 1}}}
+    }
+} 0
+test assemble-51.3 {memory leak testing} memory {
+    leaktest {
+	apply {{n} {
+	    assemble {
+		load n;		# max
+		dup;		# max n
+		jump start;     # max n
+	    
+		label loop;	# max n
+		over 1;         # max n max
+		over 1;		# max in max n
+		ge;             # man n max>=n
+		jumpTrue skip;  # max n
+
+		reverse 2;      # n max
+		pop;            # n
+		dup;            # n n
+	    
+		label skip;	# max n
+		dup;            # max n n
+		push 2;         # max n n 2
+		mod;            # max n n%2
+		jumpTrue odd;   # max n
+	    
+		push 2;         # max n 2
+		div;            # max n/2 -> max n
+		jump start;     # max n
+	     
+		label odd;	# max n
+		push 3;         # max n 3
+		mult;           # max 3*n
+		push 1;         # max 3*n 1
+		add;            # max 3*n+1
+	    
+		label start;	# max n
+		dup;		# max n n
+		push 1;		# max n n 1
+		neq;		# max n n>1
+		jumpTrue loop;	# max n
+	    
+		pop;		# max
+	    }
+	}} 1
+    }
+} 0
+test assemble-51.4 {memory leak testing} memory {
+    leaktest {
+	catch {
+	    apply {{} {
+		assemble {reverse polish notation}
+	    }}
+	}
+    }
+} 0
+
+rename fillTables {}
+rename assemble {}
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/assemble1.bench b/tests/assemble1.bench
new file mode 100644
index 0000000..18fd3a9
--- /dev/null
+++ b/tests/assemble1.bench
@@ -0,0 +1,85 @@
+proc ulam1 {n} {
+    set max $n
+    while {$n != 1} {
+	if {$n > $max} {
+	    set max $n
+	}
+	if {$n % 2} {
+	    set n [expr {3 * $n + 1}]
+	} else {
+	    set n [expr {$n / 2}]
+	}
+    }
+    return $max
+}
+
+set tcl_traceCompile 2; ulam1 1; set tcl_traceCompile 0
+
+proc ulam2 {n} {
+    tcl::unsupported::assemble {
+	load n;		# max
+	dup;		# max n
+	jump start;     # max n
+	
+	label loop;	# max n
+	over 1;         # max n max
+	over 1;		# max in max n
+	ge;             # man n max>=n
+	jumpTrue skip;  # max n
+
+	reverse 2;      # n max
+	pop;            # n
+	dup;            # n n
+	
+	label skip;	# max n
+	dup;            # max n n
+	push 2;         # max n n 2
+	mod;            # max n n%2
+	jumpTrue odd;   # max n
+	
+	push 2;         # max n 2
+	div;            # max n/2 -> max n
+	jump start;     # max n
+	
+	label odd;	# max n
+	push 3;         # max n 3
+	mult;           # max 3*n
+	push 1;         # max 3*n 1
+	add;            # max 3*n+1
+	
+	label start;	# max n
+	dup;		# max n n
+	push 1;		# max n n 1
+	neq;		# max n n>1
+	jumpTrue loop;	# max n
+	
+	pop;		# max
+    }
+}
+set tcl_traceCompile 2; ulam2 1; set tcl_traceCompile 0
+
+proc test1 {n} {
+    for {set i 1} {$i <= $n} {incr i} {
+	ulam1 $i  
+    }
+}
+proc test2 {n} {
+    for {set i 1} {$i <= $n} {incr i} {
+	ulam2 $i  
+    }
+}
+
+for {set j 0} {$j < 10} {incr j} {
+    test1 1
+    set before [clock microseconds]
+    test1 30000
+    set after [clock microseconds]
+    puts "compiled: [expr {1e-6 * ($after - $before)}]"
+    
+    test2 1
+    set before [clock microseconds]
+    test2 30000
+    set after [clock microseconds]
+    puts "assembled: [expr {1e-6 * ($after - $before)}]"
+}
+    
\ No newline at end of file
diff --git a/tests/assocd.test b/tests/assocd.test
index a677090..edf55c4 100644
--- a/tests/assocd.test
+++ b/tests/assocd.test
@@ -10,13 +10,12 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: assocd.test,v 1.6 2004/05/19 10:42:00 dkf Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testgetassocdata [llength [info commands testgetassocdata]]
 testConstraint testsetassocdata [llength [info commands testsetassocdata]]
@@ -35,15 +34,21 @@ test assocd-1.4 {testing setting assoc data} testsetassocdata {
    testsetassocdata abc "abc d e f"
 } ""
 
-test assocd-2.1 {testing getting assoc data} testgetassocdata {
-   testgetassocdata a
-} 2
-test assocd-2.2 {testing getting assoc data} testgetassocdata {
-   testgetassocdata 123
-} 456
-test assocd-2.3 {testing getting assoc data} testgetassocdata {
+test assocd-2.1 {testing getting assoc data} -setup {
+    testsetassocdata a 2
+} -constraints {testgetassocdata} -body {
+    testgetassocdata a
+} -result 2
+test assocd-2.2 {testing getting assoc data} -setup {
+    testsetassocdata 123 456
+} -constraints {testgetassocdata} -body {
+    testgetassocdata 123
+} -result 456
+test assocd-2.3 {testing getting assoc data} -setup {
+   testsetassocdata abc "abc d e f"
+} -constraints {testgetassocdata} -body {
    testgetassocdata abc
-} {abc d e f}
+} -result "abc d e f"
 test assocd-2.4 {testing getting assoc data} testgetassocdata {
    testgetassocdata xxx
 } ""
@@ -59,5 +64,5 @@ test assocd-3.3 {testing deleting assoc data} testdelassocdata {
 } {0 {}}
 
 # cleanup
-::tcltest::cleanupTests
+cleanupTests
 return
diff --git a/tests/async.test b/tests/async.test
index 969208c..cb67cc2 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -10,19 +10,17 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: async.test,v 1.8 2004/05/19 20:15:31 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
-testConstraint testasync [llength [info commands testasync]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
-tcltest::testConstraint threaded [expr {
-    [info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded)
-}]
+testConstraint testasync [llength [info commands testasync]]
+testConstraint threaded [::tcl::pkgconfig get threaded]
 
 proc async1 {result code} {
     global aresult acode
@@ -150,44 +148,25 @@ test async-3.1 {deleting handlers} testasync {
     list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
 } {3 del2 {0 0 0 del1 del2}}
 
-proc nothing {} {
-    # empty proc
-}
-proc hang1 {handle} {
-    global aresult
-    set aresult {Async event not delivered}
-    testasync marklater $handle
-    for {set i 0} {
-	$i < 2500000  &&  $aresult eq "Async event not delivered"
-    } {incr i} {
-	nothing
-    }
-    return $aresult
-}
-proc hang2 {handle} {
-    global aresult
-    set aresult {Async event not delivered}
-    testasync marklater $handle
-    for {set i 0} {
-	$i < 2500000  &&  $aresult eq "Async event not delivered"
-    } {incr i} {}
-    return $aresult
-}
-proc hang3 {handle} [concat {
-    global aresult
-    set aresult {Async event not delivered}
-    testasync marklater $handle
-    set i 0
-} [string repeat {;incr i;} 1500000] {
-    return $aresult
-}]
-
 test async-4.1 {async interrupting bytecode sequence} -constraints {
     testasync threaded
 } -setup {
     set hm [testasync create async3]
+    proc nothing {} {
+	# empty proc
+    }
 } -body {
-    hang1 $hm
+    apply {{handle} {
+	global aresult
+	set aresult {Async event not delivered}
+	testasync marklater $handle
+	for {set i 0} {
+	    $i < 2500000  &&  $aresult eq "Async event not delivered"
+	} {incr i} {
+	    nothing
+	}
+	return $aresult
+    }} $hm
 } -result {test pattern} -cleanup {
     testasync delete $hm
 }
@@ -196,7 +175,15 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints {
 } -setup {
     set hm [testasync create async3]
 } -body {
-    hang2 $hm
+    apply {{handle} {
+	global aresult
+	set aresult {Async event not delivered}
+	testasync marklater $handle
+	for {set i 0} {
+	    $i < 2500000  &&  $aresult eq "Async event not delivered"
+	} {incr i} {}
+	return $aresult
+    }} $hm
 } -result {test pattern} -cleanup {
     testasync delete $hm
 }
@@ -205,7 +192,14 @@ test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
 } -setup {
     set hm [testasync create async3]
 } -body {
-    hang3 $hm
+    apply [list {handle} [concat {
+	global aresult
+	set aresult {Async event not delivered}
+	testasync marklater $handle
+	set i 0
+    } "[string repeat {;incr i;} 1500000]after 10;" {
+	return $aresult
+    }]] $hm
 } -result {test pattern} -cleanup {
     testasync delete $hm
 }
diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test
index 56e1ffb..4721553 100644
--- a/tests/autoMkindex.test
+++ b/tests/autoMkindex.test
@@ -1,17 +1,15 @@
 # Commands covered:  auto_mkindex auto_import
 #
-# This file contains tests related to autoloading and generating
-# the autoloading index.
+# This file contains tests related to autoloading and generating the
+# autoloading index.
 #
 # Copyright (c) 1998  Lucent Technologies, 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.
-#
-# RCS: @(#) $Id: autoMkindex.test,v 1.15 2004/05/25 17:44:29 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
@@ -19,10 +17,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 makeFile {# Test file for:
 #   auto_mkindex
 #
-# This file provides example cases for testing the Tcl autoloading
-# facility.  Things are much more complicated with namespaces and classes.
-# The "auto_mkindex" facility can no longer be built on top of a simple
-# regular expression parser.  It must recognize constructs like this:
+# This file provides example cases for testing the Tcl autoloading facility.
+# Things are much more complicated with namespaces and classes.  The
+# "auto_mkindex" facility can no longer be built on top of a simple regular
+# expression parser.  It must recognize constructs like this:
 #
 #   namespace eval foo {
 #       proc test {x y} { ... }
@@ -31,23 +29,23 @@ makeFile {# Test file for:
 #       }
 #   }
 #
-# Note that procedures and itcl class definitions can be nested inside
-# of namespaces.
+# Note that procedures and itcl class definitions can be nested inside of
+# namespaces.
 #
 # Copyright (c) 1993-1998  Lucent Technologies, Inc.
 
 # This shouldn't cause any problems
 namespace import -force blt::*
 
-# Should be able to handle "proc" definitions, even if they are
-# preceded by white space.
+# Should be able to handle "proc" definitions, even if they are preceded by
+# white space.
 
 proc normal {x y} {return [expr $x+$y]}
   proc indented {x y} {return [expr $x+$y]}
 
 #
-# Should be able to handle proc declarations within namespaces,
-# even if they have explicit namespace paths.
+# Should be able to handle proc declarations within namespaces, even if they
+# have explicit namespace paths.
 #
 namespace eval buried {
     proc inside {args} {return "inside: $args"}
@@ -69,8 +67,8 @@ namespace eval buried {
     }
 }
 
-# With proper hooks, we should be able to support other commands
-# that create procedures
+# With proper hooks, we should be able to support other commands that create
+# procedures
 
 proc buried::myproc {name body args} {
     ::proc $name $body $args
@@ -90,17 +88,15 @@ namespace eval ::buried {
 }
 {::buried::my proc} mycmd6 args {return "another"}
 
-# A correctly functioning [auto_import] won't choke when a child
-# namespace [namespace import]s from its parent.
+# A correctly functioning [auto_import] won't choke when a child namespace
+# [namespace import]s from its parent.
 #
 namespace eval ::parent::child {
     namespace import ::parent::*
 }
 proc ::parent::child::test {} {}
-
 } autoMkindex.tcl
 
-
 # Save initial state of auto_mkindex_parser
 
 auto_load auto_mkindex
@@ -120,21 +116,19 @@ set result ""
 
 set origDir [pwd]
 cd $::tcltest::temporaryDirectory
-
+
 test autoMkindex-1.1 {remove any existing tclIndex file} {
     file delete tclIndex
     file exists tclIndex
 } {0}
-
 test autoMkindex-1.2 {build tclIndex based on a test file} {
     auto_mkindex . autoMkindex.tcl
     file exists tclIndex
 } {1}
-
 set element "{source [file join . autoMkindex.tcl]}"
-
-test autoMkindex-1.3 {examine tclIndex} {
+test autoMkindex-1.3 {examine tclIndex} -setup {
     file delete tclIndex
+} -body {
     auto_mkindex . autoMkindex.tcl
     namespace eval tcl_autoMkindex_tmp {
         set dir "."
@@ -145,33 +139,35 @@ test autoMkindex-1.3 {examine tclIndex} {
             lappend ::result [list $elem $auto_index($elem)]
         }
     }
+    return $result
+} -cleanup {
     namespace delete tcl_autoMkindex_tmp
-    set ::result
-} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}"
-
+} -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {normal $element} {top $element}"
 
-test autoMkindex-2.1 {commands on the autoload path can be imported} {
+test autoMkindex-2.1 {commands on the autoload path can be imported} -setup {
     file delete tclIndex
+    interp create slave
+} -body {
     auto_mkindex . autoMkindex.tcl
-    set interp [interp create]
-    set final [$interp eval {
+    slave eval {
         namespace eval blt {}
         set auto_path [linsert $auto_path 0 .]
         set info [list [catch {namespace import buried::*} result] $result]
         foreach name [lsort [info commands pub_*]] {
             lappend info $name [namespace origin $name]
         }
-        set info
-    }]
-    interp delete $interp
-    set final
-} "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"
+        return $info
+    }
+} -cleanup {
+    interp delete slave
+} -result "0 {} pub_one ::buried::pub_one pub_two ::buried::pub_two"
 
 # Test auto_mkindex hooks
 
 # Slave hook executes interesting code in the interp used to watch code.
-
-test autoMkindex-3.1 {slaveHook} {
+test autoMkindex-3.1 {slaveHook} -setup {
+    file delete tclIndex
+} -body {
     auto_mkindex_parser::slavehook {
 	_%@namespace eval ::blt {
 	    proc foo {} {}
@@ -179,26 +175,23 @@ test autoMkindex-3.1 {slaveHook} {
 	}
     }
     auto_mkindex_parser::slavehook { _%@namespace import -force ::blt::* }
-    file delete tclIndex
     auto_mkindex . autoMkindex.tcl
-     
+    file exists tclIndex
+} -cleanup {
     # Reset initCommands to avoid trashing other tests
-
     AutoMkindexTestReset
-    file exists tclIndex
-} 1 
-
-# The auto_mkindex_parser::command is used to register commands
-# that create new commands.
-
-test autoMkindex-3.2 {auto_mkindex_parser::command} {
+} -result 1 
+# The auto_mkindex_parser::command is used to register commands that create
+# new commands.
+test autoMkindex-3.2 {auto_mkindex_parser::command} -setup {
+    file delete tclIndex
+} -body {
     auto_mkindex_parser::command buried::myproc {name args} {
 	variable index
 	variable scriptFile
 	append index [list set auto_index([fullname $name])] \
 		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
     }
-    file delete tclIndex
     auto_mkindex . autoMkindex.tcl
     namespace eval tcl_autoMkindex_tmp {
         set dir "."
@@ -208,17 +201,16 @@ test autoMkindex-3.2 {auto_mkindex_parser::command} {
         foreach elem [lsort [array names auto_index]] {
             lappend ::result [list $elem $auto_index($elem)]
         }
+	return $::result
     }
+} -cleanup {
     namespace delete tcl_autoMkindex_tmp
-
     # Reset initCommands to avoid trashing other tests
-
     AutoMkindexTestReset
-    set ::result
-} "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
-
-
-test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
+} -result "{::buried::explicit $element} {::buried::inside $element} {{::buried::my proc} $element} {::buried::mycmd1 $element} {::buried::mycmd2 $element} {::buried::mycmd4 $element} {::buried::myproc $element} {::buried::pub_one $element} {::buried::pub_two $element} {::buried::relative $element} {::buried::under::neath $element} {::buried::within $element} {::parent::child::test $element} {indented $element} {mycmd3 $element} {normal $element} {top $element}"
+test autoMkindex-3.3 {auto_mkindex_parser::command} -setup {
+    file delete tclIndex
+} -constraints {knownBug} -body {
     auto_mkindex_parser::command {buried::my proc} {name args} {
 	variable index
 	variable scriptFile
@@ -226,7 +218,6 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
 	append index [list set auto_index([fullname $name])] \
 		" \[list source \[file join \$dir [list $scriptFile]\]\]\n"
     }
-    file delete tclIndex
     auto_mkindex . autoMkindex.tcl
     namespace eval tcl_autoMkindex_tmp {
         set dir "."
@@ -237,109 +228,125 @@ test autoMkindex-3.3 {auto_mkindex_parser::command} {knownBug} {
             lappend ::result [list $elem $auto_index($elem)]
         }
     }
+    list [lsearch -inline $::result *mycmd4*] \
+	[lsearch -inline $::result *mycmd5*] \
+	[lsearch -inline $::result *mycmd6*]
+} -cleanup {
     namespace delete tcl_autoMkindex_tmp
-
     # Reset initCommands to avoid trashing other tests
-
     AutoMkindexTestReset
-    proc lvalue {list pattern} {
-	set ix [lsearch $list $pattern]
-	if {$ix >= 0} {
-	    return [lindex $list $ix]
-	} else {
-	    return {}
-	}
-    }
-    list [lvalue $::result *mycmd4*] [lvalue $::result *mycmd5*] [lvalue $::result *mycmd6*]
-} "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
+} -result "{::buried::mycmd4 $element} {::buried::mycmd5 $element} {mycmd6 $element}"
+makeFile {
 
+namespace eval wok {
+    namespace ensemble create -subcommands {commands vars}
 
-makeDirectory pkg
-makeFile {
-package provide football 1.0
-    
-namespace eval ::pro:: {
-    #
-    # export only public functions.
-    #
-    namespace export {[a-z]*}
-}
-namespace eval ::college:: {
-    #
-    # export only public functions.
-    #
-    namespace export {[a-z]*}
-}
+    proc commands {{pattern *}} {
+	puts [join [lsort -dictionary [info commands $pattern]] \n]
+    }
 
-proc ::pro::team {} {
-    puts "go packers!"
-    return true
-}
+    proc vars {{pattern *}} {
+	puts [join [lsort -dictionary [info vars $pattern]] \n]
+    }
 
-proc ::college::team {} {
-    puts "go badgers!"
-    return true
 }
 
-} [file join pkg samename.tcl]
-
+} ensemblecommands.tcl
 
-test autoMkindex-4.1 {platform indenpendant source commands} {
+test autoMkindex-3.4 {ensemble commands in tclIndex} {
     file delete tclIndex
-    auto_mkindex . pkg/samename.tcl
+    auto_mkindex . ensemblecommands.tcl
     set f [open tclIndex r]
-    set dat [split [string trim [read $f]] "\n"]
-    set len [llength $dat]
-    set result [lsort [lrange $dat [expr {$len-2}] [expr {$len-1}]]]
+    set dat [list]
+    foreach r [split [string trim [read $f]] "\n"] {
+	if {[string match {set auto_index*} $r]} {
+	    lappend dat $r
+	}
+    }
+    set result [lsort $dat]
     close $f
     set result
-} {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}
-
-removeFile [file join pkg samename.tcl]
+} {{set auto_index(::wok::commands) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(::wok::vars) [list source [file join $dir ensemblecommands.tcl]]} {set auto_index(wok) [list source [file join $dir ensemblecommands.tcl]]}}
+removeFile ensemblecommands.tcl
 
-makeFile {
-set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
-set dollar2 "this string contains an escaped dollar sign -> \$foo \\\$foo"
-set bracket1 "this contains an unescaped bracket [NoSuchProc]"
-set bracket2 "this contains an escaped bracket \[NoSuchProc\]"
-set bracket3 "this contains nested unescaped brackets [[NoSuchProc]]"
-proc testProc {} {}
-} [file join pkg magicchar.tcl]
-
-test autoMkindex-5.1 {escape magic tcl chars in general code} {
+test autoMkindex-4.1 {platform independent source commands} -setup {
+    file delete tclIndex
+    makeDirectory pkg
+    makeFile {
+	package provide football 1.0
+	namespace eval ::pro:: {
+	    #
+	    # export only public functions.
+	    #
+	    namespace export {[a-z]*}
+	}
+	namespace eval ::college:: {
+	    #
+	    # export only public functions.
+	    #
+	    namespace export {[a-z]*}
+	}
+	proc ::pro::team {} {
+	    puts "go packers!"
+	    return true
+	}
+	proc ::college::team {} {
+	    puts "go badgers!"
+	    return true
+	}
+    } [file join pkg samename.tcl]
+} -body {
+    auto_mkindex . pkg/samename.tcl
+    set f [open tclIndex r]
+    lsort [lrange [split [string trim [read $f]] "\n"] end-1 end]
+} -cleanup {
+    catch {close $f}
+    removeFile [file join pkg samename.tcl]
+    removeDirectory pkg
+} -result {{set auto_index(::college::team) [list source [file join $dir pkg samename.tcl]]} {set auto_index(::pro::team) [list source [file join $dir pkg samename.tcl]]}}
+
+test autoMkindex-5.1 {escape magic tcl chars in general code} -setup {
     file delete tclIndex
+    makeDirectory pkg
+    makeFile {
+	set dollar1 "this string contains an unescaped dollar sign -> \\$foo"
+	set dollar2 \
+	    "this string contains an escaped dollar sign -> \$foo \\\$foo"
+	set bracket1 "this contains an unescaped bracket [NoSuchProc]"
+	set bracket2 "this contains an escaped bracket \[NoSuchProc\]"
+	set bracket3 \
+	    "this contains nested unescaped brackets [[NoSuchProc]]"
+	proc testProc {} {}
+    } [file join pkg magicchar.tcl]
     set result {}
-    if { ![catch {auto_mkindex . pkg/magicchar.tcl}] } {
-	set f [open tclIndex r]
-	set dat [split [string trim [read $f]] "\n"]
-	set result [lindex $dat end]
-	close $f
-    }
-    set result
-} {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
-
-removeFile [file join pkg magicchar.tcl]
-
-makeFile {
-proc {[magic mojo proc]} {} {}
-} [file join pkg magicchar2.tcl]
-
-test autoMkindex-5.2 {correctly locate auto loaded procs with []} {
+} -body {
+    auto_mkindex . pkg/magicchar.tcl
+    set f [open tclIndex r]
+    lindex [split [string trim [read $f]] "\n"] end
+} -cleanup {
+    catch {close $f}
+    removeFile [file join pkg magicchar.tcl]
+    removeDirectory pkg
+} -result {set auto_index(testProc) [list source [file join $dir pkg magicchar.tcl]]}
+test autoMkindex-5.2 {correctly locate auto loaded procs with []} -setup {
     file delete tclIndex
+    makeDirectory pkg
+    makeFile {
+	proc {[magic mojo proc]} {} {}
+    } [file join pkg magicchar2.tcl]
     set result {}
-    if { ![catch {auto_mkindex . pkg/magicchar2.tcl}] } {
-	# Make a slave interp to test the autoloading
-	set c [interp create]
-	$c eval {lappend auto_path [pwd]}
-	set result [$c eval {catch {{[magic mojo proc]}}}]
-	interp delete $c
-    }
-    set result
-} 0
-
-removeFile [file join pkg magicchar2.tcl]
-removeDirectory pkg
-
+    interp create slave
+} -body {
+    auto_mkindex . pkg/magicchar2.tcl
+    # Make a slave interp to test the autoloading
+    slave eval {lappend auto_path [pwd]}
+    slave eval {catch {{[magic mojo proc]}}}
+} -cleanup {
+    interp delete slave
+    removeFile [file join pkg magicchar2.tcl]
+    removeDirectory pkg
+} -result 0
+
 # Clean up.
 
 unset result
@@ -357,3 +364,9 @@ if {[file exists tclIndex]} {
 cd $origDir
 
 ::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/basic.test b/tests/basic.test
index 2dc628d..1a0037c 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -14,12 +14,12 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: basic.test,v 1.40 2005/05/10 18:34:56 kennykb Exp $
-#
 
 package require tcltest 2
-namespace import -force ::tcltest::*
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testevalex [llength [info commands testevalex]]
 testConstraint testcmdtoken [llength [info commands testcmdtoken]]
@@ -31,7 +31,7 @@ catch {interp delete test_interp}
 catch {rename p ""}
 catch {rename q ""}
 catch {rename cmd ""}
-catch {unset x}
+unset -nocomplain x
 
 test basic-1.1 {Tcl_CreateInterp, creates interp's global namespace} {
     catch {interp delete test_interp}
@@ -155,7 +155,7 @@ test basic-12.2 {Tcl_HideCommand, a hidden cmd remembers its containing namespac
          [namespace delete test_ns_basic]
 } {:: {} 1 {invalid command name "cmd"} {} :: {}}
 
-test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and can not go to another namespace} {
+test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and cannot go to another namespace} {
     catch {namespace delete test_ns_basic}
     catch {rename cmd ""}
     proc cmd {} {   ;# note that this is global
@@ -182,7 +182,7 @@ test basic-13.1 {Tcl_ExposeCommand, a command stays in the global namespace and
          [test_ns_basic::exposeCmdWorkAround] \
          [test_ns_basic::newCmd] \
          [namespace delete test_ns_basic]
-} {:: {} 1 {can not expose to a namespace (use expose to toplevel, then rename)} {} ::test_ns_basic {}}
+} {:: {} 1 {cannot expose to a namespace (use expose to toplevel, then rename)} {} ::test_ns_basic {}}
 test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being exposed} {
     catch {rename p ""}
     catch {rename cmd ""}
@@ -202,13 +202,13 @@ test basic-13.2 {Tcl_ExposeCommand, invalidate cached refs to cmd now being expo
 } {42 {} {} Hello {} {} 42}
 
 test basic-14.1 {Tcl_CreateCommand, new cmd goes into a namespace specified in its name, if any} {testcreatecommand} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [testcreatecommand create] \
 	 [test_ns_basic::createdcommand] \
 	 [testcreatecommand delete]
 } {{} {CreatedCommandProc in ::test_ns_basic} {}}
 test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle or end of names} {testcreatecommand} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename value:at: ""}
     list [testcreatecommand create2] \
 	 [value:at:] \
@@ -216,7 +216,7 @@ test basic-14.2 {Tcl_CreateCommand, namespace code ignore single ":"s in middle
 } {{} {CreatedCommandProc2 in ::} {}}
 
 test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified in its name, if any} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_basic {}
     proc test_ns_basic::cmd {} {  ;# proc requires that ns already exist
         return [namespace current]
@@ -232,7 +232,7 @@ test basic-17.1 {TclInvokeObjCommand} {emptyTest} {
 } {}
 
 test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace qualifiers} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename cmd ""}
     namespace eval test_ns_basic {
         proc p {} {
@@ -244,11 +244,11 @@ test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace quali
          [test_ns_basic::q] 
 } {{p in ::test_ns_basic} {} {p in ::test_ns_basic}}
 test basic-18.2 {TclRenameCommand, existing cmd must be found} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {rename test_ns_basic::p test_ns_basic::q} msg] $msg
 } {1 {can't rename "test_ns_basic::p": command doesn't exist}}
 test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_basic {
         proc p {} {
             return "p in [namespace current]"
@@ -259,7 +259,7 @@ test basic-18.3 {TclRenameCommand, delete cmd if new name is empty} {
          [info commands test_ns_basic::*]
 } {::test_ns_basic::p {} {}}
 test basic-18.4 {TclRenameCommand, bad new name} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_basic {
         proc p {} {
             return "p in [namespace current]"
@@ -267,16 +267,26 @@ test basic-18.4 {TclRenameCommand, bad new name} {
     }
     rename test_ns_basic::p :::george::martha
 } {}
-test basic-18.5 {TclRenameCommand, new name must not already exist} {
+test basic-18.5 {TclRenameCommand, new name must not already exist} -setup {
+    if {![llength [info commands :::george::martha]]} {
+        catch {namespace delete {*}[namespace children :: test_ns_*]}
+        namespace eval test_ns_basic {
+            proc p {} {
+                return "p in [namespace current]"
+            }
+        }
+        rename test_ns_basic::p :::george::martha
+    }
+} -body {
     namespace eval test_ns_basic {
         proc q {} {
             return 42
         }
     }
     list [catch {rename test_ns_basic::q :::george::martha} msg] $msg
-} {1 {can't rename to ":::george::martha": command already exists}}
+} -result {1 {can't rename to ":::george::martha": command already exists}}
 test basic-18.6 {TclRenameCommand, check for command shadowing by newly renamed cmd} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename p ""}
     catch {rename q ""}
     proc p {} {
@@ -299,10 +309,10 @@ test basic-19.1 {Tcl_SetCommandInfo} {emptyTest} {
 } {}
 
 test basic-20.1 {Tcl_GetCommandInfo, names for commands created inside namespaces} {testcmdtoken} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename p ""}
     catch {rename q ""}
-    catch {unset x}
+    unset -nocomplain x
     set x [namespace eval test_ns_basic::test_ns_basic2 {
         # the following creates a cmd in the global namespace
         testcmdtoken create p
@@ -328,7 +338,7 @@ test basic-21.1 {Tcl_GetCommandName} {emptyTest} {
 } {}
 
 test basic-22.1 {Tcl_GetCommandFullName} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_basic1 {
         namespace export cmd*
         proc cmd1 {} {}
@@ -355,7 +365,7 @@ test basic-23.1 {Tcl_DeleteCommand} {emptyTest} {
 
 test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd has compile proc} {
     catch {interp delete test_interp}
-    catch {unset x}
+    unset -nocomplain x
     interp create test_interp
     interp eval test_interp {
         proc useSet {} {
@@ -374,7 +384,7 @@ test basic-24.1 {Tcl_DeleteCommandFromToken, invalidate all compiled code if cmd
          [interp delete test_interp]
 } {123 {set called with a 123} {}}
 test basic-24.2 {Tcl_DeleteCommandFromToken, deleting commands changes command epoch} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename p ""}
     proc p {} {
         return "global p"
@@ -392,7 +402,7 @@ test basic-24.2 {Tcl_DeleteCommandFromToken, deleting commands changes command e
          [test_ns_basic::callP]
 } {{namespace p} {} {global p}}
 test basic-24.3 {Tcl_DeleteCommandFromToken, delete imported cmds that refer to a deleted cmd} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename p ""}
     namespace eval test_ns_basic {
         namespace export p
@@ -427,7 +437,7 @@ test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} -setup {
     # string would have been freed, leaving garbage bytes for the error
     # message.
     set f [open $fName w]
-    fileevent $f writable "fileevent $f writable {}; error foo"
+    chan event $f writable "chan event $f writable {}; error foo"
     set x {}
     vwait x
     close $f
@@ -438,7 +448,7 @@ test basic-26.1 {Tcl_EvalObj: preserve object while evaling it} -setup {
     rename myHandler {}
 } -result "foo\n    while executing\n\"error foo\""
 
-test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
+test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
     #
     # Follow the pure-list branch in a manner that
     #   a - the pure-list internal rep is destroyed by shimmering
@@ -455,9 +465,13 @@ test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
 	error "BAD CALL"
     }
     catch {eval $SRC}
-} 1
+} -result 1 -cleanup {
+    rename foo {}
+    rename $::SRC {}
+    unset ::SRC
+}
 
-test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
+test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
     #
     # Follow the pure-list branch in a manner that
     #   a - the pure-list internal rep is destroyed by shimmering
@@ -473,7 +487,11 @@ test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} {
 	info level 0
     }
     catch {eval $SRC}
-} 0
+} -result 0 -cleanup {
+    rename foo {}
+    rename $::SRC {}
+    unset ::SRC
+}
 
 test basic-27.1 {Tcl_ExprLong} {emptyTest} {
 } {}
@@ -494,7 +512,7 @@ test basic-32.1 {Tcl_ExprBooleanObj} {emptyTest} {
 } {}
 
 test basic-36.1 {Tcl_EvalObjv, lookup of "unknown" command} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {interp delete test_interp}
     interp create test_interp
     interp eval test_interp {
@@ -539,10 +557,10 @@ test basic-46.1 {Tcl_AllowExceptions: exception return not allowed} {stdio} {
     catch {close $f}
     set res [catch {
 	set f [open |[list [interpreter]] w+]
-	fconfigure $f -buffering line
-	puts $f {fconfigure stdout -buffering line}
+	chan configure $f -buffering line
+	puts $f {chan configure stdout -buffering line}
 	puts $f continue
-	puts $f {puts $errorInfo}
+	puts $f {puts $::errorInfo}
 	puts $f {puts DONE}
 	set newMsg {}
 	set msg {}
@@ -623,8 +641,10 @@ test basic-46.5 {Tcl_AllowExceptions: exception return not allowed} -setup {
 "return -code return"
     (file "*BREAKtest" line 2)}
 
-test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -body {
-    subst {a[set b [format cd]}
+test basic-47.1 {Tcl_EvalEx: check for missing close-bracket} -constraints {
+    testevalex
+} -body {
+    testevalex {a[set b [format cd]}
 } -returnCodes error -result {missing close-bracket}
 
 # Some lists for expansion tests to work with
@@ -646,69 +666,69 @@ if $noComp {
 }
 
 test basic-47.2.$noComp {Tcl_EvalEx: error during word expansion} -body {
-    run {{expand}\{}
+    run {{*}\{}
 } -constraints $constraints -returnCodes error -result {unmatched open brace in list}
 
 test basic-47.3.$noComp {Tcl_EvalEx, error during substitution} -body {
-    run {{expand}[error foo]}
+    run {{*}[error foo]}
 } -constraints $constraints -returnCodes error -result foo
 
 test basic-47.4.$noComp {Tcl_EvalEx: no expansion} $constraints {
-    run {list {expand} {expand}	{expand}}
-} {expand expand expand}
+    run {list {*} {*}	{*}}
+} {* * *}
 
 test basic-47.5.$noComp {Tcl_EvalEx: expansion} $constraints {
-    run {list {expand}{} {expand}	{expand}x {expand}"y z"}
-} {expand x y z}
+    run {list {*}{} {*}	{*}x {*}"y z"}
+} {* x y z}
 
 test basic-47.6.$noComp {Tcl_EvalEx: expansion to zero args} $constraints {
-    run {list {expand}{}}
+    run {list {*}{}}
 } {}
 
 test basic-47.7.$noComp {Tcl_EvalEx: expansion to one arg} $constraints {
-    run {list {expand}x}
+    run {list {*}x}
 } x
 
 test basic-47.8.$noComp {Tcl_EvalEx: expansion to many args} $constraints {
-    run {list {expand}"y z"}
+    run {list {*}"y z"}
 } {y z}
 
 test basic-47.9.$noComp {Tcl_EvalEx: expansion and subst order} $constraints {
     set x 0
-    run {list [incr x] {expand}[incr x] [incr x] \
-		{expand}[list [incr x] [incr x]] [incr x]}
+    run {list [incr x] {*}[incr x] [incr x] \
+		{*}[list [incr x] [incr x]] [incr x]}
 } {1 2 3 4 5 6}
 
 test basic-47.10.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
-    run {concat {expand}{} a b c d e f g h i j k l m n o p q r}
+    run {concat {*}{} a b c d e f g h i j k l m n o p q r}
 } {a b c d e f g h i j k l m n o p q r}
 
 test basic-47.11.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
-    run {concat {expand}1 a b c d e f g h i j k l m n o p q r}
+    run {concat {*}1 a b c d e f g h i j k l m n o p q r}
 } {1 a b c d e f g h i j k l m n o p q r}
 
 test basic-47.12.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
-    run {concat {expand}{1 2} a b c d e f g h i j k l m n o p q r}
+    run {concat {*}{1 2} a b c d e f g h i j k l m n o p q r}
 } {1 2 a b c d e f g h i j k l m n o p q r}
 
 test basic-47.13.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
-    run {concat {expand}{} {expand}{1 2} a b c d e f g h i j k l m n o p q}
+    run {concat {*}{} {*}{1 2} a b c d e f g h i j k l m n o p q}
 } {1 2 a b c d e f g h i j k l m n o p q}
 
 test basic-47.14.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
-    run {concat {expand}{} a b c d e f g h i j k l m n o p q r s}
+    run {concat {*}{} a b c d e f g h i j k l m n o p q r s}
 } {a b c d e f g h i j k l m n o p q r s}
 
 test basic-47.15.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
-    run {concat {expand}1 a b c d e f g h i j k l m n o p q r s}
+    run {concat {*}1 a b c d e f g h i j k l m n o p q r s}
 } {1 a b c d e f g h i j k l m n o p q r s}
 
 test basic-47.16.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
-    run {concat {expand}{1 2} a b c d e f g h i j k l m n o p q r s}
+    run {concat {*}{1 2} a b c d e f g h i j k l m n o p q r s}
 } {1 2 a b c d e f g h i j k l m n o p q r s}
 
 test basic-47.17.$noComp {Tcl_EvalEx: expand and memory management} $constraints {
-    run {concat {expand}{} {expand}{1 2} a b c d e f g h i j k l m n o p q r}
+    run {concat {*}{} {*}{1 2} a b c d e f g h i j k l m n o p q r}
 } {1 2 a b c d e f g h i j k l m n o p q r}
 
 test basic-48.1.$noComp {expansion: parsing} $constraints {
@@ -716,7 +736,7 @@ test basic-48.1.$noComp {expansion: parsing} $constraints {
 
 		# Another comment
 		list 1  2\
-			3   {expand}$::l1
+			3   {*}$::l1
             
 		# Comment again
 	}
@@ -727,13 +747,13 @@ test basic-48.2.$noComp {no expansion} $constraints {
 } {{a {b b} c d} {e f {g g} h} {i j k {l l}}}
 
 test basic-48.3.$noComp {expansion} $constraints {
-        run {list {expand}$::l1 $::l2 {expand}[l3]}
+        run {list {*}$::l1 $::l2 {*}[l3]}
 } {a {b b} c d {e f {g g} h} i j k {l l}}
 
 test basic-48.4.$noComp {expansion: really long cmd} $constraints {
         set cmd [list list]
         for {set t 0} {$t < 500} {incr t} {
-            lappend cmd {{expand}$::l1}
+            lappend cmd {{*}$::l1}
         }
         llength [run [join $cmd]]
 } 2000
@@ -741,31 +761,31 @@ test basic-48.4.$noComp {expansion: really long cmd} $constraints {
 test basic-48.5.$noComp {expansion: error detection} -setup {
 	set l "a {a b}x y"
 } -constraints $constraints -body {
-	run {list $::l1 {expand}$l}
+	run {list $::l1 {*}$l}
 } -cleanup {
 	unset l
 } -returnCodes 1 -result {list element in braces followed by "x" instead of space}
 
 test basic-48.6.$noComp {expansion: odd usage} $constraints {
-        run {list {expand}$::l1$::l2}
+        run {list {*}$::l1$::l2}
 } {a {b b} c de f {g g} h}
 
 test basic-48.7.$noComp {expansion: odd usage} -constraints $constraints -body {
-        run {list {expand}[l3]$::l1}
+        run {list {*}[l3]$::l1}
 } -returnCodes 1 -result {list element in braces followed by "a" instead of space}
 
 test basic-48.8.$noComp {expansion: odd usage} $constraints {
-        run {list {expand}hej$::l1}
+        run {list {*}hej$::l1}
 } {heja {b b} c d}
 
-test basic-48.9.$noComp {expansion: Not all {expand} should trigger} $constraints {
-	run {list {expand}$::l1 \{expand\}$::l2 "{expand}$::l1" {{expand} i j k}}
-} {a {b b} c d {{expand}e f {g g} h} {{expand}a {b b} c d} {{expand} i j k}}
+test basic-48.9.$noComp {expansion: Not all {*} should trigger} $constraints {
+	run {list {*}$::l1 \{*\}$::l2 "{*}$::l1" {{*} i j k}}
+} {a {b b} c d {{*}e f {g g} h} {{*}a {b b} c d} {{*} i j k}}
 
 test basic-48.10.$noComp {expansion: expansion of command word} -setup {
 	set cmd [list string range jultomte]
 } -constraints $constraints -body {
-	run {{expand}$cmd 2 6}
+	run {{*}$cmd 2 6}
 } -cleanup {
 	unset cmd
 } -result ltomt
@@ -774,24 +794,24 @@ test basic-48.11.$noComp {expansion: expansion into nothing} -setup {
         set cmd {}
         set bar {}
 } -constraints $constraints -body {
-        run {{expand}$cmd {expand}$bar}
+        run {{*}$cmd {*}$bar}
 } -cleanup {
 	unset cmd bar
 } -result {}
 
 test basic-48.12.$noComp {expansion: odd usage} $constraints {
-	run {list {expand}$::l1 {expand}"hej hopp" {expand}$::l2}
+	run {list {*}$::l1 {*}"hej hopp" {*}$::l2}
 } {a {b b} c d hej hopp e f {g g} h}
 
 test basic-48.13.$noComp {expansion: odd usage} $constraints {
-	run {list {expand}$::l1 {expand}{hej hopp} {expand}$::l2}
+	run {list {*}$::l1 {*}{hej hopp} {*}$::l2}
 } {a {b b} c d hej hopp e f {g g} h}
 
 test basic-48.14.$noComp {expansion: hash command} -setup {
         catch {rename \# ""}
         set cmd "#"
     } -constraints $constraints -body { 
-           run { {expand}$cmd apa bepa }
+           run { {*}$cmd apa bepa }
     } -cleanup {
 	unset cmd
 } -returnCodes 1 -result {invalid command name "#"}
@@ -802,7 +822,7 @@ test basic-48.15.$noComp {expansion: complex words} -setup {
             set c [list {f\ g h\ i j k} x y]
             set d {0\ 1 2 3}
     } -constraints $constraints -body {
-            run { lappend d {expand}$a($b) {expand}[lindex $c 0] }
+            run { lappend d {*}$a($b) {*}[lindex $c 0] }
     } -cleanup {
 	unset a b c d
 } -result {{0 1} 2 3 a {b c} d e {f g} {h i} j k}
@@ -820,25 +840,25 @@ test basic-48.16.$noComp {expansion: testing for leaks} -setup {
             # Create free objects that should disappear
             set l [list 1$a 2$a 3$a 4$a 5$a 6$a 7$a]
             # A short number of words and a short result (8)
-            set l [run {list {expand}$l $a$a}]
+            set l [run {list {*}$l $a$a}]
             # A short number of words and a longer result (27)
-            set l [run {list {expand}$l $a$a {expand}$l $a$a {expand}$l $a$a}]
+            set l [run {list {*}$l $a$a {*}$l $a$a {*}$l $a$a}]
             # A short number of words and a longer result, with an error
             # This is to stress the cleanup in the error case
-            if {![catch {run {_moo_ {expand}$l $a$a {expand}$l $a$a {expand}$l}}]} {
+            if {![catch {run {_moo_ {*}$l $a$a {*}$l $a$a {*}$l}}]} {
                 error "An error was expected in the previous statement"
             }
             # Many words
-            set l [run {list {expand}$l $a$a {expand}$l $a$a \
-                                 {expand}$l $a$a {expand}$l $a$a \
-                                 {expand}$l $a$a {expand}$l $a$a \
-                                 {expand}$l $a$a {expand}$l $a$a \
-                                 {expand}$l $a$a {expand}$l $a$a \
-                                 {expand}$l $a$a {expand}$l $a$a \
-                                 {expand}$l $a$a {expand}$l $a$a \
-                                 {expand}$l $a$a {expand}$l $a$a \
-                                 {expand}$l $a$a {expand}$l $a$a \
-                                 {expand}$l $a$a}]
+            set l [run {list {*}$l $a$a {*}$l $a$a \
+                                 {*}$l $a$a {*}$l $a$a \
+                                 {*}$l $a$a {*}$l $a$a \
+                                 {*}$l $a$a {*}$l $a$a \
+                                 {*}$l $a$a {*}$l $a$a \
+                                 {*}$l $a$a {*}$l $a$a \
+                                 {*}$l $a$a {*}$l $a$a \
+                                 {*}$l $a$a {*}$l $a$a \
+                                 {*}$l $a$a {*}$l $a$a \
+                                 {*}$l $a$a}]
 
             if {[llength $l] != 19*28} {
                 error "Bad Length: [llength $l] should be [expr {19*28}]"
@@ -864,7 +884,7 @@ test basic-48.17.$noComp {expansion: object safety} -setup {
     } -constraints $constraints -body { 
             set third [expr {1.0/3.0}]
             set l [list $third $third]
-            set x [run {list $third {expand}$l $third}]
+            set x [run {list $third {*}$l $third}]
 	    set res [list]
             foreach t $x {
                 lappend res [expr {$t * 3.0}]
@@ -881,7 +901,7 @@ test basic-48.18.$noComp {expansion: list semantics} -constraints $constraints -
             set apa 10
         }
         set apa 0
-        list [llength [run { {expand}$badcmd }]] $apa
+        list [llength [run { {*}$badcmd }]] $apa
     } -cleanup {
 	unset apa badcmd
 } -result {5 0}
@@ -890,38 +910,38 @@ test basic-48.19.$noComp {expansion: error checking order} -body {
         set badlist "a {}x y"
         set a 0
         set b 0
-        catch {run {list [incr a] {expand}$badlist [incr b]}}
+        catch {run {list [incr a] {*}$badlist [incr b]}}
         list $a $b
     } -constraints $constraints -cleanup {
 	unset badlist a b
 } -result {1 0}
 
 test basic-48.20.$noComp {expansion: odd case with word boundaries} $constraints {
-    run {list {expand}$::l1 {expand}"hej hopp" {expand}$::l2}
+    run {list {*}$::l1 {*}"hej hopp" {*}$::l2}
 } {a {b b} c d hej hopp e f {g g} h}
 
 test basic-48.21.$noComp {expansion: odd case with word boundaries} $constraints {
-    run {list {expand}$::l1 {expand}{hej hopp} {expand}$::l2}
+    run {list {*}$::l1 {*}{hej hopp} {*}$::l2}
 } {a {b b} c d hej hopp e f {g g} h}
 
 test basic-48.22.$noComp {expansion: odd case with word boundaries} -body {
-    run {list {expand}$::l1 {expand}"hej hopp {expand}$::l2}
+    run {list {*}$::l1 {*}"hej hopp {*}$::l2}
 } -constraints $constraints -returnCodes error -result {missing "}
 
 test basic-48.23.$noComp {expansion: handle return codes} -constraints $constraints -body {
         set res {}
         for {set t 0} {$t < 10} {incr t} {
-            run { {expand}break }
+            run { {*}break }
         }
         lappend res $t
 
         for {set t 0} {$t < 10} {incr t} {
-            run { {expand}continue }
+            run { {*}continue }
             set t 20
         }
         lappend res $t
 
-        lappend res [catch { run { {expand}{error Hejsan} } } err]
+        lappend res [catch { run { {*}{error Hejsan} } } err]
         lappend res $err
     } -cleanup {
 	unset res t
@@ -955,13 +975,13 @@ rename l3 {}
 rename run {}
 
  #cleanup
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
+catch {namespace delete {*}[namespace children :: test_ns_*]}
 catch {namespace delete george}
 catch {interp delete test_interp}
 catch {rename p ""}
 catch {rename q ""}
 catch {rename cmd ""}
 catch {rename value:at: ""}
-catch {unset x}
-::tcltest::cleanupTests
+unset -nocomplain x
+cleanupTests
 return
diff --git a/tests/binary.test b/tests/binary.test
index fb934d8..40b1315 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -1,52 +1,106 @@
-# This file tests the tclBinary.c file and the "binary" Tcl command. 
+# This file tests the tclBinary.c file and the "binary" Tcl command.
 #
-# 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) 1997 by 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.
-#
-# RCS: @(#) $Id: binary.test,v 1.20 2005/05/10 20:17:43 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-::tcltest::testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
-::tcltest::testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
+testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
+testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
+
+# Big test for correct ordering of data in [expr]
+proc testIEEE {} {
+    variable ieeeValues
+    binary scan [binary format dd -1.0 1.0] c* c
+    switch -exact -- $c {
+	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
+	    # little endian
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
+		ieeeValues(-Infinity)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
+		ieeeValues(-Normal)
+	    binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
+		ieeeValues(-Subnormal)
+	    binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
+		ieeeValues(-0)
+	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+0)
+	    binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
+		ieeeValues(+Subnormal)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
+		ieeeValues(+Normal)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
+		ieeeValues(+Infinity)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
+		ieeeValues(NaN)
+	    set ieeeValues(littleEndian) 1
+	    return 1
+	}
+	{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
+	    binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-Infinity)
+	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-Normal)
+	    binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-Subnormal)
+	    binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-0)
+	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+0)
+	    binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+Subnormal)
+	    binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+Normal)
+	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+Infinity)
+	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(NaN)
+	    set ieeeValues(littleEndian) 0
+	    return 1
+	}
+	default {
+	    return 0
+	}
+    }
+}
+
+testConstraint ieeeFloatingPoint [testIEEE]
+
+# ----------------------------------------------------------------------
 
 test binary-0.1 {DupByteArrayInternalRep} {
     set hdr [binary format cc 0 0316]
     set buf hellomatt
-    
     set data $hdr
     append data $buf
-    
     string length $data
 } 11
 
-test binary-1.1 {Tcl_BinaryObjCmd: bad args} {
-    list [catch {binary} msg] $msg
-} {1 {wrong # args: should be "binary option ?arg arg ...?"}}
-test binary-1.2 {Tcl_BinaryObjCmd: bad args} {
-    list [catch {binary foo} msg] $msg
-} {1 {bad option "foo": must be format or scan}}
-
-test binary-1.3 {Tcl_BinaryObjCmd: format error} {
-    list [catch {binary f} msg] $msg
-} {1 {wrong # args: should be "binary format formatString ?arg arg ...?"}}
-test binary-1.4 {Tcl_BinaryObjCmd: format} {
+test binary-1.1 {Tcl_BinaryObjCmd: bad args} -body {
+    binary
+} -returnCodes error -match glob -result {wrong # args: *}
+test binary-1.2 {Tcl_BinaryObjCmd: bad args} -returnCodes error -body {
+    binary foo
+} -match glob -result {unknown or ambiguous subcommand "foo": *}
+test binary-1.3 {Tcl_BinaryObjCmd: format error} -returnCodes error -body {
+    binary f
+} -result {wrong # args: should be "binary format formatString ?arg ...?"}
+test binary-1.4 {Tcl_BinaryObjCmd: format} -body {
     binary format ""
-} {}
+} -result {}
 
-
-test binary-2.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format a } msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-2.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format a
+} -result {not enough arguments for all format specifiers}
 test binary-2.2 {Tcl_BinaryObjCmd: format} {
     binary format a0 foo
 } {}
@@ -69,9 +123,9 @@ test binary-2.8 {Tcl_BinaryObjCmd: format} {
     binary format a*X3a2 foobar x
 } foox\x00r
 
-test binary-3.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format A} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-3.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format A
+} -result {not enough arguments for all format specifiers}
 test binary-3.2 {Tcl_BinaryObjCmd: format} {
     binary format A0 f
 } {}
@@ -94,9 +148,9 @@ test binary-3.8 {Tcl_BinaryObjCmd: format} {
     binary format A*X3A2 foobar x
 } {foox r}
 
-test binary-4.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format B} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-4.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format B
+} -result {not enough arguments for all format specifiers}
 test binary-4.2 {Tcl_BinaryObjCmd: format} {
     binary format B0 1
 } {}
@@ -118,13 +172,13 @@ test binary-4.7 {Tcl_BinaryObjCmd: format} {
 test binary-4.8 {Tcl_BinaryObjCmd: format} {
     binary format B2B3 10 010
 } \x80\x40
-test binary-4.9 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format B1B5 1 foo} msg] $msg
-} {1 {expected binary string but got "foo" instead}}
+test binary-4.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format B1B5 1 foo
+} -result {expected binary string but got "foo" instead}
 
-test binary-5.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format b} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-5.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format b
+} -result {not enough arguments for all format specifiers}
 test binary-5.2 {Tcl_BinaryObjCmd: format} {
     binary format b0 1
 } {}
@@ -149,13 +203,13 @@ test binary-5.8 {Tcl_BinaryObjCmd: format} {
 test binary-5.9 {Tcl_BinaryObjCmd: format} {
     binary format b2b3 10 010
 } \x01\x02
-test binary-5.10 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format b1b5 1 foo} msg] $msg
-} {1 {expected binary string but got "foo" instead}}
+test binary-5.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format b1b5 1 foo
+} -result {expected binary string but got "foo" instead}
 
-test binary-6.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format h} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-6.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format h
+} -result {not enough arguments for all format specifiers}
 test binary-6.2 {Tcl_BinaryObjCmd: format} {
     binary format h0 1
 } {}
@@ -183,13 +237,13 @@ test binary-6.9 {Tcl_BinaryObjCmd: format} {
 test binary-6.10 {Tcl_BinaryObjCmd: format} {
     binary format h2h3 23 456
 } \x32\x54\x06
-test binary-6.11 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format h2 foo} msg] $msg
-} {1 {expected hexadecimal string but got "foo" instead}}
+test binary-6.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format h2 foo
+} -result {expected hexadecimal string but got "foo" instead}
 
-test binary-7.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format H} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-7.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format H
+} -result {not enough arguments for all format specifiers}
 test binary-7.2 {Tcl_BinaryObjCmd: format} {
     binary format H0 1
 } {}
@@ -217,16 +271,16 @@ test binary-7.9 {Tcl_BinaryObjCmd: format} {
 test binary-7.10 {Tcl_BinaryObjCmd: format} {
     binary format H2H3 23 456
 } \x23\x45\x60
-test binary-7.11 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format H2 foo} msg] $msg
-} {1 {expected hexadecimal string but got "foo" instead}}
-
-test binary-8.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format c} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-8.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format c blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-7.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format H2 foo
+} -result {expected hexadecimal string but got "foo" instead}
+
+test binary-8.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format c
+} -result {not enough arguments for all format specifiers}
+test binary-8.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format c blat
+} -result {expected integer but got "blat"}
 test binary-8.3 {Tcl_BinaryObjCmd: format} {
     binary format c0 0x50
 } {}
@@ -245,24 +299,24 @@ test binary-8.7 {Tcl_BinaryObjCmd: format} {
 test binary-8.8 {Tcl_BinaryObjCmd: format} {
     binary format c* {0x50 0x52}
 } PR
-test binary-8.9 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format c2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-8.10 {Tcl_BinaryObjCmd: format} {
+test binary-8.9 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format c2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-8.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {0x50 0x51}
-    list [catch {binary format c $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+    binary format c $a
+} -result "expected integer but got \"0x50 0x51\""
 test binary-8.11 {Tcl_BinaryObjCmd: format} {
     set a {0x50 0x51}
     binary format c1 $a
 } P
 
-test binary-9.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format s} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-9.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format s blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-9.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format s
+} -result {not enough arguments for all format specifiers}
+test binary-9.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format s blat
+} -result {expected integer but got "blat"}
 test binary-9.3 {Tcl_BinaryObjCmd: format} {
     binary format s0 0x50
 } {}
@@ -284,24 +338,24 @@ test binary-9.8 {Tcl_BinaryObjCmd: format} {
 test binary-9.9 {Tcl_BinaryObjCmd: format} {
     binary format s2 {0x50 0x52 0x53} 0x54
 } P\x00R\x00
-test binary-9.10 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format s2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-9.11 {Tcl_BinaryObjCmd: format} {
+test binary-9.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format s2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-9.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {0x50 0x51}
-    list [catch {binary format s $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+    binary format s $a
+} -result "expected integer but got \"0x50 0x51\""
 test binary-9.12 {Tcl_BinaryObjCmd: format} {
     set a {0x50 0x51}
     binary format s1 $a
 } P\x00
 
-test binary-10.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format S} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-10.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format S blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-10.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format S
+} -result {not enough arguments for all format specifiers}
+test binary-10.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format S blat
+} -result {expected integer but got "blat"}
 test binary-10.3 {Tcl_BinaryObjCmd: format} {
     binary format S0 0x50
 } {}
@@ -323,24 +377,24 @@ test binary-10.8 {Tcl_BinaryObjCmd: format} {
 test binary-10.9 {Tcl_BinaryObjCmd: format} {
     binary format S2 {0x50 0x52 0x53} 0x54
 } \x00P\x00R
-test binary-10.10 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format S2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-10.11 {Tcl_BinaryObjCmd: format} {
+test binary-10.10 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format S2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-10.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {0x50 0x51}
-    list [catch {binary format S $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+    binary format S $a
+} -result "expected integer but got \"0x50 0x51\""
 test binary-10.12 {Tcl_BinaryObjCmd: format} {
     set a {0x50 0x51}
     binary format S1 $a
 } \x00P
 
-test binary-11.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format i} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-11.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format i blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-11.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format i
+} -result {not enough arguments for all format specifiers}
+test binary-11.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format i blat
+} -result {expected integer but got "blat"}
 test binary-11.3 {Tcl_BinaryObjCmd: format} {
     binary format i0 0x50
 } {}
@@ -365,24 +419,24 @@ test binary-11.9 {Tcl_BinaryObjCmd: format} {
 test binary-11.10 {Tcl_BinaryObjCmd: format} {
     binary format i* {0x50515253 0x52}
 } SRQPR\x00\x00\x00
-test binary-11.11 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format i2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-11.12 {Tcl_BinaryObjCmd: format} {
+test binary-11.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format i2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-11.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {0x50 0x51}
-    list [catch {binary format i $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+    binary format i $a
+} -result "expected integer but got \"0x50 0x51\""
 test binary-11.13 {Tcl_BinaryObjCmd: format} {
     set a {0x50 0x51}
     binary format i1 $a
 } P\x00\x00\x00
 
-test binary-12.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format I} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-12.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format I blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-12.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format I
+} -result {not enough arguments for all format specifiers}
+test binary-12.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format I blat
+} -result {expected integer but got "blat"}
 test binary-12.3 {Tcl_BinaryObjCmd: format} {
     binary format I0 0x50
 } {}
@@ -407,24 +461,24 @@ test binary-12.9 {Tcl_BinaryObjCmd: format} {
 test binary-12.10 {Tcl_BinaryObjCmd: format} {
     binary format I* {0x50515253 0x52}
 } PQRS\x00\x00\x00R
-test binary-12.11 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format i2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-12.12 {Tcl_BinaryObjCmd: format} {
+test binary-12.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format i2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-12.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {0x50 0x51}
-    list [catch {binary format I $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+    binary format I $a
+} -result "expected integer but got \"0x50 0x51\""
 test binary-12.13 {Tcl_BinaryObjCmd: format} {
     set a {0x50 0x51}
     binary format I1 $a
 } \x00\x00\x00P
 
-test binary-13.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format f} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-13.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format f blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-13.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format f
+} -result {not enough arguments for all format specifiers}
+test binary-13.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format f blat
+} -result {expected floating-point number but got "blat"}
 test binary-13.3 {Tcl_BinaryObjCmd: format} {
     binary format f0 1.6
 } {}
@@ -464,13 +518,13 @@ test binary-13.14 {Tcl_BinaryObjCmd: float underflow} bigEndian {
 test binary-13.15 {Tcl_BinaryObjCmd: float underflow} littleEndian {
     binary format f -3.402825e-100
 } \x00\x00\x00\x80
-test binary-13.16 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format f2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-13.17 {Tcl_BinaryObjCmd: format} {
+test binary-13.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format f2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-13.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {1.6 3.4}
-    list [catch {binary format f $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+    binary format f $a
+} -result "expected floating-point number but got \"1.6 3.4\""
 test binary-13.18 {Tcl_BinaryObjCmd: format} bigEndian {
     set a {1.6 3.4}
     binary format f1 $a
@@ -480,12 +534,12 @@ test binary-13.19 {Tcl_BinaryObjCmd: format} littleEndian {
     binary format f1 $a
 } \xcd\xcc\xcc\x3f
 
-test binary-14.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format d} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-14.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format d blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-14.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format d
+} -result {not enough arguments for all format specifiers}
+test binary-14.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format d blat
+} -result {expected floating-point number but got "blat"}
 test binary-14.3 {Tcl_BinaryObjCmd: format} {
     binary format d0 1.6
 } {}
@@ -513,16 +567,13 @@ test binary-14.10 {Tcl_BinaryObjCmd: format} bigEndian {
 test binary-14.11 {Tcl_BinaryObjCmd: format} littleEndian {
     binary format d2 {1.6 3.4 5.6}
 } \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
-test binary-14.12 {Tcl_BinaryObjCmd: float overflow} {nonPortable bigEndian} {
-    binary format d NaN
-} \x7f\xff\xff\xff\xff\xff\xff\xff
-test binary-14.14 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format d2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-14.15 {Tcl_BinaryObjCmd: format} {
+test binary-14.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format d2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-14.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {1.6 3.4}
-    list [catch {binary format d $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+    binary format d $a
+} -result "expected floating-point number but got \"1.6 3.4\""
 test binary-14.16 {Tcl_BinaryObjCmd: format} bigEndian {
     set a {1.6 3.4}
     binary format d1 $a
@@ -531,10 +582,14 @@ test binary-14.17 {Tcl_BinaryObjCmd: format} littleEndian {
     set a {1.6 3.4}
     binary format d1 $a
 } \x9a\x99\x99\x99\x99\x99\xf9\x3f
-
-test binary-15.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format ax*a "y" "z"} msg] $msg
-} {1 {cannot use "*" in format string with "x"}}
+test binary-14.18 {FormatNumber: Bug 1116542} {
+    binary scan [binary format d 1.25] d w
+    set w
+} 1.25
+
+test binary-15.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format ax*a "y" "z"
+} -result {cannot use "*" in format string with "x"}
 test binary-15.2 {Tcl_BinaryObjCmd: format} {
     binary format axa "y" "z"
 } y\x00z
@@ -544,6 +599,18 @@ test binary-15.3 {Tcl_BinaryObjCmd: format} {
 test binary-15.4 {Tcl_BinaryObjCmd: format} {
     binary format a*X3x3a* "foo" "z"
 } \x00\x00\x00z
+test binary-15.5 {Tcl_BinaryObjCmd: format - bug #1923966} {
+    binary format x0s 1
+} \x01\x00
+test binary-15.6 {Tcl_BinaryObjCmd: format - bug #1923966} {
+    binary format x0ss 1 1
+} \x01\x00\x01\x00
+test binary-15.7 {Tcl_BinaryObjCmd: format - bug #1923966} {
+    binary format x1s 1
+} \x00\x01\x00
+test binary-15.8 {Tcl_BinaryObjCmd: format - bug #1923966} {
+    binary format x1ss 1 1
+} \x00\x01\x00\x01\x00
 
 test binary-16.1 {Tcl_BinaryObjCmd: format} {
     binary format a*X*a "foo" "z"
@@ -571,738 +638,840 @@ test binary-17.3 {Tcl_BinaryObjCmd: format} {
     binary format {a*  @0  a2 @* a*} "foobar" "ab" "blat"
 } abobarblat
 
-test binary-18.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format u0a3 abc abd} msg] $msg
-} {1 {bad field specifier "u"}}
+test binary-18.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format u0a3 abc abd
+} -result {bad field specifier "u"}
 
-
-test binary-19.1 {Tcl_BinaryObjCmd: errors} {
-    list [catch {binary s} msg] $msg
-} {1 {wrong # args: should be "binary scan value formatString ?varName varName ...?"}}
-test binary-19.2 {Tcl_BinaryObjCmd: errors} {
-    list [catch {binary scan foo} msg] $msg
-} {1 {wrong # args: should be "binary scan value formatString ?varName varName ...?"}}
+test binary-19.1 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
+    binary s
+} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
+test binary-19.2 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
+    binary scan foo
+} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
 test binary-19.3 {Tcl_BinaryObjCmd: scan} {
     binary scan {} {}
 } 0
 
-test binary-20.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc a} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-20.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-20.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc a
+} -result {not enough arguments for all format specifiers}
+test binary-20.2 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan abc a arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-20.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    binary scan abc a arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-20.3 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     set arg1 abc
     list [binary scan abc a0 arg1] $arg1
-} {1 {}}
-test binary-20.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 {}}
+test binary-20.4 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan abc a* arg1] $arg1
-} {1 abc}
-test binary-20.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 abc}
+test binary-20.5 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan abc a5 arg1] [info exists arg1]
-} {0 0}
+} -result {0 0}
 test binary-20.6 {Tcl_BinaryObjCmd: scan} {
     set arg1 foo
     list [binary scan abc a2 arg1] $arg1
 } {1 ab}
-test binary-20.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+test binary-20.7 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+    unset -nocomplain arg2
+} -body {
     list [binary scan abcdef a2a2 arg1 arg2] $arg1 $arg2
-} {2 ab cd}
-test binary-20.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {2 ab cd}
+test binary-20.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan abc a2 arg1(a)] $arg1(a)
-} {1 ab}
-test binary-20.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 ab}
+test binary-20.9 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan abc a arg1(a)] $arg1(a)
-} {1 a}
-
-test binary-21.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc A} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-21.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 a}
+
+test binary-21.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc A
+} -result {not enough arguments for all format specifiers}
+test binary-21.2 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan abc A arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-21.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    binary scan abc A arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-21.3 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     set arg1 abc
     list [binary scan abc A0 arg1] $arg1
-} {1 {}}
-test binary-21.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 {}}
+test binary-21.4 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan abc A* arg1] $arg1
-} {1 abc}
-test binary-21.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 abc}
+test binary-21.5 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan abc A5 arg1] [info exists arg1]
-} {0 0}
+} -result {0 0}
 test binary-21.6 {Tcl_BinaryObjCmd: scan} {
     set arg1 foo
     list [binary scan abc A2 arg1] $arg1
 } {1 ab}
-test binary-21.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+test binary-21.7 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+    unset -nocomplain arg2
+} -body {
     list [binary scan abcdef A2A2 arg1 arg2] $arg1 $arg2
-} {2 ab cd}
-test binary-21.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {2 ab cd}
+test binary-21.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan abc A2 arg1(a)] $arg1(a)
-} {1 ab}
-test binary-21.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 ab}
+test binary-21.9 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan abc A2 arg1(a)] $arg1(a)
-} {1 ab}
-test binary-21.10 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 ab}
+test binary-21.10 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan abc A arg1(a)] $arg1(a)
-} {1 a}
-test binary-21.11 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 a}
+test binary-21.11 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan "abc def \x00  " A* arg1] $arg1
-} {1 {abc def}}
-test binary-21.12 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+} -result {1 {abc def}}
+test binary-21.12 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -body {
     list [binary scan "abc def \x00ghi  " A* arg1] $arg1
-} [list 1 "abc def \x00ghi"]
+} -result [list 1 "abc def \x00ghi"]
 
-test binary-22.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc b} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-22.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc b
+} -result {not enough arguments for all format specifiers}
 test binary-22.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 b* arg1] $arg1
 } {1 0100101011001010}
 test binary-22.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x82\x53 b arg1] $arg1
 } {1 0}
 test binary-22.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x82\x53 b1 arg1] $arg1
 } {1 0}
 test binary-22.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x82\x53 b0 arg1] $arg1
 } {1 {}}
 test binary-22.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 b5 arg1] $arg1
 } {1 01001}
 test binary-22.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 b8 arg1] $arg1
 } {1 01001010}
 test binary-22.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 b14 arg1] $arg1
 } {1 01001010110010}
 test binary-22.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 b14 arg1] $arg1
 } {0 foo}
-test binary-22.10 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-22.10 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53 b1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-22.11 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1 arg2}
+    binary scan \x52\x53 b1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-22.11 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1 arg2
+} -body {
     set arg1 foo
     set arg2 bar
     list [binary scan \x07\x87\x05 b5b* arg1 arg2] $arg1 $arg2
-} {2 11100 1110000110100000}
+} -result {2 11100 1110000110100000}
 
-
-test binary-23.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc B} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-23.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc B
+} -result {not enough arguments for all format specifiers}
 test binary-23.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 B* arg1] $arg1
 } {1 0101001001010011}
 test binary-23.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x82\x53 B arg1] $arg1
 } {1 1}
 test binary-23.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x82\x53 B1 arg1] $arg1
 } {1 1}
 test binary-23.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 B0 arg1] $arg1
 } {1 {}}
 test binary-23.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 B5 arg1] $arg1
 } {1 01010}
 test binary-23.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 B8 arg1] $arg1
 } {1 01010010}
 test binary-23.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 B14 arg1] $arg1
 } {1 01010010010100}
 test binary-23.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 B14 arg1] $arg1
 } {0 foo}
-test binary-23.10 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-23.10 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53 B1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-23.11 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1 arg2}
+    binary scan \x52\x53 B1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-23.11 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1 arg2
+} -body {
     set arg1 foo
     set arg2 bar
     list [binary scan \x70\x87\x05 B5B* arg1 arg2] $arg1 $arg2
-} {2 01110 1000011100000101}
+} -result {2 01110 1000011100000101}
 
-test binary-24.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc h} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-24.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc h
+} -result {not enough arguments for all format specifiers}
 test binary-24.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 h* arg1] $arg1
 } {1 253a}
 test binary-24.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xc2\xa3 h arg1] $arg1
 } {1 2}
 test binary-24.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x82\x53 h1 arg1] $arg1
 } {1 2}
 test binary-24.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 h0 arg1] $arg1
 } {1 {}}
 test binary-24.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xf2\x53 h2 arg1] $arg1
 } {1 2f}
 test binary-24.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 h3 arg1] $arg1
 } {1 253}
 test binary-24.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 h3 arg1] $arg1
 } {0 foo}
-test binary-24.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-24.9 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53 h1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-24.10 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1 arg2}
+    binary scan \x52\x53 h1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-24.10 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1 arg2
+} -body {
     set arg1 foo
     set arg2 bar
     list [binary scan \x70\x87\x05 h2h* arg1 arg2] $arg1 $arg2
-} {2 07 7850}
+} -result {2 07 7850}
 
-test binary-25.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc H} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-25.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc H
+} -result {not enough arguments for all format specifiers}
 test binary-25.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 H* arg1] $arg1
 } {1 52a3}
 test binary-25.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xc2\xa3 H arg1] $arg1
 } {1 c}
 test binary-25.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x82\x53 H1 arg1] $arg1
 } {1 8}
 test binary-25.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 H0 arg1] $arg1
 } {1 {}}
 test binary-25.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xf2\x53 H2 arg1] $arg1
 } {1 f2}
 test binary-25.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\x53 H3 arg1] $arg1
 } {1 525}
 test binary-25.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 H3 arg1] $arg1
 } {0 foo}
-test binary-25.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-25.9 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53 H1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x52\x53 H1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-25.10 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x70\x87\x05 H2H* arg1 arg2] $arg1 $arg2
 } {2 70 8705}
 
-test binary-26.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc c} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-26.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc c
+} -result {not enough arguments for all format specifiers}
 test binary-26.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 c* arg1] $arg1
 } {1 {82 -93}}
 test binary-26.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 c arg1] $arg1
 } {1 82}
 test binary-26.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 c1 arg1] $arg1
 } {1 82}
 test binary-26.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 c0 arg1] $arg1
 } {1 {}}
 test binary-26.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 c2 arg1] $arg1
 } {1 {82 -93}}
 test binary-26.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xff c arg1] $arg1
 } {1 -1}
 test binary-26.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 c3 arg1] $arg1
 } {0 foo}
-test binary-26.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-26.9 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53 c1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x52\x53 c1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-26.10 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x70\x87\x05 c2c* arg1 arg2] $arg1 $arg2
 } {2 {112 -121} 5}
+test binary-26.11 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1
+    list [binary scan \x52\xa3 cu* arg1] $arg1
+} {1 {82 163}}
+test binary-26.12 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1
+    list [binary scan \x52\xa3 cu arg1] $arg1
+} {1 82}
+test binary-26.13 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1
+    list [binary scan \xff cu arg1] $arg1
+} {1 255}
+test binary-26.14 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x80 cuc arg1 arg2] $arg1 $arg2
+} {2 128 -128}
+test binary-26.15 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x80 ccu arg1 arg2] $arg1 $arg2
+} {2 -128 128}
 
-test binary-27.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc s} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-27.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc s
+} -result {not enough arguments for all format specifiers}
 test binary-27.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 s* arg1] $arg1
 } {1 {-23726 21587}}
 test binary-27.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 s arg1] $arg1
 } {1 -23726}
 test binary-27.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 s1 arg1] $arg1
 } {1 -23726}
 test binary-27.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 s0 arg1] $arg1
 } {1 {}}
 test binary-27.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 s2 arg1] $arg1
 } {1 {-23726 21587}}
 test binary-27.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 s1 arg1] $arg1
 } {0 foo}
-test binary-27.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-27.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53 s1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x52\x53 s1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-27.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x05 s2c* arg1 arg2] $arg1 $arg2
 } {2 {-23726 21587} 5}
+test binary-27.10 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1
+    list [binary scan \x52\xa3\x53\x54 su* arg1] $arg1
+} {1 {41810 21587}}
+test binary-27.11 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \xff\xff\xff\xff sus arg1 arg2] $arg1 $arg2
+} {2 65535 -1}
+test binary-27.12 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \xff\xff\xff\xff ssu arg1 arg2] $arg1 $arg2
+} {2 -1 65535}
 
-test binary-28.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc S} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-28.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc S
+} -result {not enough arguments for all format specifiers}
 test binary-28.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 S* arg1] $arg1
 } {1 {21155 21332}}
 test binary-28.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 S arg1] $arg1
 } {1 21155}
 test binary-28.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 S1 arg1] $arg1
 } {1 21155}
 test binary-28.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 S0 arg1] $arg1
 } {1 {}}
 test binary-28.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 S2 arg1] $arg1
 } {1 {21155 21332}}
 test binary-28.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 S1 arg1] $arg1
 } {0 foo}
-test binary-28.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-28.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53 S1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x52\x53 S1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-28.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x05 S2c* arg1 arg2] $arg1 $arg2
 } {2 {21155 21332} 5}
-
-test binary-29.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc i} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-28.10 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1
+    list [binary scan \x52\xa3\x53\x54 Su* arg1] $arg1
+} {1 {21155 21332}}
+test binary-28.11 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1
+    list [binary scan \xa3\x52\x54\x53 Su* arg1] $arg1
+} {1 {41810 21587}}
+
+test binary-29.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc i
+} -result {not enough arguments for all format specifiers}
 test binary-29.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i* arg1] $arg1
 } {1 {1414767442 67305985}}
 test binary-29.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i arg1] $arg1
 } {1 1414767442}
 test binary-29.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 i1 arg1] $arg1
 } {1 1414767442}
 test binary-29.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53 i0 arg1] $arg1
 } {1 {}}
 test binary-29.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 i2 arg1] $arg1
 } {1 {1414767442 67305985}}
 test binary-29.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 i1 arg1] $arg1
 } {0 foo}
-test binary-29.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-29.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53\x53\x54 i1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x52\x53\x53\x54 i1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-29.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 i2c* arg1 arg2] $arg1 $arg2
 } {2 {1414767442 67305985} 5}
-
-test binary-30.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc I} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-29.10 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iui arg1 arg2] $arg1 $arg2
+} {2 4294967295 -1}
+test binary-29.11 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff iiu arg1 arg2] $arg1 $arg2
+} {2 -1 4294967295}
+test binary-29.12 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 iuiu arg1 arg2] $arg1 $arg2
+} {2 128 2147483648}
+
+test binary-30.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc I
+} -result {not enough arguments for all format specifiers}
 test binary-30.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I* arg1] $arg1
 } {1 {1386435412 16909060}}
 test binary-30.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I arg1] $arg1
 } {1 1386435412}
 test binary-30.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 I1 arg1] $arg1
 } {1 1386435412}
 test binary-30.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53 I0 arg1] $arg1
 } {1 {}}
 test binary-30.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 I2 arg1] $arg1
 } {1 {1386435412 16909060}}
 test binary-30.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 I1 arg1] $arg1
 } {0 foo}
-test binary-30.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-30.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53\x53\x54 I1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x52\x53\x53\x54 I1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-30.9 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 I2c* arg1 arg2] $arg1 $arg2
 } {2 {1386435412 16909060} 5}
-
-test binary-31.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc f} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-30.10 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IuI arg1 arg2] $arg1 $arg2
+} {2 4294967295 -1}
+test binary-30.11 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff IIu arg1 arg2] $arg1 $arg2
+} {2 -1 4294967295}
+test binary-30.12 {Tcl_BinaryObjCmd: scan} {
+    unset -nocomplain arg1 arg2
+    list [binary scan \x80\x00\x00\x00\x00\x00\x00\x80 IuIu arg1 arg2] $arg1 $arg2
+} {2 2147483648 128}
+
+test binary-31.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc f
+} -result {not enough arguments for all format specifiers}
 test binary-31.2 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f* arg1] $arg1
 } {1 {1.600000023841858 3.4000000953674316}}
 test binary-31.3 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f* arg1] $arg1
 } {1 {1.600000023841858 3.4000000953674316}}
 test binary-31.4 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f arg1] $arg1
 } {1 1.600000023841858}
 test binary-31.5 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f arg1] $arg1
 } {1 1.600000023841858}
 test binary-31.6 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd f1 arg1] $arg1
 } {1 1.600000023841858}
 test binary-31.7 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f f1 arg1] $arg1
 } {1 1.600000023841858}
 test binary-31.8 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd f0 arg1] $arg1
 } {1 {}}
 test binary-31.9 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f f0 arg1] $arg1
 } {1 {}}
 test binary-31.10 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a f2 arg1] $arg1
 } {1 {1.600000023841858 3.4000000953674316}}
 test binary-31.11 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 f2 arg1] $arg1
 } {1 {1.600000023841858 3.4000000953674316}}
 test binary-31.12 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 f1 arg1] $arg1
 } {0 foo}
-test binary-31.13 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-31.13 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x3f\xcc\xcc\xcd f1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x3f\xcc\xcc\xcd f1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-31.14 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 f2c* arg1 arg2] $arg1 $arg2
 } {2 {1.600000023841858 3.4000000953674316} 5}
 test binary-31.15 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 f2c* arg1 arg2] $arg1 $arg2
 } {2 {1.600000023841858 3.4000000953674316} 5}
 
-test binary-32.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc d} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-32.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc d
+} -result {not enough arguments for all format specifiers}
 test binary-32.2 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d* arg1] $arg1
 } {1 {1.6 3.4}}
 test binary-32.3 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d* arg1] $arg1
 } {1 {1.6 3.4}}
 test binary-32.4 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d arg1] $arg1
 } {1 1.6}
 test binary-32.5 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d arg1] $arg1
 } {1 1.6}
 test binary-32.6 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1] $arg1
 } {1 1.6}
 test binary-32.7 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d1 arg1] $arg1
 } {1 1.6}
 test binary-32.8 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d0 arg1] $arg1
 } {1 {}}
 test binary-32.9 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f d0 arg1] $arg1
 } {1 {}}
 test binary-32.10 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 d2 arg1] $arg1
 } {1 {1.6 3.4}}
 test binary-32.11 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 d2 arg1] $arg1
 } {1 {1.6 3.4}}
 test binary-32.12 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 d1 arg1] $arg1
 } {0 foo}
-test binary-32.13 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-32.13 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a d1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-32.14 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 d2c* arg1 arg2] $arg1 $arg2
 } {2 {1.6 3.4} 5}
 test binary-32.15 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 d2c* arg1 arg2] $arg1 $arg2
 } {2 {1.6 3.4} 5}
 
 test binary-33.1 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+    unset -nocomplain arg1
+    unset -nocomplain arg2
     list [binary scan abcdefg a2xa3 arg1 arg2] $arg1 $arg2
 } {2 ab def}
 test binary-33.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+    unset -nocomplain arg1
+    unset -nocomplain arg2
     set arg2 foo
     list [binary scan abcdefg a3x*a3 arg1 arg2] $arg1 $arg2
 } {1 abc foo}
 test binary-33.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+    unset -nocomplain arg1
+    unset -nocomplain arg2
     set arg2 foo
     list [binary scan abcdefg a3x20a3 arg1 arg2] $arg1 $arg2
 } {1 abc foo}
 test binary-33.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+    unset -nocomplain arg1
+    unset -nocomplain arg2
     set arg2 foo
     list [binary scan abc a3x20a3 arg1 arg2] $arg1 $arg2
 } {1 abc foo}
 test binary-33.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abcdef x1a1 arg1] $arg1
 } {1 b}
 test binary-33.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abcdef x5a1 arg1] $arg1
 } {1 f}
 test binary-33.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abcdef x0a1 arg1] $arg1
 } {1 a}
 
 test binary-34.1 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+    unset -nocomplain arg1
+    unset -nocomplain arg2
     list [binary scan abcdefg a2Xa3 arg1 arg2] $arg1 $arg2
 } {2 ab bcd}
 test binary-34.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+    unset -nocomplain arg1
+    unset -nocomplain arg2
     set arg2 foo
     list [binary scan abcdefg a3X*a3 arg1 arg2] $arg1 $arg2
 } {2 abc abc}
 test binary-34.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+    unset -nocomplain arg1
+    unset -nocomplain arg2
     set arg2 foo
     list [binary scan abcdefg a3X20a3 arg1 arg2] $arg1 $arg2
 } {2 abc abc}
 test binary-34.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abc X20a3 arg1] $arg1
 } {1 abc}
 test binary-34.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abcdef x*X1a1 arg1] $arg1
 } {1 f}
 test binary-34.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abcdef x*X5a1 arg1] $arg1
 } {1 b}
 test binary-34.7 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abcdef x3X0a1 arg1] $arg1
 } {1 d}
 
-test binary-35.1 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
-    list [catch {binary scan abcdefg a2@a3 arg1 arg2} msg] $msg
-} {1 {missing count for "@" field specifier}}
+test binary-35.1 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+    unset -nocomplain arg2
+} -returnCodes error -body {
+    binary scan abcdefg a2@a3 arg1 arg2
+} -result {missing count for "@" field specifier}
 test binary-35.2 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+    unset -nocomplain arg1
+    unset -nocomplain arg2
     set arg2 foo
     list [binary scan abcdefg a3@*a3 arg1 arg2] $arg1 $arg2
 } {1 abc foo}
 test binary-35.3 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
-    catch {unset arg2}
+    unset -nocomplain arg1
+    unset -nocomplain arg2
     set arg2 foo
     list [binary scan abcdefg a3@20a3 arg1 arg2] $arg1 $arg2
 } {1 abc foo}
 test binary-35.4 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abcdef @2a3 arg1] $arg1
 } {1 cde}
 test binary-35.5 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abcdef x*@1a1 arg1] $arg1
 } {1 b}
 test binary-35.6 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan abcdef x*@0a1 arg1] $arg1
 } {1 a}
 
-test binary-36.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abcdef u0a3} msg] $msg
-} {1 {bad field specifier "u"}}
+test binary-36.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abcdef u0a3
+} -result {bad field specifier "u"}
 
-# GetFormatSpec is pretty thoroughly tested above, but there are a few
-# cases we should text explicitly
+# GetFormatSpec is pretty thoroughly tested above, but there are a few cases
+# we should text explicitly
 
 test binary-37.1 {GetFormatSpec: whitespace} {
     binary format "a3 a5     a3" foo barblat baz
@@ -1322,11 +1491,11 @@ test binary-37.5 {GetFormatSpec: whitespace} {
 test binary-37.6 {GetFormatSpec: whitespace} {
     binary format "     a3   " foo
 } foo
-test binary-37.7 {GetFormatSpec: numbers} {
-    list [catch {binary scan abcdef "x-1" foo} msg] $msg
-} {1 {bad field specifier "-"}}
+test binary-37.7 {GetFormatSpec: numbers} -returnCodes error -body {
+    binary scan abcdef "x-1" foo
+} -result {bad field specifier "-"}
 test binary-37.8 {GetFormatSpec: numbers} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan abcdef "a0x3" arg1] $arg1
 } {1 {}}
@@ -1364,82 +1533,99 @@ test binary-38.8 {FormatNumber: word alignment} littleEndian {
 } \x01\xcd\xcc\xcc\x3f
 
 test binary-39.1 {ScanNumber: sign extension} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 c2 arg1] $arg1
 } {1 {82 -93}}
 test binary-39.2 {ScanNumber: sign extension} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 s4 arg1] $arg1
 } {1 {513 -32511 386 -32127}}
 test binary-39.3 {ScanNumber: sign extension} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 S4 arg1] $arg1
 } {1 {258 385 -32255 -32382}}
 test binary-39.4 {ScanNumber: sign extension} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 i5 arg1] $arg1
 } {1 {33620225 16843137 16876033 25297153 -2130640639}}
 test binary-39.5 {ScanNumber: sign extension} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 I5 arg1] $arg1
 } {1 {16843010 -2130640639 25297153 16876033 16843137}}
-
-test binary-40.1 {ScanNumber: floating point overflow} {nonPortable bigEndian} {
-    catch {unset arg1}
+test binary-39.6 {ScanNumber: no sign extension} {
+    unset -nocomplain arg1
+    list [binary scan \x52\xa3 cu2 arg1] $arg1
+} {1 {82 163}}
+test binary-39.7 {ScanNumber: no sign extension} {
+    unset -nocomplain arg1
+    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 su4 arg1] $arg1
+} {1 {513 33025 386 33409}}
+test binary-39.8 {ScanNumber: no sign extension} {
+    unset -nocomplain arg1
+    list [binary scan \x01\x02\x01\x81\x82\x01\x81\x82 Su4 arg1] $arg1
+} {1 {258 385 33281 33154}}
+test binary-39.9 {ScanNumber: no sign extension} {
+    unset -nocomplain arg1
+    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 iu5 arg1] $arg1
+} {1 {33620225 16843137 16876033 25297153 2164326657}}
+test binary-39.10 {ScanNumber: no sign extension} {
+    unset -nocomplain arg1
+    list [binary scan \x01\x01\x01\x02\x81\x01\x01\x01\x01\x82\x01\x01\x01\x01\x82\x01\x01\x01\x01\x81 Iu5 arg1] $arg1
+} {1 {16843010 2164326657 25297153 16876033 16843137}}
+
+test binary-40.3 {ScanNumber: NaN} -body {
+    unset -nocomplain arg1
     list [binary scan \xff\xff\xff\xff f1 arg1] $arg1
-} {1 -NaN}
-test binary-40.3 {ScanNumber: floating point overflow} {littleEndian win} {
-    catch {unset arg1}
-    set result [binary scan \xff\xff\xff\xff f1 arg1]
-    lappend result [regexp -nocase NaN $arg1]
-} {1 1}
-test binary-40.4 {ScanNumber: floating point overflow} {nonPortable bigEndian} {
-    catch {unset arg1}
-    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1] $arg1
-} {1 -NaN}
-test binary-40.6 {ScanNumber: floating point overflow} {littleEndian win} {
-    catch {unset arg1}
-    set result [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d1 arg1]
-    lappend result [regexp -nocase NaN $arg1]
-} {1 1}
-
-test binary-41.1 {ScanNumber: word alignment} {
-    catch {unset arg1; unset arg2}
+} -match glob -result {1 -NaN*}
+test binary-40.4 {ScanNumber: NaN} -body {
+    unset -nocomplain arg1
+    list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
+} -match glob -result {1 -NaN*}
+
+test binary-41.1 {ScanNumber: word alignment} -setup {
+    unset -nocomplain arg1 arg2
+} -body {
     list [binary scan \x01\x01\x00 c1s1 arg1 arg2] $arg1 $arg2
-} {2 1 1}
-test binary-41.2 {ScanNumber: word alignment} {
-    catch {unset arg1; unset arg2}
+} -result {2 1 1}
+test binary-41.2 {ScanNumber: word alignment} -setup {
+    unset -nocomplain arg1 arg2
+} -body {
     list [binary scan \x01\x00\x01 c1S1 arg1 arg2] $arg1 $arg2
-} {2 1 1}
-test binary-41.3 {ScanNumber: word alignment} {
-    catch {unset arg1; unset arg2}
+} -result {2 1 1}
+test binary-41.3 {ScanNumber: word alignment} -setup {
+    unset -nocomplain arg1 arg2
+} -body {
     list [binary scan \x01\x01\x00\x00\x00 c1i1 arg1 arg2] $arg1 $arg2
-} {2 1 1}
-test binary-41.4 {ScanNumber: word alignment} {
-    catch {unset arg1; unset arg2}
+} -result {2 1 1}
+test binary-41.4 {ScanNumber: word alignment} -setup {
+    unset -nocomplain arg1 arg2
+} -body {
     list [binary scan \x01\x00\x00\x00\x01 c1I1 arg1 arg2] $arg1 $arg2
-} {2 1 1}
-test binary-41.5 {ScanNumber: word alignment} bigEndian {
-    catch {unset arg1; unset arg2}
+} -result {2 1 1}
+test binary-41.5 {ScanNumber: word alignment} -setup {
+    unset -nocomplain arg1 arg2
+} -constraints bigEndian -body {
     list [binary scan \x01\x3f\xcc\xcc\xcd c1f1 arg1 arg2] $arg1 $arg2
-} {2 1 1.600000023841858}
-test binary-41.6 {ScanNumber: word alignment} littleEndian {
-    catch {unset arg1; unset arg2}
+} -result {2 1 1.600000023841858}
+test binary-41.6 {ScanNumber: word alignment} -setup {
+    unset -nocomplain arg1 arg2
+} -constraints littleEndian -body {
     list [binary scan \x01\xcd\xcc\xcc\x3f c1f1 arg1 arg2] $arg1 $arg2
-} {2 1 1.600000023841858}
-test binary-41.7 {ScanNumber: word alignment} bigEndian {
-    catch {unset arg1; unset arg2}
+} -result {2 1 1.600000023841858}
+test binary-41.7 {ScanNumber: word alignment} -setup {
+    unset -nocomplain arg1 arg2
+} -constraints bigEndian -body {
     list [binary scan \x01\x3f\xf9\x99\x99\x99\x99\x99\x9a c1d1 arg1 arg2] $arg1 $arg2
-} {2 1 1.6}
-test binary-41.8 {ScanNumber: word alignment} littleEndian {
-    catch {unset arg1; unset arg2}
+} -result {2 1 1.6}
+test binary-41.8 {ScanNumber: word alignment} -setup {
+    unset -nocomplain arg1 arg2
+} -constraints littleEndian -body {
     list [binary scan \x01\x9a\x99\x99\x99\x99\x99\xf9\x3f c1d1 arg1 arg2] $arg1 $arg2
-} {2 1 1.6}
+} -result {2 1 1.6}
 
-test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} {} {
-    catch {binary ""} result
-    set result
-} {bad option "": must be format or scan}
+test binary-42.1 {Tcl_BinaryObjCmd: bad arguments} -constraints {} -body {
+    binary ?
+} -returnCodes error -match glob -result {unknown or ambiguous subcommand "?": *}
 
 # Wide int (guaranteed at least 64-bit) handling
 test binary-43.1 {Tcl_BinaryObjCmd: format wide int} {} {
@@ -1465,6 +1651,26 @@ test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
     binary scan [binary format W [expr {wide(3) << 31}]] W x
     set x
 } 6442450944
+test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
+    unset -nocomplain arg1
+    list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
+} {1 -9223372036854775808}
+test binary-43.6 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+    unset -nocomplain arg1
+    list [binary scan \x80[string repeat \x00 7] Wu arg1] $arg1
+} {1 9223372036854775808}
+test binary-43.7 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+    unset -nocomplain arg1
+    list [binary scan [string repeat \x00 7]\x80 wu arg1] $arg1
+} {1 9223372036854775808}
+test binary-43.8 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+    unset -nocomplain arg1 arg2
+    list [binary scan \x80[string repeat \x00 7]\x80[string repeat \x00 7] WuW arg1 arg2] $arg1 $arg2
+} {2 9223372036854775808 -9223372036854775808}
+test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
+    unset -nocomplain arg1 arg2
+    list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
+} {2 9223372036854775808 -9223372036854775808}
 
 test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
     binary scan [binary format sws 16450 -1 19521] c* x
@@ -1498,22 +1704,22 @@ test binary-46.5 {Tcl_BinaryObjCmd: handling of non-ISO8859-1 chars} {
 } "1 \u00a4 \u20ac"
 
 test binary-47.1 {Tcl_BinaryObjCmd: number cache reference count handling} {
-    # This test is only reliable when memory debugging is turned on,
-    # but without even memory debugging it should still generate the
-    # expected answers and might therefore still pick up memory corruption
-    # caused by [Bug 851747].
+    # This test is only reliable when memory debugging is turned on, but
+    # without even memory debugging it should still generate the expected
+    # answers and might therefore still pick up memory corruption caused by
+    # [Bug 851747].
     list [binary scan aba ccc x x x] $x
 } {3 97}
 
 ### TIP#129: endian specifiers ----
 
 # format t
-test binary-48.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format t} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-48.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format t blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-48.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format t
+} -result {not enough arguments for all format specifiers}
+test binary-48.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format t blat
+} -result {expected integer but got "blat"}
 test binary-48.3 {Tcl_BinaryObjCmd: format} {
     binary format S0 0x50
 } {}
@@ -1541,10 +1747,10 @@ test binary-48.10 {Tcl_BinaryObjCmd: format} bigEndian {
 test binary-48.11 {Tcl_BinaryObjCmd: format} littleEndian {
     binary format t2 {0x50 0x52}
 } P\x00R\x00
-test binary-48.12 {Tcl_BinaryObjCmd: format}  bigEndian {
+test binary-48.12 {Tcl_BinaryObjCmd: format} bigEndian {
     binary format t* {0x5051 0x52}
 } PQ\x00R
-test binary-48.13 {Tcl_BinaryObjCmd: format}  littleEndian {
+test binary-48.13 {Tcl_BinaryObjCmd: format} littleEndian {
     binary format t* {0x5051 0x52}
 } QPR\x00
 test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian {
@@ -1553,13 +1759,13 @@ test binary-48.14 {Tcl_BinaryObjCmd: format} bigEndian {
 test binary-48.15 {Tcl_BinaryObjCmd: format} littleEndian {
     binary format t2 {0x50 0x52 0x53} 0x54
 } P\x00R\x00
-test binary-48.16 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format t2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-48.17 {Tcl_BinaryObjCmd: format} {
+test binary-48.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format t2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-48.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {0x50 0x51}
-    list [catch {binary format t $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+    binary format t $a
+} -result "expected integer but got \"0x50 0x51\""
 test binary-48.18 {Tcl_BinaryObjCmd: format} bigEndian {
     set a {0x50 0x51}
     binary format t1 $a
@@ -1570,12 +1776,12 @@ test binary-48.19 {Tcl_BinaryObjCmd: format} littleEndian {
 } P\x00
 
 # format n
-test binary-49.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format n} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-49.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format n blat} msg] $msg
-} {1 {expected integer but got "blat"}}
+test binary-49.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format n
+} -result {not enough arguments for all format specifiers}
+test binary-49.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format n blat
+} -result {expected integer but got "blat"}
 test binary-49.3 {Tcl_BinaryObjCmd: format} {
     binary format n0 0x50
 } {}
@@ -1600,13 +1806,13 @@ test binary-49.9 {Tcl_BinaryObjCmd: format} littleEndian {
 test binary-49.10 {Tcl_BinaryObjCmd: format} littleEndian {
     binary format n* {0x50515253 0x52}
 } SRQPR\x00\x00\x00
-test binary-49.11 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format n2 {0x50}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-49.12 {Tcl_BinaryObjCmd: format} {
+test binary-49.11 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format n2 {0x50}
+} -result {number of elements in list does not match count}
+test binary-49.12 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {0x50 0x51}
-    list [catch {binary format n $a} msg] $msg
-} [list 1 "expected integer but got \"0x50 0x51\""]
+    binary format n $a
+} -result "expected integer but got \"0x50 0x51\""
 test binary-49.13 {Tcl_BinaryObjCmd: format} littleEndian {
     set a {0x50 0x51}
     binary format n1 $a
@@ -1649,14 +1855,13 @@ test binary-50.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
     set x
 } 6442450944
 
-
 # format Q/q
-test binary-51.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format Q} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-51.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format q blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-51.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format Q
+} -result {not enough arguments for all format specifiers}
+test binary-51.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format q blat
+} -result {expected floating-point number but got "blat"}
 test binary-51.3 {Tcl_BinaryObjCmd: format} {
     binary format q0 1.6
 } {}
@@ -1684,19 +1889,13 @@ test binary-51.10 {Tcl_BinaryObjCmd: format} {} {
 test binary-51.11 {Tcl_BinaryObjCmd: format} {} {
     binary format q2 {1.6 3.4 5.6}
 } \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40
-test binary-51.12 {Tcl_BinaryObjCmd: float overflow} {nonPortable bigEndian} {
-    binary format Q NaN
-} \x7f\xff\xff\xff\xff\xff\xff\xff
-test binary-51.13 {Tcl_BinaryObjCmd: float overflow} {nonPortable mac} {
-    binary format Q NaN
-} \x7f\xf8\x02\xa0\x00\x00\x00\x00
-test binary-51.14 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format q2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-51.15 {Tcl_BinaryObjCmd: format} {
+test binary-51.14 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format q2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-51.15 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {1.6 3.4}
-    list [catch {binary format q $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+    binary format q $a
+} -result "expected floating-point number but got \"1.6 3.4\""
 test binary-51.16 {Tcl_BinaryObjCmd: format} {} {
     set a {1.6 3.4}
     binary format Q1 $a
@@ -1707,12 +1906,12 @@ test binary-51.17 {Tcl_BinaryObjCmd: format} {} {
 } \x9a\x99\x99\x99\x99\x99\xf9\x3f
 
 # format R/r
-test binary-53.1 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format r} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-53.2 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format r blat} msg] $msg
-} {1 {expected floating-point number but got "blat"}}
+test binary-53.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format r
+} -result {not enough arguments for all format specifiers}
+test binary-53.2 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format r blat
+} -result {expected floating-point number but got "blat"}
 test binary-53.3 {Tcl_BinaryObjCmd: format} {
     binary format f0 1.6
 } {}
@@ -1752,13 +1951,13 @@ test binary-53.14 {Tcl_BinaryObjCmd: float underflow} {} {
 test binary-53.15 {Tcl_BinaryObjCmd: float underflow} {} {
     binary format r -3.402825e-100
 } \x00\x00\x00\x80
-test binary-53.16 {Tcl_BinaryObjCmd: format} {
-    list [catch {binary format r2 {1.6}} msg] $msg
-} {1 {number of elements in list does not match count}}
-test binary-53.17 {Tcl_BinaryObjCmd: format} {
+test binary-53.16 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
+    binary format r2 {1.6}
+} -result {number of elements in list does not match count}
+test binary-53.17 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
     set a {1.6 3.4}
-    list [catch {binary format r $a} msg] $msg
-} [list 1 "expected floating-point number but got \"1.6 3.4\""]
+    binary format r $a
+} -result "expected floating-point number but got \"1.6 3.4\""
 test binary-53.18 {Tcl_BinaryObjCmd: format} {} {
     set a {1.6 3.4}
     binary format R1 $a
@@ -1769,298 +1968,352 @@ test binary-53.19 {Tcl_BinaryObjCmd: format} {} {
 } \xcd\xcc\xcc\x3f
 
 # scan t (s)
-test binary-54.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc t} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-54.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc t
+} -result {not enough arguments for all format specifiers}
 test binary-54.2 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
 } {1 {-23726 21587}}
 test binary-54.3 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
 } {1 -23726}
 test binary-54.4 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 t1 arg1] $arg1
 } {1 -23726}
 test binary-54.5 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 t0 arg1] $arg1
 } {1 {}}
 test binary-54.6 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
 } {1 {-23726 21587}}
 test binary-54.7 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 t1 arg1] $arg1
 } {0 foo}
-test binary-54.8 {Tcl_BinaryObjCmd: scan} {} {
-    catch {unset arg1}
+test binary-54.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x52\x53 t1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-54.9 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
 } {2 {-23726 21587} 5}
+test binary-54.10 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x00\x80\x00\x80 tut arg1 arg2] $arg1 $arg2
+} {2 32768 -32768}
+test binary-54.11 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x00\x80\x00\x80 ttu arg1 arg2] $arg1 $arg2
+} {2 -32768 32768}
 
 # scan t (b)
-test binary-55.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc t} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-55.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc t
+} -result {not enough arguments for all format specifiers}
+test binary-55.2 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 t* arg1] $arg1
 } {1 {21155 21332}}
-test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-55.3 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 t arg1] $arg1
 } {1 21155}
-test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-55.4 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 t1 arg1] $arg1
 } {1 21155}
-test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-55.5 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3 t0 arg1] $arg1
 } {1 {}}
-test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-55.6 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 t2 arg1] $arg1
 } {1 {21155 21332}}
-test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-55.7 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 t1 arg1] $arg1
 } {0 foo}
-test binary-55.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-55.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53 t1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1 arg2}
+    binary scan \x52\x53 t1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-55.9 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x05 t2c* arg1 arg2] $arg1 $arg2
 } {2 {21155 21332} 5}
+test binary-55.10 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x00\x80\x00 tut arg1 arg2] $arg1 $arg2
+} {2 32768 -32768}
+test binary-55.11 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x00\x80\x00 ttu arg1 arg2] $arg1 $arg2
+} {2 -32768 32768}
 
 # scan n (s)
-test binary-56.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc n} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-56.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc n
+} -result {not enough arguments for all format specifiers}
 test binary-56.2 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
 } {1 {1414767442 67305985}}
-test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian  {
-    catch {unset arg1}
+test binary-56.3 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
 } {1 1414767442}
-test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian  {
-    catch {unset arg1}
+test binary-56.4 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
 } {1 1414767442}
-test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian  {
-    catch {unset arg1}
+test binary-56.5 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53 n0 arg1] $arg1
 } {1 {}}
-test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian  {
-    catch {unset arg1}
+test binary-56.6 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
 } {1 {1414767442 67305985}}
-test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian  {
-    catch {unset arg1}
+test binary-56.7 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 n1 arg1] $arg1
 } {0 foo}
-test binary-56.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-56.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian  {
-    catch {unset arg1 arg2}
+    binary scan \x52\x53\x53\x54 n1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-56.9 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
 } {2 {1414767442 67305985} 5}
+test binary-56.10 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
+} {2 128 128}
+test binary-56.11 {Tcl_BinaryObjCmd: scan} littleEndian {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
+} {2 2147483648 -2147483648}
 
 # scan n (b)
-test binary-57.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc n} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
-test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-57.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc n
+} -result {not enough arguments for all format specifiers}
+test binary-57.2 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n* arg1] $arg1
 } {1 {1386435412 16909060}}
-test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-57.3 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n arg1] $arg1
 } {1 1386435412}
-test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-57.4 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54 n1 arg1] $arg1
 } {1 1386435412}
-test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-57.5 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53 n0 arg1] $arg1
 } {1 {}}
-test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-57.6 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04 n2 arg1] $arg1
 } {1 {1386435412 16909060}}
-test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1}
+test binary-57.7 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 n1 arg1] $arg1
 } {0 foo}
-test binary-57.8 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-57.8 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x52\x53\x53\x54 n1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
-test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian  {
-    catch {unset arg1 arg2}
+    binary scan \x52\x53\x53\x54 n1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
+test binary-57.9 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x52\xa3\x53\x54\x01\x02\x03\x04\x05 n2c* arg1 arg2] $arg1 $arg2
 } {2 {1386435412 16909060} 5}
+test binary-57.10 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x80\x00\x00\x00\x80\x00\x00\x00 nun arg1 arg2] $arg1 $arg2
+} {2 2147483648 -2147483648}
+test binary-57.11 {Tcl_BinaryObjCmd: scan} bigEndian {
+    unset -nocomplain arg1 arg2
+    set arg1 foo
+    set arg2 bar
+    list [binary scan \x00\x00\x00\x80\x00\x00\x00\x80 nun arg1 arg2] $arg1 $arg2
+} {2 128 128}
 
 # scan Q/q
-test binary-58.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc q} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-58.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc q
+} -result {not enough arguments for all format specifiers}
 test binary-58.2 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q* arg1] $arg1
 } {1 {1.6 3.4}}
 test binary-58.3 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q* arg1] $arg1
 } {1 {1.6 3.4}}
 test binary-58.4 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q arg1] $arg1
 } {1 1.6}
 test binary-58.5 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q arg1] $arg1
 } {1 1.6}
 test binary-58.6 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q1 arg1] $arg1
 } {1 1.6}
 test binary-58.7 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q1 arg1] $arg1
 } {1 1.6}
 test binary-58.8 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a Q0 arg1] $arg1
 } {1 {}}
 test binary-58.9 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f q0 arg1] $arg1
 } {1 {}}
 test binary-58.10 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33 Q2 arg1] $arg1
 } {1 {1.6 3.4}}
 test binary-58.11 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40 q2 arg1] $arg1
 } {1 {1.6 3.4}}
 test binary-58.12 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 q1 arg1] $arg1
 } {0 foo}
-test binary-58.13 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-58.13 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a q1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-58.14 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x3f\xf9\x99\x99\x99\x99\x99\x9a\x40\x0b\x33\x33\x33\x33\x33\x33\x05 Q2c* arg1 arg2] $arg1 $arg2
 } {2 {1.6 3.4} 5}
 test binary-58.15 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x9a\x99\x99\x99\x99\x99\xf9\x3f\x33\x33\x33\x33\x33\x33\x0b\x40\x05 q2c* arg1 arg2] $arg1 $arg2
 } {2 {1.6 3.4} 5}
 
 # scan R/r
-test binary-59.1 {Tcl_BinaryObjCmd: scan} {
-    list [catch {binary scan abc r} msg] $msg
-} {1 {not enough arguments for all format specifiers}}
+test binary-59.1 {Tcl_BinaryObjCmd: scan} -returnCodes error -body {
+    binary scan abc r
+} -result {not enough arguments for all format specifiers}
 test binary-59.2 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R* arg1] $arg1
 } {1 {1.600000023841858 3.4000000953674316}}
 test binary-59.3 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r* arg1] $arg1
 } {1 {1.600000023841858 3.4000000953674316}}
 test binary-59.4 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R arg1] $arg1
 } {1 1.600000023841858}
 test binary-59.5 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r arg1] $arg1
 } {1 1.600000023841858}
 test binary-59.6 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd R1 arg1] $arg1
 } {1 1.600000023841858}
 test binary-59.7 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f r1 arg1] $arg1
 } {1 1.600000023841858}
 test binary-59.8 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd R0 arg1] $arg1
 } {1 {}}
 test binary-59.9 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f r0 arg1] $arg1
 } {1 {}}
 test binary-59.10 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a R2 arg1] $arg1
 } {1 {1.600000023841858 3.4000000953674316}}
 test binary-59.11 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1}
+    unset -nocomplain arg1
     list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40 r2 arg1] $arg1
 } {1 {1.600000023841858 3.4000000953674316}}
 test binary-59.12 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+    unset -nocomplain arg1
     set arg1 foo
     list [binary scan \x52 r1 arg1] $arg1
 } {0 foo}
-test binary-59.13 {Tcl_BinaryObjCmd: scan} {
-    catch {unset arg1}
+test binary-59.13 {Tcl_BinaryObjCmd: scan} -setup {
+    unset -nocomplain arg1
+} -returnCodes error -body {
     set arg1 1
-    list [catch {binary scan \x3f\xcc\xcc\xcd r1 arg1(a)} msg] $msg
-} {1 {can't set "arg1(a)": variable isn't array}}
+    binary scan \x3f\xcc\xcc\xcd r1 arg1(a)
+} -result {can't set "arg1(a)": variable isn't array}
 test binary-59.14 {Tcl_BinaryObjCmd: scan} bigEndian {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \x3f\xcc\xcc\xcd\x40\x59\x99\x9a\x05 R2c* arg1 arg2] $arg1 $arg2
 } {2 {1.600000023841858 3.4000000953674316} 5}
 test binary-59.15 {Tcl_BinaryObjCmd: scan} littleEndian {
-    catch {unset arg1 arg2}
+    unset -nocomplain arg1 arg2
     set arg1 foo
     set arg2 bar
     list [binary scan \xcd\xcc\xcc\x3f\x9a\x99\x59\x40\x05 r2c* arg1 arg2] $arg1 $arg2
@@ -2081,7 +2334,7 @@ test binary-61.2 {Tcl_BinaryObjCmd: scan wide int} littleEndian {
     binary scan lcTolleH m x
     set x
 } 5216694956358656876
-test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set}  littleEndian {
+test binary-61.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} littleEndian {
     binary scan [binary format w [expr {wide(3) << 31}]] m x
     set x
 } 6442450944
@@ -2090,7 +2343,507 @@ test binary-61.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} bigEndian {
     set x
 } 6442450944
 
-
+# scan/format infinities
+
+test binary-62.1 {infinity} ieeeFloatingPoint {
+    binary scan [binary format q Infinity] w w
+    format 0x%016lx $w
+} 0x7ff0000000000000
+test binary-62.2 {infinity} ieeeFloatingPoint {
+    binary scan [binary format q -Infinity] w w
+    format 0x%016lx $w
+} 0xfff0000000000000
+test binary-62.3 {infinity} ieeeFloatingPoint {
+    binary scan [binary format q Inf] w w
+    format 0x%016lx $w
+} 0x7ff0000000000000
+test binary-62.4 {infinity} ieeeFloatingPoint {
+    binary scan [binary format q -Infinity] w w
+    format 0x%016lx $w
+} 0xfff0000000000000
+test binary-62.5 {infinity} ieeeFloatingPoint {
+    binary scan [binary format w 0x7ff0000000000000] q d
+    set d
+} Inf
+test binary-62.6 {infinity} ieeeFloatingPoint {
+    binary scan [binary format w 0xfff0000000000000] q d
+    set d
+} -Inf
+
+# scan/format Not-a-Number
+
+test binary-63.1 {NaN} ieeeFloatingPoint {
+    binary scan [binary format q NaN] w w
+    format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0x7ff0000000000000
+test binary-63.2 {NaN} ieeeFloatingPoint {
+    binary scan [binary format q -NaN] w w
+    format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0xfff0000000000000
+test binary-63.3 {NaN} ieeeFloatingPoint {
+    binary scan [binary format q NaN(3123456789aBc)] w w
+    format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0x7ff3123456789abc
+test binary-63.4 {NaN} ieeeFloatingPoint {
+    binary scan [binary format q {NaN( 3123456789aBc)}] w w
+    format 0x%016lx [expr {$w & 0xfff3ffffffffffff}]
+} 0x7ff3123456789abc
+
+# Make sure TclParseNumber() rejects invalid nan-hex formats [Bug 3402540]
+test binary-63.5 {NaN} -constraints ieeeFloatingPoint -body {
+    binary format q Nan(
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.6 {NaN} -constraints ieeeFloatingPoint -body {
+    binary format q Nan()
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.7 {NaN} -constraints ieeeFloatingPoint -body {
+    binary format q Nan(g)
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.8 {NaN} -constraints ieeeFloatingPoint -body {
+    binary format q Nan(1,2)
+} -returnCodes error -match glob -result {expected floating-point number*}
+test binary-63.9 {NaN} -constraints ieeeFloatingPoint -body {
+    binary format q Nan(1234567890abcd)
+} -returnCodes error -match glob -result {expected floating-point number*}
+
+test binary-64.1 {NaN} -constraints ieeeFloatingPoint -body {
+    binary scan [binary format w 0x7ff8000000000000] q d
+    set d
+} -match glob -result NaN*
+test binary-64.2 {NaN} -constraints ieeeFloatingPoint -body {
+    binary scan [binary format w 0x7ff0123456789aBc] q d
+    set d
+} -match glob -result NaN(*123456789abc)
+
+test binary-65.1 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fcfffffffffffff] q d
+    set d
+} 0.24999999999999997
+test binary-65.2 {smallest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fd0000000000000] q d
+    set d
+} 0.25
+test binary-65.3 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fdfffffffffffff] q d
+    set d
+} 0.49999999999999994
+test binary-65.4 {smallest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fe0000000000000] q d
+    set d
+} 0.5
+test binary-65.5 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x3fffffffffffffff] q d
+    set d
+} 1.9999999999999998
+test binary-65.6 {smallest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x4000000000000000] q d
+    set d
+} 2.0
+test binary-65.7 {smallest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x434fffffffffffff] q d
+    set d
+} 18014398509481982.0
+test binary-65.8 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x4350000000000000] q d
+    set d
+} 18014398509481984.0
+test binary-65.9 {largest significand} ieeeFloatingPoint {
+    binary scan [binary format w 0x4350000000000001] q d
+    set d
+} 18014398509481988.0
+
+test binary-70.1 {binary encode hex} -body {
+    binary encode hex
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-70.2 {binary encode hex} -body {
+    binary encode hex a
+} -result {61}
+test binary-70.3 {binary encode hex} -body {
+    binary encode hex {}
+} -result {}
+test binary-70.4 {binary encode hex} -body {
+    binary encode hex [string repeat a 20]
+} -result [string repeat 61 20]
+test binary-70.5 {binary encode hex} -body {
+    binary encode hex \0\1\2\3\4\0\1\2\3\4
+} -result {00010203040001020304}
+
+test binary-71.1 {binary decode hex} -body {
+    binary decode hex
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-71.2 {binary decode hex} -body {
+    binary decode hex 61
+} -result {a}
+test binary-71.3 {binary decode hex} -body {
+    binary decode hex {}
+} -result {}
+test binary-71.4 {binary decode hex} -body {
+    binary decode hex [string repeat 61 20]
+} -result [string repeat a 20]
+test binary-71.5 {binary decode hex} -body {
+    binary decode hex 00010203040001020304
+} -result "\0\1\2\3\4\0\1\2\3\4"
+test binary-71.6 {binary decode hex} -body {
+    binary decode hex "61 61"
+} -result {aa}
+test binary-71.7 {binary decode hex} -body {
+    binary decode hex "61\n\n\n61"
+} -result {aa}
+test binary-71.8 {binary decode hex} -body {
+    binary decode hex -strict "61 61"
+} -returnCodes error -result {invalid hexadecimal digit " " at position 2}
+test binary-71.9 {binary decode hex} -body {
+    set r [binary decode hex "6"]
+    list [string length $r] $r
+} -result {0 {}}
+test binary-71.10 {binary decode hex} -body {
+    string length [binary decode hex " "]
+} -result 0
+test binary-71.11 {binary decode hex: Bug b98fa55285} -body {
+    apply {{} {
+	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c26\n"
+	set decoded [binary decode hex $str]
+	list [string length $decoded] [scan [string index $decoded end] %c]
+    }}
+} -result {29 38}
+test binary-71.12 {binary decode hex: Bug b98fa55285 cross check} -body {
+    apply {{} {
+	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n"
+	set decoded [binary decode hex $str]
+	list [string length $decoded] [scan [string index $decoded end] %c]
+    }}
+} -result {28 140}
+test binary-71.13 {binary decode hex: Bug b98fa55285 cross check} -body {
+    apply {{} {
+	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n"
+	set decoded [binary decode hex $str]
+	list [string length $decoded] [scan [string index $decoded end] %c]
+    }}
+} -result {28 140}
+test binary-71.14 {binary decode hex: Bug b98fa55285 cross check} -body {
+    apply {{} {
+	set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n\n"
+	set decoded [binary decode hex $str]
+	list [string length $decoded] [scan [string index $decoded end] %c]
+    }}
+} -result {28 140}
+
+test binary-72.1 {binary encode base64} -body {
+    binary encode base64
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-72.2 {binary encode base64} -body {
+    binary encode base64 abc
+} -result {YWJj}
+test binary-72.3 {binary encode base64} -body {
+    binary encode base64 {}
+} -result {}
+test binary-72.4 {binary encode base64} -body {
+    binary encode base64 [string repeat abc 20]
+} -result [string repeat YWJj 20]
+test binary-72.5 {binary encode base64} -body {
+    binary encode base64 \0\1\2\3\4\0\1\2\3
+} -result {AAECAwQAAQID}
+test binary-72.6 {binary encode base64} -body {
+    binary encode base64 \0
+} -result {AA==}
+test binary-72.7 {binary encode base64} -body {
+    binary encode base64 \0\0
+} -result {AAA=}
+test binary-72.8 {binary encode base64} -body {
+    binary encode base64 \0\0\0
+} -result {AAAA}
+test binary-72.9 {binary encode base64} -body {
+    binary encode base64 \0\0\0\0
+} -result {AAAAAA==}
+test binary-72.10 {binary encode base64} -body {
+    binary encode base64 -maxlen 0 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJj}
+test binary-72.11 {binary encode base64} -body {
+    binary encode base64 -maxlen 1 -wrapchar : abcabcabc
+} -result {Y:W:J:j:Y:W:J:j:Y:W:J:j}
+test binary-72.12 {binary encode base64} -body {
+    binary encode base64 -maxlen 2 -wrapchar : abcabcabc
+} -result {YW:Jj:YW:Jj:YW:Jj}
+test binary-72.13 {binary encode base64} -body {
+    binary encode base64 -maxlen 3 -wrapchar : abcabcabc
+} -result {YWJ:jYW:JjY:WJj}
+test binary-72.14 {binary encode base64} -body {
+    binary encode base64 -maxlen 4 -wrapchar : abcabcabc
+} -result {YWJj:YWJj:YWJj}
+test binary-72.15 {binary encode base64} -body {
+    binary encode base64 -maxlen 5 -wrapchar : abcabcabc
+} -result {YWJjY:WJjYW:Jj}
+test binary-72.16 {binary encode base64} -body {
+    binary encode base64 -maxlen 6 -wrapchar : abcabcabc
+} -result {YWJjYW:JjYWJj}
+test binary-72.17 {binary encode base64} -body {
+    binary encode base64 -maxlen 7 -wrapchar : abcabcabc
+} -result {YWJjYWJ:jYWJj}
+test binary-72.18 {binary encode base64} -body {
+    binary encode base64 -maxlen 8 -wrapchar : abcabcabc
+} -result {YWJjYWJj:YWJj}
+test binary-72.19 {binary encode base64} -body {
+    binary encode base64 -maxlen 9 -wrapchar : abcabcabc
+} -result {YWJjYWJjY:WJj}
+test binary-72.20 {binary encode base64} -body {
+    binary encode base64 -maxlen 10 -wrapchar : abcabcabc
+} -result {YWJjYWJjYW:Jj}
+test binary-72.21 {binary encode base64} -body {
+    binary encode base64 -maxlen 11 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJ:j}
+test binary-72.22 {binary encode base64} -body {
+    binary encode base64 -maxlen 12 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJj}
+test binary-72.23 {binary encode base64} -body {
+    binary encode base64 -maxlen 13 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJj}
+test binary-72.24 {binary encode base64} -body {
+    binary encode base64 -maxlen 60 -wrapchar : abcabcabc
+} -result {YWJjYWJjYWJj}
+test binary-72.25 {binary encode base64} -body {
+    binary encode base64 -maxlen 2 -wrapchar * abcabcabc
+} -result {YW*Jj*YW*Jj*YW*Jj}
+test binary-72.26 {binary encode base64} -body {
+    binary encode base64 -maxlen 6 -wrapchar -*- abcabcabc
+} -result {YWJjYW-*-JjYWJj}
+test binary-72.27 {binary encode base64} -body {
+    binary encode base64 -maxlen 4 -wrapchar -*- abcabcabc
+} -result {YWJj-*-YWJj-*-YWJj}
+test binary-72.28 {binary encode base64} -body {
+    binary encode base64 -maxlen 6 -wrapchar 0123456789 abcabcabc
+} -result {YWJjYW0123456789JjYWJj}
+
+test binary-73.1 {binary decode base64} -body {
+    binary decode base64
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-73.2 {binary decode base64} -body {
+    binary decode base64 YWJj
+} -result {abc}
+test binary-73.3 {binary decode base64} -body {
+    binary decode base64 {}
+} -result {}
+test binary-73.4 {binary decode base64} -body {
+    binary decode base64 [string repeat YWJj 20]
+} -result [string repeat abc 20]
+test binary-73.5 {binary encode base64} -body {
+    binary decode base64 AAECAwQAAQID
+} -result "\0\1\2\3\4\0\1\2\3"
+test binary-73.6 {binary encode base64} -body {
+    binary decode base64 AA==
+} -result "\0"
+test binary-73.7 {binary encode base64} -body {
+    binary decode base64 AAA=
+} -result "\0\0"
+test binary-73.8 {binary encode base64} -body {
+    binary decode base64 AAAA
+} -result "\0\0\0"
+test binary-73.9 {binary encode base64} -body {
+    binary decode base64 AAAAAA==
+} -result "\0\0\0\0"
+test binary-73.10 {binary decode base64} -body {
+    set s "[string repeat YWJj 10]\n[string repeat YWJj 10]"
+    binary decode base64 $s
+} -result [string repeat abc 20]
+test binary-73.11 {binary decode base64} -body {
+    set s "[string repeat YWJj 10]\n    [string repeat YWJj 10]"
+    binary decode base64 $s
+} -result [string repeat abc 20]
+test binary-73.12 {binary decode base64} -body {
+    binary decode base64 -strict ":YWJj"
+} -returnCodes error -match glob -result {invalid base64 character ":" at position 0}
+test binary-73.13 {binary decode base64} -body {
+    set s "[string repeat YWJj 10]:[string repeat YWJj 10]"
+    binary decode base64 -strict $s
+} -returnCodes error -match glob -result {invalid base64 character ":" at position 40}
+test binary-73.14 {binary decode base64} -body {
+    set s "[string repeat YWJj 10]\n    [string repeat YWJj 10]"
+    binary decode base64 -strict $s
+} -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.20 {binary decode base64} -body {
+    set r [binary decode base64 Y]
+    list [string length $r] $r
+} -result {0 {}}
+test binary-73.21 {binary decode base64} -body {
+    set r [binary decode base64 YW]
+    list [string length $r] $r
+} -result {1 a}
+test binary-73.22 {binary decode base64} -body {
+    set r [binary decode base64 YWJ]
+    list [string length $r] $r
+} -result {2 ab}
+test binary-73.23 {binary decode base64} -body {
+    set r [binary decode base64 YWJj]
+    list [string length $r] $r
+} -result {3 abc}
+test binary-73.24 {binary decode base64} -body {
+    string length [binary decode base64 " "]
+} -result 0
+test binary-73.25 {binary decode base64} -body {
+    list [string length [set r [binary decode base64 WA==\n]]] $r
+} -result {1 X}
+test binary-73.26 {binary decode base64} -body {
+    list [string length [set r [binary decode base64 WFk=\n]]] $r
+} -result {2 XY}
+test binary-73.27 {binary decode base64} -body {
+    list [string length [set r [binary decode base64 WFla\n]]] $r
+} -result {3 XYZ}
+test binary-73.28 {binary decode base64} -body {
+    list [string length [set r [binary decode base64 -strict WA==\n]]] $r
+} -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.29 {binary decode base64} -body {
+    list [string length [set r [binary decode base64 -strict WFk=\n]]] $r
+} -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.30 {binary decode base64} -body {
+    list [string length [set r [binary decode base64 -strict WFla\n]]] $r
+} -returnCodes error -match glob -result {invalid base64 character *}
+test binary-73.31 {binary decode base64} -body {
+    list [string length [set r [binary decode base64 WA==WFla]]] $r
+} -returnCodes error -match glob -result {invalid base64 character *}
+
+test binary-74.1 {binary encode uuencode} -body {
+    binary encode uuencode
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-74.2 {binary encode uuencode} -body {
+    binary encode uuencode abc
+} -result {#86)C
+}
+test binary-74.3 {binary encode uuencode} -body {
+    binary encode uuencode {}
+} -result {}
+test binary-74.4 {binary encode uuencode} -body {
+    binary encode uuencode [string repeat abc 20]
+} -result "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
+test binary-74.5 {binary encode uuencode} -body {
+    binary encode uuencode \0\1\2\3\4\0\1\2\3
+} -result ")``\$\"`P0``0(#\n"
+test binary-74.6 {binary encode uuencode} -body {
+    binary encode uuencode \0
+} -result {!``
+}
+test binary-74.7 {binary encode uuencode} -body {
+    binary encode uuencode \0\0
+} -result "\"```
+"
+test binary-74.8 {binary encode uuencode} -body {
+    binary encode uuencode \0\0\0
+} -result {#````
+}
+test binary-74.9 {binary encode uuencode} -body {
+    binary encode uuencode \0\0\0\0
+} -result {$``````
+}
+test binary-74.10 {binary encode uuencode} -returnCodes error -body {
+    binary encode uuencode -foo 30 abcabcabc
+} -result {bad option "-foo": must be -maxlen or -wrapchar}
+test binary-74.11 {binary encode uuencode} -returnCodes error -body {
+    binary encode uuencode -maxlen 1 abcabcabc
+} -result {line length out of range}
+test binary-74.12 {binary encode uuencode} -body {
+    binary encode uuencode -maxlen 3 -wrapchar | abcabcabc
+} -result {!80|!8@|!8P|!80|!8@|!8P|!80|!8@|!8P|}
+
+test binary-75.1 {binary decode uuencode} -body {
+    binary decode uuencode
+} -returnCodes error -match glob -result "wrong # args: *"
+test binary-75.2 {binary decode uuencode} -body {
+    binary decode uuencode "#86)C\n"
+} -result {abc}
+test binary-75.3 {binary decode uuencode} -body {
+    binary decode uuencode {}
+} -result {}
+test binary-75.3.1 {binary decode uuencode} -body {
+    binary decode uuencode `\n
+} -result {}
+test binary-75.4 {binary decode uuencode} -body {
+    binary decode uuencode "M[string repeat 86)C 15]\n/[string repeat 86)C 5]\n"
+} -result [string repeat abc 20]
+test binary-75.5 {binary decode uuencode} -body {
+    binary decode uuencode ")``\$\"`P0``0(#"
+} -result "\0\1\2\3\4\0\1\2\3"
+test binary-75.6 {binary decode uuencode} -body {
+    string length [binary decode uuencode "`\n"]
+} -result 0
+test binary-75.7 {binary decode uuencode} -body {
+    string length [binary decode uuencode "!`\n"]
+} -result 1
+test binary-75.8 {binary decode uuencode} -body {
+    string length [binary decode uuencode "\"``\n"]
+} -result 2
+test binary-75.9 {binary decode uuencode} -body {
+    string length [binary decode uuencode "#```\n"]
+} -result 3
+test binary-75.10 {binary decode uuencode} -body {
+    set s ">[string repeat 86)C 10]\n>[string repeat 86)C 10]"
+    binary decode uuencode $s
+} -result [string repeat abc 20]
+test binary-75.11 {binary decode uuencode} -body {
+    set s ">[string repeat 86)C 10]\n\t>\t[string repeat 86)C 10]\r"
+    binary decode uuencode $s
+} -result [string repeat abc 20]
+test binary-75.12 {binary decode uuencode} -body {
+    binary decode uuencode -strict "|86)C"
+} -returnCodes error -match glob -result {invalid uuencode character "|" at position 0}
+test binary-75.13 {binary decode uuencode} -body {
+    set s ">[string repeat 86)C 10]|[string repeat 86)C 10]"
+    binary decode uuencode -strict $s
+} -returnCodes error -match glob -result {invalid uuencode character "|" at position 41}
+test binary-75.14 {binary decode uuencode} -body {
+    set s ">[string repeat 86)C 10]\na[string repeat 86)C 10]"
+    binary decode uuencode -strict $s
+} -returnCodes error -match glob -result {invalid uuencode character *}
+test binary-75.20 {binary decode uuencode} -body {
+    set r [binary decode uuencode " 8"]
+    list [string length $r] $r
+} -result {0 {}}
+test binary-75.21 {binary decode uuencode} -body {
+    set r [binary decode uuencode "!86"]
+    list [string length $r] $r
+} -result {1 a}
+test binary-75.22 {binary decode uuencode} -body {
+    set r [binary decode uuencode "\"86)"]
+    list [string length $r] $r
+} -result {2 ab}
+test binary-75.23 {binary decode uuencode} -body {
+    set r [binary decode uuencode "#86)C"]
+    list [string length $r] $r
+} -result {3 abc}
+test binary-75.24 {binary decode uuencode} -body {
+    set s "#04)\# "
+    binary decode uuencode $s
+} -result ABC
+test binary-75.25 {binary decode uuencode} -body {
+    set s "#04)\#z"
+    binary decode uuencode $s
+} -returnCodes error -match glob -result {invalid uuencode character "z" at position 5}
+test binary-75.26 {binary decode uuencode} -body {
+    string length [binary decode uuencode " "]
+} -result 0
+
+test binary-76.1 {binary string appending growth algorithm} unix {
+    # Create zero-length byte array first
+    set f [open /dev/null rb]
+    chan configure $f -blocking 0
+    set str [read $f 2]
+    close $f
+    # Append to it
+    string length [append str [binary format a* foo]]
+} 3
+test binary-76.2 {binary string appending growth algorithm} win {
+    # Create zero-length byte array first
+    set f [open NUL rb]
+    chan configure $f -blocking 0
+    set str [read $f 2]
+    close $f
+    # Append to it
+    string length [append str [binary format a* foo]]
+} 3
+
+# ----------------------------------------------------------------------
 # cleanup
+
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/case.test b/tests/case.test
index 477538c..6d63cea 100644
--- a/tests/case.test
+++ b/tests/case.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: case.test,v 1.6 2004/05/19 10:52:35 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -42,7 +40,7 @@ test case-1.7 {list of patterns} {
 
 test case-2.1 {error in executed command} {
     list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
-	    $msg $errorInfo
+	    $msg $::errorInfo
 } {1 {Just a test} {Just a test
     while executing
 "error "Just a test""
@@ -51,7 +49,7 @@ test case-2.1 {error in executed command} {
 "case a in a {error "Just a test"} default {format 1}"}}
 test case-2.2 {error: not enough args} {
     list [catch {case} msg] $msg
-} {1 {wrong # args: should be "case string ?in? patList body ... ?default body?"}}
+} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}}
 test case-2.3 {error: pattern with no body} {
     list [catch {case a b} msg] $msg
 } {1 {extra case pattern with no body}}
@@ -60,7 +58,7 @@ test case-2.4 {error: pattern with no body} {
 } {1 {extra case pattern with no body}}
 test case-2.5 {error in default command} {
     list [catch {case foo in a {error case1} default {error case2} \
-	    b {error case 3}} msg] $msg $errorInfo
+	    b {error case 3}} msg] $msg $::errorInfo
 } {1 case2 {case2
     while executing
 "error case2"
diff --git a/tests/chan.test b/tests/chan.test
index dd2fea6..d8390e2 100644
--- a/tests/chan.test
+++ b/tests/chan.test
@@ -6,32 +6,62 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: chan.test,v 1.4 2005/06/07 21:31:53 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+#
+# Note: The tests for the chan methods "create" and "postevent"
+# currently reside in the file "ioCmd.test".
+#
+
 test chan-1.1 {chan command general syntax} -body {
     chan
-} -returnCodes error -result "wrong # args: should be \"chan subcommand ?argument ...?\""
+} -returnCodes error -result "wrong # args: should be \"chan subcommand ?arg ...?\""
 test chan-1.2 {chan command general syntax} -body {
     chan FOOBAR
-} -returnCodes error -result "unknown or ambiguous subcommand \"FOOBAR\": must be blocked, close, configure, copy, eof, event, flush, gets, names, puts, read, seek, tell, or truncate"
+} -returnCodes error -match glob -result "unknown or ambiguous subcommand \"FOOBAR\": must be *"
 
 test chan-2.1 {chan command: blocked subcommand} -body {
     chan blocked foo bar
 } -returnCodes error -result "wrong # args: should be \"chan blocked channelId\""
-
 test chan-3.1 {chan command: close subcommand} -body {
-    chan close foo bar
-} -returnCodes error -result "wrong # args: should be \"chan close channelId\""
-
+    chan close foo bar zet
+} -returnCodes error -result "wrong # args: should be \"chan close channelId ?direction?\""
+test chan-3.2 {chan command: close subcommand} -setup {
+    set chan [open [info script] r]
+} -body {
+    chan close $chan bar
+} -cleanup {
+    close $chan
+} -returnCodes error -result "bad direction \"bar\": must be read or write"
+test chan-3.3 {chan command: close subcommand} -setup {
+    set chan [open [info script] r]
+} -body {
+    chan close $chan write
+} -cleanup {
+    close $chan
+} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"
 test chan-4.1 {chan command: configure subcommand} -body {
     chan configure
-} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?optionName? ?value? ?optionName value?...\""
+} -returnCodes error -result "wrong # args: should be \"chan configure channelId ?-option value ...?\""
+test chan-4.2 {chan command: [Bug 800753]} -body {
+    chan configure stdout -eofchar \u0100
+} -returnCodes error -match glob -result {bad value*}
+test chan-4.3 {chan command: [Bug 800753]} -body {
+    chan configure stdout -eofchar \u0000
+} -returnCodes error -match glob -result {bad value*}
+test chan-4.4 {chan command: check valid inValue, no outValue} -body {
+    chan configure stdout -eofchar [list \x27 {}]
+} -returnCodes ok -result {}
+test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {
+    chan configure stdout -eofchar [list \x27 \x80]
+} -returnCodes error -match glob -result {bad value for -eofchar:*}
+test chan-4.6 {chan command: check no inValue, valid outValue} -body {
+    chan configure stdout -eofchar [list {} \x27]
+} -returnCodes ok -result {} -cleanup {chan configure stdout -eofchar [list {} {}]}
 
 test chan-5.1 {chan command: copy subcommand} -body {
     chan copy foo
@@ -91,6 +121,152 @@ test chan-15.2 {chan command: truncate subcommand} -setup {
     catch {removeFile $file}
 }
 
+# TIP 287: chan pending
+test chan-16.1 {chan command: pending subcommand} -body {
+    chan pending
+} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
+test chan-16.2 {chan command: pending subcommand} -body {
+    chan pending stdin
+} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
+test chan-16.3 {chan command: pending subcommand} -body {
+    chan pending stdin stdout stderr
+} -returnCodes error -result "wrong # args: should be \"chan pending mode channelId\""
+test chan-16.4 {chan command: pending subcommand} -body {
+    chan pending {input output} stdout
+} -returnCodes error -result "bad mode \"input output\": must be input or output"
+test chan-16.5 {chan command: pending input subcommand} -body {
+    chan pending input stdout 
+} -result -1
+test chan-16.6 {chan command: pending input subcommand} -body {
+    chan pending input stdin
+} -result 0
+test chan-16.7 {chan command: pending input subcommand} -body {
+    chan pending input FOOBAR
+} -returnCodes error -result "can not find channel named \"FOOBAR\""
+test chan-16.8 {chan command: pending input subcommand} -setup {
+    set file [makeFile {} testAvailable]
+    set f [open $file w+]
+    chan configure $f -translation lf -buffering line
+} -body {
+    chan puts $f foo
+    chan puts $f bar
+    chan puts $f baz
+    chan seek $f 0
+    chan gets $f
+    chan pending input $f
+} -result 8 -cleanup {
+    catch {chan close $f}
+    catch {removeFile $file}
+}
+test chan-16.9 {chan command: pending input subcommand} -setup {
+    proc chan-16.9-accept {sock addr port} {
+        chan configure $sock -blocking 0 -buffering line -buffersize 32
+        chan event $sock readable [list chan-16.9-readable $sock]
+    }
+
+    proc chan-16.9-readable {sock} {
+        set r [chan gets $sock line]
+        set l [string length $line]
+        set e [chan eof $sock]
+        set b [chan blocked $sock]
+        set i [chan pending input $sock]
+
+        lappend ::chan-16.9-data $r $l $e $b $i
+
+        if {$r != -1 || $e || $l || !$b || $i > 128} {
+            set data [read $sock $i]
+            lappend ::chan-16.9-data [string range $data 0 2]
+            lappend ::chan-16.9-data [string range $data end-2 end]
+            set ::chan-16.9-done 1
+            chan event $sock readable {}
+        } else {
+	    after idle chan-16.9-client
+	}
+    }
+
+    proc chan-16.9-client {} {
+        chan puts -nonewline $::client ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890
+        chan flush $::client
+    }
+
+    set ::server [socket -server chan-16.9-accept -myaddr 127.0.0.1 0]
+    set ::client [socket 127.0.0.1 [lindex [fconfigure $::server -sockname] 2]]
+    set ::chan-16.9-data [list]
+    set ::chan-16.9-done 0
+} -body {
+    after idle chan-16.9-client 
+    vwait ::chan-16.9-done
+    set ::chan-16.9-data
+} -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup {
+    catch {chan close $client}
+    catch {chan close $server}
+    rename chan-16.9-accept {}
+    rename chan-16.9-readable {}
+    rename chan-16.9-client {}
+    unset -nocomplain ::chan-16.9-data
+    unset -nocomplain ::chan-16.9-done
+    unset -nocomplain ::server
+    unset -nocomplain ::client
+}
+test chan-16.10 {chan command: pending output subcommand} -body {
+    chan pending output stdin
+} -result -1
+test chan-16.11 {chan command: pending output subcommand} -body {
+    chan pending output stdout
+} -result 0
+test chan-16.12 {chan command: pending output subcommand} -body {
+    chan pending output FOOBAR
+} -returnCodes error -result "can not find channel named \"FOOBAR\""
+test chan-16.13 {chan command: pending output subcommand} -setup {
+    set file [makeFile {} testPendingOutput]
+    set f [open $file w+]
+    chan configure $f -translation lf -buffering full -buffersize 1024
+} -body {
+    set result [list]
+    chan puts $f [string repeat x 512]
+    lappend result [chan pending output $f]
+    chan flush $f
+    lappend result [chan pending output $f]
+} -result [list 513 0] -cleanup {
+    unset -nocomplain result
+    catch {chan close $f}
+    catch {removeFile $file}
+}
+
+# TIP 304: chan pipe
+
+test chan-17.1 {chan command: pipe subcommand} -body {
+    chan pipe foo
+} -returnCodes error -result "wrong # args: should be \"chan pipe \""
+
+test chan-17.2 {chan command: pipe subcommand} -body {
+    chan pipe foo bar
+} -returnCodes error -result "wrong # args: should be \"chan pipe \""
+
+test chan-17.3 {chan command: pipe subcommand} -body {
+	set l [chan pipe]
+    foreach {pr pw} $l break
+    list [llength $l] [fconfigure $pr -blocking] [fconfigure $pw -blocking]
+} -result [list 2 1 1] -cleanup {
+    close $pw
+    close $pr
+}
+
+test chan-17.4 {chan command: pipe subcommand} -body {
+    set ::done 0
+    foreach {::pr ::pw} [chan pipe] break
+    after 100 {puts $::pw foo;flush $::pw}
+    fileevent $::pr readable {set ::done 1}
+    after 500 {set ::done -1}
+    vwait ::done
+    set out nope
+    if {$::done==1} {gets $::pr out}
+    list $::done $out
+} -result [list 1 foo] -cleanup {
+    close $::pw
+    close $::pr
+}
+
 cleanupTests
 return
 
diff --git a/tests/chanio.test b/tests/chanio.test
new file mode 100644
index 0000000..999d0bb
--- /dev/null
+++ b/tests/chanio.test
@@ -0,0 +1,7723 @@
+# -*- tcl -*-
+# Functionality covered: operation of all IO commands, and all procedures
+# defined in generic/tclIO.c.
+#
+# 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-1994 The Regents of the University of California.
+# Copyright (c) 1994-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.
+
+if {[catch {package require tcltest 2}]} {
+    chan puts stderr "Skipping tests in [info script].  tcltest 2 required."
+    return
+}
+namespace eval ::tcl::test::io {
+    namespace import ::tcltest::*
+
+    variable umaskValue
+    variable path
+    variable f
+    variable i
+    variable n
+    variable v
+    variable msg
+    variable expected
+
+    ::tcltest::loadTestedCommands
+    catch [list package require -exact Tcltest [info patchlevel]]
+    
+    testConstraint testchannel      [llength [info commands testchannel]]
+    testConstraint exec             [llength [info commands exec]]
+    testConstraint openpipe         1
+    testConstraint fileevent        [llength [info commands fileevent]]
+    testConstraint fcopy            [llength [info commands fcopy]]
+    testConstraint testfevent       [llength [info commands testfevent]]
+    testConstraint testchannelevent [llength [info commands testchannelevent]]
+    testConstraint testmainthread   [llength [info commands testmainthread]]
+    testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+
+    # You need a *very* special environment to do some tests.  In particular,
+    # many file systems do not support large-files...
+    testConstraint largefileSupport 0
+
+    # some tests can only be run is umask is 2 if "umask" cannot be run, the
+    # tests will be skipped.
+    set umaskValue 0
+    testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}]
+
+    testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]
+
+    # set up a long data file for some of the following tests
+
+    set path(longfile) [makeFile {} longfile]
+    set f [open $path(longfile) w]
+    chan configure $f -eofchar {} -translation lf
+    for { set i 0 } { $i < 100 } { incr i} {
+	chan puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
+\#123456789abcdef01
+\#"
+    }
+    chan close $f
+
+    set path(cat) [makeFile {
+	set f stdin
+	if {$argv != ""} {
+	    set f [open [lindex $argv 0]]
+	}
+	chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a
+	chan configure stdout -encoding binary -translation lf -buffering none
+	chan event $f readable "foo $f"
+	proc foo {f} {
+	    set x [chan read $f]
+	    catch {chan puts -nonewline $x}
+	    if {[chan eof $f]} {
+		chan close $f
+		exit 0
+	    }
+	}
+	vwait forever
+    } cat]
+
+    set thisScript [file join [pwd] [info script]]
+
+    proc contents {file} {
+	set f [open $file]
+	chan configure $f -translation binary
+	set a [chan read $f]
+	chan close $f
+	return $a
+    }
+
+    # Wrapper round butt-ugly pipe syntax
+    proc openpipe {{mode r+} args} {
+	open "|[list [interpreter] {*}$args]" $mode
+    }
+
+test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
+    # no test, need to cause an async error.
+} {}
+set path(test1) [makeFile {} test1]
+test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
+    set f [open $path(test1) w]
+    chan configure $f -encoding binary
+    chan puts -nonewline $f "a\u4e4d\0"
+    chan close $f
+    contents $path(test1)
+} "a\x4d\x00"
+test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
+    set f [open $path(test1) w]
+    chan configure $f -encoding shiftjis
+    chan puts -nonewline $f "a\u4e4d\0"
+    chan close $f
+    contents $path(test1)
+} "a\x93\xe1\x00"
+set path(test2) [makeFile {} test2]
+test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
+    # This test written for SF bug #506297.
+    #
+    # Executing this test without the fix for the referenced bug applied to
+    # tcl will cause tcl, more specifically WriteChars, to go into an infinite
+    # loop.
+    set f [open $path(test2) w] 
+    chan configure      $f -encoding iso2022-jp 
+    chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399] 
+    chan close           $f 
+    contents $path(test2)
+} "    \x1b\$B\$O\x1b(B"
+test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
+    # When closing a channel with an encoding that appends escape bytes, check
+    # for the case where the escape bytes overflow the current IO buffer. The
+    # bytes should be moved into a new buffer.
+    set data "1234567890 [format %c 12399]"
+    set sizes [list]
+    # With default buffer size
+    set f [open $path(test2) w]
+    chan configure      $f -encoding iso2022-jp
+    chan puts -nonewline $f $data
+    chan close           $f
+    lappend sizes [file size $path(test2)]
+    # With buffer size equal to the length of the data, the escape bytes would
+    # go into the next buffer.
+    set f [open $path(test2) w]
+    chan configure      $f -encoding iso2022-jp -buffersize 16
+    chan puts -nonewline $f $data
+    chan close           $f
+    lappend sizes [file size $path(test2)]
+    # With buffer size that is large enough to hold 1 byte of escaped data,
+    # but not all 3. This should not write the escape bytes to the first
+    # buffer and then again to the second buffer.
+    set f [open $path(test2) w]
+    chan configure      $f -encoding iso2022-jp -buffersize 17
+    chan puts -nonewline $f $data
+    chan close           $f
+    lappend sizes [file size $path(test2)]
+    # With buffer size that can hold 2 out of 3 bytes of escaped data.
+    set f [open $path(test2) w]
+    chan configure      $f -encoding iso2022-jp -buffersize 18
+    chan puts -nonewline $f $data
+    chan close           $f
+    lappend sizes [file size $path(test2)]
+    # With buffer size that can hold all the data and escape bytes.
+    set f [open $path(test2) w]
+    chan configure      $f -encoding iso2022-jp -buffersize 19
+    chan puts -nonewline $f $data
+    chan close           $f
+    lappend sizes [file size $path(test2)]
+} {19 19 19 19 19}
+
+test chan-io-2.1 {WriteBytes} {
+    # loop until all bytes are written
+    set f [open $path(test1) w]
+    chan configure $f  -encoding binary -buffersize 16 -translation crlf
+    chan puts $f "abcdefghijklmnopqrstuvwxyz"
+    chan close $f
+    contents $path(test1)
+} "abcdefghijklmnopqrstuvwxyz\r\n"
+test chan-io-2.2 {WriteBytes: savedLF > 0} {
+    # After flushing buffer, there was a \n left over from the last
+    # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.
+    set f [open $path(test1) w]
+    chan configure $f -encoding binary -buffersize 16 -translation crlf
+    chan puts -nonewline $f "123456789012345\n12"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "123456789012345\r" "123456789012345\r\n12"]
+test chan-io-2.3 {WriteBytes: flush on line} -body {
+    # Tcl "line" buffering has weird behavior: if current buffer contains a
+    # \n, entire buffer gets flushed.  Logical behavior would be to flush only
+    # up to the \n.
+    set f [open $path(test1) w]
+    chan configure $f -encoding binary -buffering line -translation crlf
+    chan puts -nonewline $f "\n12"
+    contents $path(test1)
+} -cleanup {
+    chan close $f
+} -result "\r\n12"
+test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} {
+    set f [open $path(test1) w]
+     chan configure $f -encoding binary -buffering line -translation lf \
+	     -buffersize 16
+    chan puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
+
+test chan-io-3.1 {WriteChars: compatibility with WriteBytes} {
+    # loop until all bytes are written
+    set f [open $path(test1) w]
+    chan configure $f -encoding ascii -buffersize 16 -translation crlf
+    chan puts $f "abcdefghijklmnopqrstuvwxyz"
+    chan close $f
+    contents $path(test1)
+} "abcdefghijklmnopqrstuvwxyz\r\n"
+test chan-io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
+    # After flushing buffer, there was a \n left over from the last
+    # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.
+    set f [open $path(test1) w]
+    chan configure $f -encoding ascii -buffersize 16 -translation crlf
+    chan puts -nonewline $f "123456789012345\n12"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "123456789012345\r" "123456789012345\r\n12"]
+test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -body {
+    # Tcl "line" buffering has weird behavior: if current buffer contains a
+    # \n, entire buffer gets flushed.  Logical behavior would be to flush only
+    # up to the \n.
+    set f [open $path(test1) w]
+    chan configure $f -encoding ascii -buffering line -translation crlf
+    chan puts -nonewline $f "\n12"
+    contents $path(test1)
+} -cleanup {
+    chan close $f
+} -result "\r\n12"
+test chan-io-3.4 {WriteChars: loop over stage buffer} {
+    # stage buffer maps to more than can be queued at once.
+    set f [open $path(test1) w]
+    chan configure $f -encoding jis0208 -buffersize 16 
+    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test chan-io-3.5 {WriteChars: saved != 0} {
+    # Bytes produced by UtfToExternal from end of last channel buffer had to
+    # be moved to beginning of next channel buffer to preserve requested
+    # buffersize.
+    set f [open $path(test1) w]
+    chan configure $f -encoding jis0208 -buffersize 17 
+    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
+    # One incomplete UTF-8 character at end of staging buffer. Backup in src
+    # to the beginning of that UTF-8 character and try again.
+    #
+    # Translate the first 16 bytes, produce 14 bytes of output, 2 left over
+    # (first two bytes of \uff21 in UTF-8). Given those two bytes try
+    # translating them again, find that no bytes are read produced, and break
+    # to outer loop where those two bytes will have the remaining 4 bytes (the
+    # last byte of \uff21 plus the all of \uff22) appended.
+    set f [open $path(test1) w]
+    chan configure $f -encoding shiftjis -buffersize 16
+    chan puts -nonewline $f "12345678901234\uff21\uff22"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
+test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
+    # When translating UTF-8 to external, the produced bytes went past end of
+    # the channel buffer. This is done on purpose - we then truncate the bytes
+    # at the end of the partial character to preserve the requested blocksize
+    # on flush. The truncated bytes are moved to the beginning of the next
+    # channel buffer.
+    set f [open $path(test1) w]
+    chan configure $f -encoding jis0208 -buffersize 17 
+    chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test chan-io-3.8 {WriteChars: reset sawLF after each buffer} {
+    set f [open $path(test1) w]
+    chan configure $f -encoding ascii -buffering line -translation lf \
+	     -buffersize 16
+    chan puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
+
+test chan-io-4.1 {TranslateOutputEOL: lf} {
+    # search for \n
+    set f [open $path(test1) w]
+    chan configure $f -buffering line -translation lf
+    chan puts $f "abcde"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "abcde\n" "abcde\n"]
+test chan-io-4.2 {TranslateOutputEOL: cr} {
+    # search for \n, replace with \r
+    set f [open $path(test1) w]
+    chan configure $f -buffering line -translation cr
+    chan puts $f "abcde"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "abcde\r" "abcde\r"]
+test chan-io-4.3 {TranslateOutputEOL: crlf} {
+    # simple case: search for \n, replace with \r
+    set f [open $path(test1) w]
+    chan configure $f -buffering line -translation crlf
+    chan puts $f "abcde"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "abcde\r\n" "abcde\r\n"]
+test chan-io-4.4 {TranslateOutputEOL: crlf} {
+    # Keep storing more bytes in output buffer until output buffer is full. We
+    # have 13 bytes initially that would turn into 18 bytes. Fill dest buffer
+    # while (dstEnd < dstMax).
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -buffersize 16
+    chan puts -nonewline $f "1234567\n\n\n\n\nA"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"]
+test chan-io-4.5 {TranslateOutputEOL: crlf} {
+    # Check for overflow of the destination buffer
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -buffersize 12
+    chan puts -nonewline $f "12345678901\n456789012345678901234"
+    chan close $f
+    set x [contents $path(test1)]
+} "12345678901\r\n456789012345678901234"
+
+test chan-io-5.1 {CheckFlush: not full} {
+    set f [open $path(test1) w]
+    chan configure $f 
+    chan puts -nonewline $f "12345678901234567890"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "" "12345678901234567890"]
+test chan-io-5.2 {CheckFlush: full} {
+    set f [open $path(test1) w]
+    chan configure $f -buffersize 16
+    chan puts -nonewline $f "12345678901234567890"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "1234567890123456" "12345678901234567890"]
+test chan-io-5.3 {CheckFlush: not line} {
+    set f [open $path(test1) w]
+    chan configure $f -buffering line
+    chan puts -nonewline $f "12345678901234567890"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "" "12345678901234567890"]
+test chan-io-5.4 {CheckFlush: line} {
+    set f [open $path(test1) w]
+    chan configure $f -buffering line -translation lf -encoding ascii
+    chan puts -nonewline $f "1234567890\n1234567890"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "1234567890\n1234567890" "1234567890\n1234567890"]
+test chan-io-5.5 {CheckFlush: none} {
+    set f [open $path(test1) w]
+    chan configure $f -buffering none
+    chan puts -nonewline $f "1234567890"
+    set x [list [contents $path(test1)]]
+    chan close $f
+    lappend x [contents $path(test1)]
+} [list "1234567890" "1234567890"]
+
+test chan-io-6.1 {Tcl_GetsObj: working} -body {
+    set f [open $path(test1) w]
+    chan puts $f "foo\nboo"
+    chan close $f
+    set f [open $path(test1)]
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result {foo}
+test chan-io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} emptyTest {
+    # no test, need to cause an async error.
+} {}
+test chan-io-6.3 {Tcl_GetsObj: how many have we used?} -body {
+    # if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved}
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts $f "abc\ndefg"
+    chan close $f
+    set f [open $path(test1)]
+    list [chan tell $f] [chan gets $f line] [chan tell $f] [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {0 3 5 4 defg}
+test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation binary
+    chan puts $f "\x81\u1234\0"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation binary
+    list [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 3 "\x81\x34\x00"]
+test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation binary
+    chan puts $f "\x88\xea\x92\x9a"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -encoding shiftjis
+    list [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 2 "\u4e00\u4e01"]
+set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+append a $a
+append a $a
+test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
+    # if (dst >= dstEnd) 
+    set f [open $path(test1) w]
+    chan puts $f $a
+    chan puts $f hi
+    chan close $f
+    set f [open $path(test1)]
+    list [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 256 $a]
+test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints {stdio openpipe} -body {
+    # if (FilterInputBytes(chanPtr, &gs) != 0)
+    set f [openpipe w+ $path(cat)]
+    chan puts -nonewline $f "hi\nwould"
+    chan flush $f
+    chan gets $f
+    chan configure $f -blocking 0
+    chan gets $f line
+} -cleanup {
+    chan close $f
+} -result {-1}
+test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body {
+    set f [open $path(test1) w]
+    chan puts $f "abcdef\x1aghijk\nwombat"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -eofchar \x1a
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {6 abcdef -1 {}}
+test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body {
+    set f [open $path(test1) w]
+    chan puts $f "abcdefghijk\nwom\u001abat"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -eofchar \x1a
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {11 abcdefghijk 3 wom}
+# Comprehensive tests
+test chan-io-6.10 {Tcl_GetsObj: lf mode: no chars} -body {
+    set f [open $path(test1) w]
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation lf
+    list [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {-1 {}}
+test chan-io-6.11 {Tcl_GetsObj: lf mode: lone \n} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation lf
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {0 {} -1 {}}
+test chan-io-6.12 {Tcl_GetsObj: lf mode: lone \r} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation lf
+    set x [list [chan gets $f line] $line [chan gets $f line] $line]
+} -cleanup {
+    chan close $f
+} -result [list 1 "\r" -1 ""]
+test chan-io-6.13 {Tcl_GetsObj: lf mode: 1 char} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f a
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation lf
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {1 a -1 {}}
+test chan-io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "a\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation lf
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {1 a -1 {}}
+test chan-io-6.15 {Tcl_GetsObj: lf mode: several chars} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation lf
+    list [chan gets $f line] $line [chan gets $f line] $line \
+	[chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
+test chan-io-6.16 {Tcl_GetsObj: cr mode: no chars} -body {
+    set f [open $path(test1) w]
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation cr
+    list [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {-1 {}}
+test chan-io-6.17 {Tcl_GetsObj: cr mode: lone \n} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation cr
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 1 "\n" -1 ""]
+test chan-io-6.18 {Tcl_GetsObj: cr mode: lone \r} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation cr
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {0 {} -1 {}}
+test chan-io-6.19 {Tcl_GetsObj: cr mode: 1 char} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f a
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation cr
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {1 a -1 {}}
+test chan-io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "a\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation cr
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {1 a -1 {}}
+test chan-io-6.21 {Tcl_GetsObj: cr mode: several chars} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation cr
+    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
+test chan-io-6.22 {Tcl_GetsObj: crlf mode: no chars} -body {
+    set f [open $path(test1) w]
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    list [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {-1 {}}
+test chan-io-6.23 {Tcl_GetsObj: crlf mode: lone \n} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 1 "\n" -1 ""]
+test chan-io-6.24 {Tcl_GetsObj: crlf mode: lone \r} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 1 "\r" -1 ""]
+test chan-io-6.25 {Tcl_GetsObj: crlf mode: \r\r} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\r\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 2 "\r\r" -1 ""]
+test chan-io-6.26 {Tcl_GetsObj: crlf mode: \r\n} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\r\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {0 {} -1 {}}
+test chan-io-6.27 {Tcl_GetsObj: crlf mode: 1 char} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f a
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {1 a -1 {}}
+test chan-io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "a\r\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {1 a -1 {}}
+test chan-io-6.29 {Tcl_GetsObj: crlf mode: several chars} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
+test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} -constraints {testchannel} -body {
+    # if (eol >= dstEnd)
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf -buffersize 16
+    list [chan gets $f line] $line [testchannel inputbuffered $f]
+} -cleanup {
+    chan close $f
+} -result [list 15 "123456789012345" 15]
+test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} -setup {
+    set x ""
+} -constraints {stdio testchannel openpipe fileevent} -body {
+    # (FilterInputBytes() != 0)
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation {crlf lf} -buffering none
+    chan puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
+    chan configure $f -buffersize 16
+    lappend x [chan gets $f]
+    chan configure $f -blocking 0
+    lappend x [chan gets $f line] $line [chan blocked $f] \
+	[testchannel inputbuffered $f]
+} -cleanup {
+    chan close $f
+} -result {bbbbbbbbbbbbbb -1 {} 1 16}
+test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} -constraints {testchannel} -body {
+    # not (FilterInputBytes() != 0)
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456789012345\r\n123"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf -buffersize 16
+    list [chan gets $f line] $line [chan tell $f] [testchannel inputbuffered $f]
+} -cleanup {
+    chan close $f
+} -result {15 123456789012345 17 3}
+test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} -body {
+    # eol still equals dstEnd
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456789012345\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf -buffersize 16
+    list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result [list 16 "123456789012345\r" 1]
+test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} -body {
+    # not (*eol == '\n') 
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456789012345\rabcd\r\nefg"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf -buffersize 16
+    list [chan gets $f line] $line [chan tell $f]
+} -cleanup {
+    chan close $f
+} -result [list 20 "123456789012345\rabcd" 22]
+test chan-io-6.35 {Tcl_GetsObj: auto mode: no chars} -body {
+    set f [open $path(test1) w]
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    list [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {-1 {}}
+test chan-io-6.36 {Tcl_GetsObj: auto mode: lone \n} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {0 {} -1 {}}
+test chan-io-6.37 {Tcl_GetsObj: auto mode: lone \r} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {0 {} -1 {}}
+test chan-io-6.38 {Tcl_GetsObj: auto mode: \r\r} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\r\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {0 {} 0 {} -1 {}}
+test chan-io-6.39 {Tcl_GetsObj: auto mode: \r\n} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\r\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {0 {} -1 {}}
+test chan-io-6.40 {Tcl_GetsObj: auto mode: 1 char} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f a
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {1 a -1 {}}
+test chan-io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "a\r\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    list [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {1 a -1 {}}
+test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} -setup {
+    set x ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    lappend x [chan gets $f line] $line [chan gets $f line] $line
+    lappend x [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {4 abcd 4 efgh 4 ijkl 4 mnop -1 {}}
+test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
+    set x ""
+} -constraints {stdio testchannel openpipe fileevent} -body {
+    # if (chanPtr->flags & INPUT_SAW_CR)
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation {auto lf} -buffering none
+    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+    chan configure $f -buffersize 16
+    lappend x [chan gets $f]
+    chan configure $f -blocking 0
+    lappend x [chan gets $f line] $line [testchannel queuedcr $f] 
+    chan configure $f -blocking 1
+    chan puts -nonewline $f "\nabcd\refg\x1a"
+    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+    lappend x [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
+test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
+    set x ""
+} -constraints {stdio testchannel openpipe fileevent} -body {
+    # not (*eol == '\n') 
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation {auto lf} -buffering none
+    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+    chan configure $f -buffersize 16
+    lappend x [chan gets $f]
+    chan configure $f -blocking 0
+    lappend x [chan gets $f line] $line [testchannel queuedcr $f] 
+    chan configure $f -blocking 1
+    chan puts -nonewline $f "abcd\refg\x1a"
+    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+    lappend x [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
+test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup {
+    set x ""
+} -constraints {stdio testchannel openpipe fileevent} -body {
+    # Tcl_ExternalToUtf()
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation {auto lf} -buffering none
+    chan configure $f -encoding unicode
+    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+    chan configure $f -buffersize 16
+    chan gets $f
+    chan configure $f -blocking 0
+    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+    chan configure $f -blocking 1
+    chan puts -nonewline $f "\nabcd\refg"
+    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
+    chan close $f
+} -result {15 123456789abcdef 1 4 abcd 0}
+test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} -setup {
+    set x ""
+} -constraints {stdio testchannel openpipe fileevent} -body {
+    # memmove()
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation {auto lf} -buffering none
+    chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
+    chan configure $f -buffersize 16
+    chan gets $f
+    chan configure $f -blocking 0
+    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+    chan configure $f -blocking 1
+    chan puts -nonewline $f "\n\x1a"
+    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
+    chan close $f
+} -result {15 123456789abcdef 1 -1 {} 0}
+test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} -constraints {testchannel} -body {
+    # (eol == dstEnd)
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto -buffersize 16
+    list [chan gets $f] [testchannel inputbuffered $f]
+} -cleanup {
+    chan close $f
+} -result {123456789012345 15}
+test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} -constraints {testchannel} -body {
+    # PeekAhead() did not get any, so (eol >= dstEnd)
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456789012345\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto -buffersize 16
+    list [chan gets $f] [testchannel queuedcr $f]
+} -cleanup {
+    chan close $f
+} -result {123456789012345 1}
+test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} -constraints {testchannel} -body {
+    # if (*eol == '\n') {skip++}
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456\r\n78901"
+    chan close $f
+    set f [open $path(test1)]
+    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
+} -cleanup {
+    chan close $f
+} -result {123456 0 8 78901}
+test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} -constraints {testchannel} -body {
+    # not (*eol == '\n') 
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456\r78901"
+    chan close $f
+    set f [open $path(test1)]
+    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
+} -cleanup {
+    chan close $f
+} -result {123456 0 7 78901}
+test chan-io-6.51 {Tcl_GetsObj: auto mode: \n} -body {
+    # else if (*eol == '\n') {goto gotoeol;}
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456\n78901"
+    chan close $f
+    set f [open $path(test1)]
+    list [chan gets $f] [chan tell $f] [chan gets $f]
+} -cleanup {
+    chan close $f
+} -result {123456 7 78901}
+test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -body {
+    # if (eof != NULL)
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "123456\x1ak9012345\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -eofchar \x1a
+    list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
+} -cleanup {
+    chan close $f
+} -result {123456 0 6 {}}
+test chan-io-6.53 {Tcl_GetsObj: device EOF} -body {
+    # didn't produce any bytes
+    set f [open $path(test1) w]
+    chan close $f
+    set f [open $path(test1)]
+    list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {-1 {} 1}
+test chan-io-6.54 {Tcl_GetsObj: device EOF} -body {
+    # got some bytes before EOF.
+    set f [open $path(test1) w]
+    chan puts -nonewline $f abc
+    chan close $f
+    set f [open $path(test1)]
+    list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {3 abc 1}
+test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
+    # Tcl_ExternalToUtf(), make sure state updated
+    set f [open $path(test1) w]
+    chan configure $f -encoding iso2022-jp
+    chan puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -encoding iso2022-jp
+    list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
+test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
+    update
+    variable x {}
+} -constraints {stdio openpipe fileevent} -body {
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -buffering none
+    chan puts -nonewline $f "foobar"
+    chan configure $f -blocking 0
+    after 500 [namespace code {
+	lappend x timeout
+    }]
+    chan event $f readable [namespace code {
+	lappend x [chan gets $f]
+    }]
+    vwait [namespace which -variable x]
+    vwait [namespace which -variable x]
+    chan configure $f -blocking 1
+    chan puts -nonewline $f "baz\n"
+    after 500 [namespace code {
+	lappend x timeout
+    }]
+    chan configure $f -blocking 0
+    vwait [namespace which -variable x]
+    vwait [namespace which -variable x]
+    return $x
+} -cleanup {
+    chan close $f
+} -result {{} timeout foobarbaz timeout}
+
+test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} -body {
+    # (result == TCL_CONVERT_MULTIBYTE)
+    set f [open $path(test1) w]
+    chan configure $f -encoding shiftjis
+    chan puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -encoding shiftjis -buffersize 16
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result "1234567890123\uff10\uff11\uff12\uff13\uff14"
+test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -body {
+    # (bufPtr->nextAdded < bufPtr->bufLength)
+    set f [open $path(test1) w]
+    chan configure $f -encoding binary
+    chan puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -encoding shiftjis
+    list [chan gets $f line] $line [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {10 1234567890 0}
+test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
+    set x ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    chan configure $f -encoding binary
+    chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -encoding shiftjis
+    lappend x [chan gets $f line] $line
+    lappend x [chan tell $f] [testchannel inputbuffered $f] [chan eof $f]
+    lappend x [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
+test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
+    variable x ""
+} -constraints {stdio openpipe fileevent} -body {
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -encoding binary -buffering none
+    chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
+    chan configure $f -encoding shiftjis -blocking 0
+    chan event $f read [namespace code {
+	lappend x [chan gets $f line] $line [chan blocked $f]
+    }]
+    vwait [namespace which -variable x]
+    chan configure $f -encoding binary -blocking 1
+    chan puts $f "\x51\x82\x52"
+    chan configure $f -encoding shiftjis
+    vwait [namespace which -variable x]
+    return $x
+} -cleanup {
+    chan close $f
+} -result [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
+
+test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constraints {testchannel} -body {
+    # (bufPtr->nextPtr == NULL)
+    set f [open $path(test1) w]
+    chan configure $f -encoding ascii -translation lf
+    chan puts -nonewline $f "123456789012345\r\n2345678"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -encoding ascii -translation auto -buffersize 16
+    # here
+    chan gets $f
+    testchannel inputbuffered $f
+} -cleanup {
+    chan close $f
+} -result 7
+test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup {
+    variable x {}
+} -constraints {stdio testchannel openpipe fileevent} -body {
+    # not (bufPtr->nextPtr == NULL)
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation lf -encoding ascii -buffering none
+    chan puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
+    chan event $f read [namespace code {
+	lappend x [chan gets $f line] $line [testchannel inputbuffered $f]
+    }]
+    chan configure $f -encoding unicode -buffersize 16 -blocking 0
+    vwait [namespace which -variable x]
+    chan configure $f -translation auto -encoding ascii -blocking 1
+    # here
+    vwait [namespace which -variable x]
+    return $x
+} -cleanup {
+    chan close $f
+} -result {-1 {} 42 15 123456789012345 25}
+test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel openpipe fileevent} -body {
+    # (bytesLeft == 0)
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation {auto binary}
+    chan puts -nonewline $f "abcdefghijklmno\r"
+    chan flush $f
+    list [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
+    chan close $f
+} -result {15 abcdefghijklmno 1}
+set a "123456789012345678901234567890"
+append a "123456789012345678901234567890"
+append a "1234567890123456789012345678901"
+test chan-io-8.4 {PeekAhead: cached data available in this buffer} -body {
+    # not (bytesLeft == 0)
+    set f [open $path(test1) w+]
+    chan configure $f -translation binary
+    chan puts $f "${a}\r\nabcdef"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -encoding binary -translation auto
+    # "${a}\r" was converted in one operation (because ENCODING_LINESIZE is
+    # 30). To check if "\n" follows, calls PeekAhead and determines that
+    # cached data is available in buffer w/o having to call driver.
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result $a
+unset a
+test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel openpipe fileevent} -body {
+    # (bufPtr->nextAdded < bufPtr->length)
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation {auto binary}
+    chan puts -nonewline $f "abcdefghijklmno\r"
+    chan flush $f
+    # here
+    list [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
+    chan close $f
+} -result {15 abcdefghijklmno 1}
+test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
+    # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) 
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation {auto binary} -buffersize 16
+    chan puts -nonewline $f "abcdefghijklmno\r"
+    chan flush $f
+    # here
+    list [chan gets $f line] $line [testchannel queuedcr $f]
+} -cleanup {
+    chan close $f
+} -result {15 abcdefghijklmno 1}
+test chan-io-8.7 {PeekAhead: cleanup} -setup {
+    set x ""
+} -constraints {stdio testchannel openpipe fileevent} -body {
+    # Make sure bytes are removed from buffer.
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -translation {auto binary} -buffering none
+    chan puts -nonewline $f "abcdefghijklmno\r"
+    # here
+    lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+    chan puts -nonewline $f "\x1a"
+    lappend x [chan gets $f line] $line
+} -cleanup {
+    chan close $f
+} -result {15 abcdefghijklmno 1 -1 {}}
+
+test chan-io-9.1 {CommonGetsCleanup} emptyTest {
+} {}
+
+test chan-io-10.1 {Tcl_ReadChars: CheckChannelErrors} emptyTest {
+    # no test, need to cause an async error.
+} {}
+test chan-io-10.2 {Tcl_ReadChars: loop until enough copied} -body {
+    # one time
+    # for (copied = 0; (unsigned) toRead > 0; )
+    set f [open $path(test1) w]
+    chan puts $f abcdefghijklmnop
+    chan close $f
+    set f [open $path(test1)]
+    chan read $f 5
+} -cleanup {
+    chan close $f
+} -result {abcde}
+test chan-io-10.3 {Tcl_ReadChars: loop until enough copied} -body {
+    # multiple times
+    # for (copied = 0; (unsigned) toRead > 0; )
+    set f [open $path(test1) w]
+    chan puts $f abcdefghijklmnopqrstuvwxyz
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -buffersize 16
+    # here
+    chan read $f 19
+} -cleanup {
+    chan close $f
+} -result {abcdefghijklmnopqrs}
+test chan-io-10.4 {Tcl_ReadChars: no more in channel buffer} -body {
+    # (copiedNow < 0)
+    set f [open $path(test1) w]
+    chan puts -nonewline $f abcdefghijkl
+    chan close $f
+    set f [open $path(test1)]
+    # here
+    chan read $f 1000
+} -cleanup {
+    chan close $f
+} -result {abcdefghijkl}
+test chan-io-10.5 {Tcl_ReadChars: stop on EOF} -body {
+    # (chanPtr->flags & CHANNEL_EOF)
+    set f [open $path(test1) w]
+    chan puts -nonewline $f abcdefghijkl
+    chan close $f
+    set f [open $path(test1)]
+    # here
+    chan read $f 1000
+} -cleanup {
+    chan close $f
+} -result {abcdefghijkl}
+
+test chan-io-11.1 {ReadBytes: want to read a lot} -body {
+    # ((unsigned) toRead > (unsigned) srcLen)
+    set f [open $path(test1) w]
+    chan puts -nonewline $f abcdefghijkl
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -encoding binary
+    # here
+    chan read $f 1000
+} -cleanup {
+    chan close $f
+} -result {abcdefghijkl}
+test chan-io-11.2 {ReadBytes: want to read all} -body {
+    # ((unsigned) toRead > (unsigned) srcLen)
+    set f [open $path(test1) w]
+    chan puts -nonewline $f abcdefghijkl
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -encoding binary
+    # here
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result {abcdefghijkl}
+test chan-io-11.3 {ReadBytes: allocate more space} -body {
+    # (toRead > length - offset - 1)
+    set f [open $path(test1) w]
+    chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -buffersize 16 -encoding binary
+    # here
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result {abcdefghijklmnopqrstuvwxyz}
+test chan-io-11.4 {ReadBytes: EOF char found} -body {
+    # (TranslateInputEOL() != 0)
+    set f [open $path(test1) w]
+    chan puts $f abcdefghijklmnopqrstuvwxyz
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -eofchar m -encoding binary
+    # here
+    list [chan read $f] [chan eof $f] [chan read $f] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abcdefghijkl 1 {} 1}
+
+test chan-io-12.1 {ReadChars: want to read a lot} -body {
+    # ((unsigned) toRead > (unsigned) srcLen)
+    set f [open $path(test1) w]
+    chan puts -nonewline $f abcdefghijkl
+    chan close $f
+    set f [open $path(test1)]
+    # here
+    chan read $f 1000
+} -cleanup {
+    chan close $f
+} -result {abcdefghijkl}
+test chan-io-12.2 {ReadChars: want to read all} -body {
+    # ((unsigned) toRead > (unsigned) srcLen)
+    set f [open $path(test1) w]
+    chan puts -nonewline $f abcdefghijkl
+    chan close $f
+    set f [open $path(test1)]
+    # here
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result {abcdefghijkl}
+test chan-io-12.3 {ReadChars: allocate more space} -body {
+    # (toRead > length - offset - 1)
+    set f [open $path(test1) w]
+    chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -buffersize 16
+    # here
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result {abcdefghijklmnopqrstuvwxyz}
+test chan-io-12.4 {ReadChars: split-up char} -setup {
+    variable x {}
+} -constraints {stdio testchannel openpipe fileevent} -body {
+    # (srcRead == 0)
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -encoding binary -buffering none -buffersize 16
+    chan puts -nonewline $f "123456789012345\x96"
+    chan configure $f -encoding shiftjis -blocking 0
+    chan event $f read [namespace code {
+	lappend x [chan read $f] [testchannel inputbuffered $f]
+    }]
+    chan configure $f -encoding shiftjis
+    vwait [namespace which -variable x]
+    chan configure $f -encoding binary -blocking 1
+    chan puts -nonewline $f "\x7b"
+    after 500			;# Give the cat process time to catch up
+    chan configure $f -encoding shiftjis -blocking 0
+    vwait [namespace which -variable x]
+    return $x
+} -cleanup {
+    chan close $f
+} -result [list "123456789012345" 1 "\u672c" 0]
+test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
+    variable x {}
+} -constraints {stdio openpipe fileevent} -body {
+    set path(test1) [makeFile {
+	chan configure stdout -encoding binary -buffering none
+	chan gets stdin; chan puts -nonewline "\xe7"
+	chan gets stdin; chan puts -nonewline "\x89"
+	chan gets stdin; chan puts -nonewline "\xa6"
+    } test1]
+    set f [openpipe r+ $path(test1)]
+    chan event $f readable [namespace code {
+	lappend x [chan read $f]
+	if {[chan eof $f]} {
+	    lappend x eof
+	}
+    }]
+    chan puts $f "go1"
+    chan flush $f
+    chan configure $f -blocking 0 -encoding utf-8
+    vwait [namespace which -variable x]
+    after 500 [namespace code { lappend x timeout }]
+    vwait [namespace which -variable x]
+    chan puts $f "go2"
+    chan flush $f
+    vwait [namespace which -variable x]
+    after 500 [namespace code { lappend x timeout }]
+    vwait [namespace which -variable x]
+    chan puts $f "go3"
+    chan flush $f
+    vwait [namespace which -variable x]
+    vwait [namespace which -variable x]
+    lappend x [catch {chan close $f} msg] $msg
+} -result "{} timeout {} timeout \u7266 {} eof 0 {}"
+
+test chan-io-13.1 {TranslateInputEOL: cr mode} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\rdef\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation cr
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "abcd\ndef\n"
+test chan-io-13.2 {TranslateInputEOL: crlf mode} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\r\ndef\r\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "abcd\ndef\n"
+test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body {
+    # (src >= srcMax) 
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\r\ndef\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "abcd\ndef\r"
+test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body {
+    # (src >= srcMax) 
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\r\ndef\rfgh"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "abcd\ndef\rfgh"
+test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
+    # (src >= srcMax) 
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\r\ndef\nfgh"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation crlf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "abcd\ndef\nfgh"
+test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup {
+    variable x {}
+    variable y {}
+} -constraints {stdio testchannel openpipe fileevent} -body {
+    # (chanPtr->flags & INPUT_SAW_CR)
+    # This test may fail on slower machines.
+    set f [openpipe w+ $path(cat)]
+    chan configure $f -blocking 0 -buffering none -translation {auto lf}
+    chan event $f read [namespace code {
+	lappend x [chan read $f] [testchannel queuedcr $f]
+    }]
+    chan puts -nonewline $f "abcdefghj\r"
+    after 500 [namespace code {set y ok}]
+    vwait [namespace which -variable y]
+    chan puts -nonewline $f "\n01234"
+    after 500 [namespace code {set y ok}]
+    vwait [namespace which -variable y]
+    return $x
+} -cleanup {
+    chan close $f
+} -result [list "abcdefghj\n" 1 "01234" 0]
+test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints {testchannel openpipe} -body {
+    # (src >= srcMax)
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\r"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    list [chan read $f] [testchannel queuedcr $f]
+} -cleanup {
+    chan close $f
+} -result [list "abcd\n" 1]
+test chan-io-13.8 {TranslateInputEOL: auto mode: \r\n} -body {
+    # (*src == '\n')
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\r\ndef"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "abcd\ndef"
+test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\rdef"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "abcd\ndef"
+test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body {
+    # not (*src == '\r') 
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\ndef"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "abcd\ndef"
+test chan-io-13.11 {TranslateInputEOL: EOF char} -body {
+    # (*chanPtr->inEofChar != '\0')
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "abcd\ndefgh"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto -eofchar e
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "abcd\nd"
+test chan-io-13.12 {TranslateInputEOL: find EOF char in src} -body {
+    # (*chanPtr->inEofChar != '\0')
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
+    chan close $f
+    set f [open $path(test1)]
+    chan configure $f -translation auto -eofchar e
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "\n\n\nab\n\nd"
+
+# Test standard handle management. The functions tested are Tcl_SetStdChannel
+# and Tcl_GetStdChannel. Incidentally we are also testing channel table
+# management.
+
+if {[testConstraint testchannel]} {
+    set consoleFileNames [lsort [testchannel open]]
+} else {
+    # just to avoid an error
+    set consoleFileNames [list]
+}
+
+test chan-io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} {
+    set result ""
+    lappend result [chan configure stdin -buffering]
+    lappend result [chan configure stdout -buffering]
+    lappend result [chan configure stderr -buffering]
+    lappend result [lsort [testchannel open]]
+} [list line line none $consoleFileNames]
+test chan-io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} -setup {
+    interp create x
+    set result ""
+} -body {
+    lappend result [x eval {chan configure stdin -buffering}]
+    lappend result [x eval {chan configure stdout -buffering}]
+    lappend result [x eval {chan configure stderr -buffering}]
+} -cleanup {
+    interp delete x
+} -result {line line none}
+set path(test3) [makeFile {} test3]
+test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec openpipe} -body {
+    set f [open $path(test1) w]
+    chan puts -nonewline $f {
+	chan close stdin
+	chan close stdout
+	chan close stderr
+	set f  [}
+    chan puts $f [list open $path(test1) r]]
+    chan puts $f "set f2 \[[list open $path(test2) w]]"
+    chan puts $f "set f3 \[[list open $path(test3) w]]"
+    chan puts $f {	chan puts stdout [chan gets stdin]
+	chan puts stdout out
+	chan puts stderr err
+	chan close $f
+	chan close $f2
+	chan close $f3
+    }
+    chan close $f
+    set result [exec [interpreter] $path(test1)]
+    set f  [open $path(test2) r]
+    set f2 [open $path(test3) r]
+    lappend result [chan read $f] [chan read $f2]
+} -cleanup {
+    chan close $f
+    chan close $f2
+} -result {{
+out
+} {err
+}}
+# This test relies on the fact that stdout is used before stderr.
+test chan-io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec} -body {
+    set f [open $path(test1) w]
+    chan puts -nonewline $f { chan close stdin
+	chan close stdout
+	chan close stderr
+	set f  [}
+    chan puts $f [list open $path(test1) r]]
+    chan puts $f "set f2 \[[list open $path(test2) w]]"
+    chan puts $f "set f3 \[[list open $path(test3) w]]"
+    chan puts $f {
+	chan puts stdout [chan gets stdin]
+	chan puts stdout $f2
+	chan puts stderr $f3
+	chan close $f
+	chan close $f2
+	chan close $f3
+    }
+    chan close $f
+    set result [exec [interpreter] $path(test1)]
+    set f  [open $path(test2) r]
+    set f2 [open $path(test3) r]
+    lappend result [chan read $f] [chan read $f2]
+} -cleanup {
+    chan close $f
+    chan close $f2
+} -result {{ chan close stdin
+stdout
+} {stderr
+}}
+catch {interp delete z}
+test chan-io-14.5 {Tcl_GetChannel: stdio name translation} -setup {
+    interp create z
+} -body {
+    chan eof stdin
+    catch {z eval chan flush stdin} msg1
+    catch {z eval chan close stdin} msg2
+    catch {z eval chan flush stdin} msg3
+    list $msg1 $msg2 $msg3
+} -cleanup {
+    interp delete z
+} -result {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
+test chan-io-14.6 {Tcl_GetChannel: stdio name translation} -setup {
+    interp create z
+} -body {
+    chan eof stdout
+    catch {z eval chan flush stdout} msg1
+    catch {z eval chan close stdout} msg2
+    catch {z eval chan flush stdout} msg3
+    list $msg1 $msg2 $msg3
+} -cleanup {
+    interp delete z
+} -result {{} {} {can not find channel named "stdout"}}
+test chan-io-14.7 {Tcl_GetChannel: stdio name translation} -setup {
+    interp create z
+} -body {
+    chan eof stderr
+    catch {z eval chan flush stderr} msg1
+    catch {z eval chan close stderr} msg2
+    catch {z eval chan flush stderr} msg3
+    list $msg1 $msg2 $msg3
+} -cleanup {
+    interp delete z
+} -result {{} {} {can not find channel named "stderr"}}
+set path(script) [makeFile {} script]
+test chan-io-14.8 {reuse of stdio special channels} -setup {
+    file delete $path(script)
+    file delete $path(test1)
+} -constraints {stdio openpipe} -body {
+    set f [open $path(script) w]
+    chan puts -nonewline $f {
+	chan close stderr
+	set f [}
+    chan puts $f [list open $path(test1) w]]
+    chan puts -nonewline $f {
+	chan puts stderr hello
+	chan close $f
+	set f [}
+    chan puts $f [list open $path(test1) r]]
+    chan puts $f {
+	chan puts [chan gets $f]
+    }
+    chan close $f
+    set f [openpipe r $path(script)]
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result hello
+test chan-io-14.9 {reuse of stdio special channels} -setup {
+    file delete $path(script)
+    file delete $path(test1)
+} -constraints {stdio openpipe fileevent} -body {
+    set f [open $path(script) w]
+    chan puts $f {
+        array set path [lindex $argv 0]
+	set f [open $path(test1) w]
+	chan puts $f hello
+	chan close $f
+	chan close stderr
+	set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r]
+	chan puts [chan gets $f]
+    }
+    chan close $f
+    set f [openpipe r $path(script) [array get path]]
+    chan gets $f
+} -cleanup {
+    chan close $f
+    # Added delay to give Windows time to stop the spawned process and clean
+    # up its grip on the file test1. Added delete as proper test cleanup.
+    # The failing tests were 18.1 and 18.2 as first re-users of file "test1".
+    after [expr {[testConstraint win] ? 10000 : 500}]
+    file delete $path(script)
+    file delete $path(test1)
+} -result hello
+
+test chan-io-15.1 {Tcl_CreateChan CloseHandler} emptyTest {
+} {}
+
+test chan-io-16.1 {Tcl_DeleteChan CloseHandler} emptyTest {
+} {}
+
+# Test channel table management. The functions tested are GetChannelTable,
+# DeleteChannelTable, Tcl_RegisterChannel, Tcl_UnregisterChannel,
+# Tcl_GetChannel and Tcl_CreateChannel.
+#
+# These functions use "eof stdin" to ensure that the standard channels are
+# added to the channel table of the interpreter.
+
+test chan-io-17.1 {GetChannelTable, DeleteChannelTable on std handles} -setup {
+    set l ""
+} -constraints {testchannel} -body {
+    set l1 [testchannel refcount stdin]
+    chan eof stdin
+    interp create x
+    lappend l [expr {[testchannel refcount stdin] - $l1}]
+    x eval {chan eof stdin}
+    lappend l [expr {[testchannel refcount stdin] - $l1}]
+    interp delete x
+    lappend l [expr {[testchannel refcount stdin] - $l1}]
+} -result {0 1 0}
+test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} -setup  {
+    set l ""
+} -constraints {testchannel} -body {
+    set l1 [testchannel refcount stdout]
+    chan eof stdin
+    interp create x
+    lappend l [expr {[testchannel refcount stdout] - $l1}]
+    x eval {chan eof stdout}
+    lappend l [expr {[testchannel refcount stdout] - $l1}]
+    interp delete x
+    lappend l [expr {[testchannel refcount stdout] - $l1}]
+} -result {0 1 0}
+test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} -setup {
+    set l ""
+} -constraints {testchannel} -body {
+    set l1 [testchannel refcount stderr]
+    chan eof stdin
+    interp create x
+    lappend l [expr {[testchannel refcount stderr] - $l1}]
+    x eval {chan eof stderr}
+    lappend l [expr {[testchannel refcount stderr] - $l1}]
+    interp delete x
+    lappend l [expr {[testchannel refcount stderr] - $l1}]
+} -result {0 1 0}
+
+test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
+    file delete -force $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    lappend l [lindex [testchannel info $f] 15]
+    chan close $f
+    if {[catch {lindex [testchannel info $f] 15} msg]} {
+	lappend l $msg
+    } else {
+	lappend l "very broken: $f found after being chan closed"
+    }
+    string equal $l [list 1 "can not find channel named \"$f\""]
+} -result 1
+test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
+    file delete -force $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    lappend l [lindex [testchannel info $f] 15]
+    interp create x
+    interp share "" $f x
+    lappend l [lindex [testchannel info $f] 15]
+    x eval chan close $f
+    lappend l [lindex [testchannel info $f] 15]
+    interp delete x
+    lappend l [lindex [testchannel info $f] 15]
+    chan close $f
+    if {[catch {lindex [testchannel info $f] 15} msg]} {
+	lappend l $msg
+    } else {
+	lappend l "very broken: $f found after being chan closed"
+    }
+    string equal $l [list 1 2 1 1 "can not find channel named \"$f\""]
+} -result 1
+test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    lappend l [lindex [testchannel info $f] 15]
+    interp create x
+    interp share "" $f x
+    lappend l [lindex [testchannel info $f] 15]
+    interp delete x
+    lappend l [lindex [testchannel info $f] 15]
+    chan close $f
+    if {[catch {lindex [testchannel info $f] 15} msg]} {
+	lappend l $msg
+    } else {
+	lappend l "very broken: $f found after being chan closed"
+    }
+    string equal $l [list 1 2 1 "can not find channel named \"$f\""]
+} -result 1
+
+test chan-io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
+    chan eof stdin
+} 0
+test chan-io-19.2 {testing Tcl_GetChannel, user opened handle} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan eof $f
+} -cleanup {
+    chan close $f
+} -result 0
+test chan-io-19.3 {Tcl_GetChannel, channel not found} -body {
+    chan eof file34
+} -returnCodes error -result {can not find channel named "file34"}
+test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    lappend l [chan eof $f]
+    chan close $f
+    if {[catch {lindex [testchannel info $f] 15} msg]} {
+	lappend l $msg
+    } else {
+	lappend l "very broken: $f found after being chan closed"
+    }
+    string equal $l [list 0 "can not find channel named \"$f\""]
+} -result 1
+
+test chan-io-20.1 {Tcl_CreateChannel: initial settings} -setup {
+    set old [encoding system]
+} -body {
+    set a [open $path(test2) w]
+    encoding system ascii
+    set f [open $path(test1) w]
+    chan configure $f -encoding
+} -cleanup {
+    encoding system $old
+    chan close $f
+    chan close $a
+} -result {ascii}
+test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body {
+    set f [open $path(test1) w+]
+    list [chan configure $f -eofchar] [chan configure $f -translation]
+} -cleanup {
+    chan close $f
+} -result [list [list \x1a ""] {auto crlf}]
+test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body {
+    set f [open $path(test1) w+]
+    list [chan configure $f -eofchar] [chan configure $f -translation]
+} -cleanup {
+    chan close $f
+} -result {{{} {}} {auto lf}}
+test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
+    set path(stdout) [makeFile {} stdout]
+} -constraints {stdio openpipe} -body {
+    set f [open $path(script) w]
+    chan puts -nonewline $f {
+	chan close stdout
+	set f1 [}
+    chan puts $f [list open $path(stdout) w]]
+    chan puts $f {
+	chan configure $f1 -buffersize 777
+	chan puts stderr [chan configure stdout -buffersize]
+    }
+    chan close $f
+    set f [openpipe r $path(script)]
+    chan close $f
+} -cleanup {
+    removeFile $path(stdout)
+} -returnCodes error -result {777}
+
+test chan-io-21.1 {Chan CloseChannelsOnExit} emptyTest {
+} {}
+
+# Test management of attributes associated with a channel, such as its default
+# translation, its name and type, etc. The functions tested in this group are
+# Tcl_GetChannelName, Tcl_GetChannelType and Tcl_GetChannelFile.
+# Tcl_GetChannelInstanceData not tested because files do not use the instance
+# data.
+
+test chan-io-22.1 {Tcl_GetChannelMode} emptyTest {
+    # Not used anywhere in Tcl.
+} {}
+
+test chan-io-23.1 {Tcl_GetChannelName} -constraints {testchannel} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    set n [testchannel name $f]
+    expr {$n eq $f ? "ok" : "$n != $f"}
+} -cleanup {
+    chan close $f
+} -result ok
+
+test chan-io-24.1 {Tcl_GetChannelType} -constraints {testchannel} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    testchannel type $f
+} -cleanup {
+    chan close $f
+} -result "file"
+
+test chan-io-25.1 {Tcl_GetChannelHandle, input} -setup {
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f "1234567890\n098765432"
+    chan close $f
+    set f [open $path(test1) r]
+    chan gets $f
+    lappend l [testchannel inputbuffered $f]
+    lappend l [chan tell $f]
+} -cleanup {
+    chan close $f
+} -result {10 11}
+test chan-io-25.2 {Tcl_GetChannelHandle, output} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [chan tell $f]
+    chan flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [chan tell $f]
+} -cleanup {
+    chan close $f
+    file delete $path(test1)
+} -result {6 6 0 6}
+
+test chan-io-26.1 {Tcl_GetChannelInstanceData} -body {
+    # "pid" command uses Tcl_GetChannelInstanceData
+    # Don't care what pid is (but must be a number), just want to exercise it.
+    set f [openpipe r << exit]
+    pid $f
+} -constraints {stdio openpipe} -cleanup {
+    chan close $f
+} -match regexp -result {^\d+$}
+
+# Test flushing. The functions tested here are FlushChannel.
+
+test chan-io-27.1 {FlushChannel, no output buffered} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan flush $f
+    file size $path(test1)
+} -cleanup {
+    chan close $f
+} -result 0
+test chan-io-27.2 {FlushChannel, some output buffered} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f hello
+    lappend l [file size $path(test1)]
+    chan flush $f
+    lappend l [file size $path(test1)]
+    chan close $f
+    lappend l [file size $path(test1)]
+} -result {0 6 6}
+test chan-io-27.3 {FlushChannel, implicit flush on chan close} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f hello
+    lappend l [file size $path(test1)]
+    chan close $f
+    lappend l [file size $path(test1)]
+} -result {0 6}
+test chan-io-27.4 {FlushChannel, implicit flush when buffer fills} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan configure $f -buffersize 60
+    lappend l [file size $path(test1)]
+    for {set i 0} {$i < 12} {incr i} {
+	chan puts $f hello
+    }
+    lappend l [file size $path(test1)]
+    chan flush $f
+    lappend l [file size $path(test1)]
+} -cleanup {
+    chan close $f
+} -result {0 60 72}
+test chan-io-27.5 {FlushChannel, implicit flush when buffer fills and on chan close} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {unixOrPc} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -buffersize 60 -eofchar {}
+    lappend l [file size $path(test1)]
+    for {set i 0} {$i < 12} {incr i} {
+	chan puts $f hello
+    }
+    lappend l [file size $path(test1)]
+    chan close $f
+    lappend l [file size $path(test1)]
+} -result {0 60 72}
+set path(pipe)   [makeFile {} pipe]
+set path(output) [makeFile {} output]
+test chan-io-27.6 {FlushChannel, async flushing, async chan close} -setup {
+    file delete $path(pipe)
+    file delete $path(output)
+} -constraints {stdio asyncPipeChan Close openpipe} -body {
+    set f [open $path(pipe) w]
+    chan puts $f "set f \[[list open $path(output) w]]"
+    chan puts $f {
+	chan configure $f -translation lf -buffering none -eofchar {}
+	while {![chan eof stdin]} {
+	    after 20
+	    chan puts -nonewline $f [chan read stdin 1024]
+	}
+	chan close $f
+    }
+    chan close $f
+    set x 01234567890123456789012345678901
+    for {set i 0} {$i < 11} {incr i} {
+        set x "$x$x"
+    }
+    set f [open $path(output) w]
+    chan close $f
+    set f [openpipe w $path(pipe)]
+    chan configure $f -blocking off
+    chan puts -nonewline $f $x
+    chan close $f
+    set counter 0
+    while {([file size $path(output)] < 65536) && ($counter < 1000)} {
+	after 20 [list incr [namespace which -variable counter]]
+	vwait [namespace which -variable counter]
+    }
+    if {$counter == 1000} {
+        set result "file size only [file size $path(output)]"
+    } else {
+        set result ok
+    }
+} -result ok
+
+# Tests closing a channel. The functions tested are Chan CloseChannel and
+# Tcl_Chan Close.
+
+test chan-io-28.1 {Chan CloseChannel called when all references are dropped} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    interp create x
+    interp share "" $f x
+    lappend l [testchannel refcount $f]
+    x eval chan close $f
+    interp delete x
+    lappend l [testchannel refcount $f]
+} -cleanup {
+    chan close $f
+} -result {2 1}
+test chan-io-28.2 {Chan CloseChannel called when all references are dropped} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    interp create x
+    interp share "" $f x
+    chan puts -nonewline $f abc
+    chan close $f
+    x eval chan puts $f def
+    x eval chan close $f
+    interp delete x
+    set f [open $path(test1) r]
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result abcdef
+test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} -setup {
+    file delete $path(pipe)
+    file delete $path(output)
+} -constraints {stdio asyncPipeChan Close nonPortable openpipe} -body {
+    set f [open $path(pipe) w]
+    chan puts $f {
+	# Need to not have eof char appended on chan close, because the other
+	# side of the pipe already chan closed, so that writing would cause an
+	# error "invalid file".
+	chan configure stdout -eofchar {}
+	chan configure stderr -eofchar {}
+	set f [open $path(output) w]
+	chan configure $f -translation lf -buffering none
+	for {set x 0} {$x < 20} {incr x} {
+	    after 20
+	    chan puts -nonewline $f [chan read stdin 1024]
+	}
+	chan close $f
+    }
+    chan close $f
+    set x 01234567890123456789012345678901
+    for {set i 0} {$i < 11} {incr i} {
+        set x "$x$x"
+    }
+    set f [open $path(output) w]
+    chan close $f
+    set f [openpipe r+ $path(pipe)]
+    chan configure $f -blocking off -eofchar {}
+    chan puts -nonewline $f $x
+    chan close $f
+    set counter 0
+    while {([file size $path(output)] < 20480) && ($counter < 1000)} {
+	after 20 [list incr [namespace which -variable counter]]
+	vwait [namespace which -variable counter]
+    }
+    if {$counter == 1000} {
+        set result probably_broken
+    } else {
+        set result ok
+    }
+} -result ok
+test chan-io-28.4 {Tcl_Chan Close} -constraints {testchannel} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    lappend l [lsort [testchannel open]]
+    set f [open $path(test1) w]
+    lappend l [lsort [testchannel open]]
+    chan close $f
+    lappend l [lsort [testchannel open]]
+    set x [list $consoleFileNames \
+		[lsort [list {*}$consoleFileNames $f]] \
+		$consoleFileNames]
+    expr {$l eq $x ? "ok" : "{$l} != {$x}"}
+} -result ok
+test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup {
+    file delete $path(script)
+} -constraints {stdio unix testchannel openpipe} -body {
+    set f [open $path(script) w]
+    chan puts $f {
+	chan close stdin
+	chan puts [testchannel open]
+    }
+    chan close $f
+    set f [openpipe r $path(script)]
+    set l [chan gets $f]
+    chan close $f
+    lsort $l
+} -result {file1 file2}
+test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} -setup {
+    set cat [makeFile {
+	fconfigure stdout -buffering line
+	while {[gets stdin line] >= 0} {puts $line}
+	puts DONE
+	exit 0
+    } cat.tcl]
+    variable done
+} -body {
+    set ff [openpipe r+ $cat]
+    puts $ff Hey
+    close $ff w
+    set timer [after 1000 [namespace code {set done Failed}]]
+    set acc {}
+    fileevent $ff readable [namespace code {
+	if {[gets $ff line] < 0} {
+	    set done Succeeded
+	} else {
+	    lappend acc $line
+	}
+    }]
+    vwait [namespace which -variable done]
+    after cancel $timer
+    close $ff r
+    list $done $acc
+} -cleanup {
+    removeFile cat.tcl
+} -result {Succeeded {Hey DONE}}
+test chan-io-28.7 {Tcl_CloseEx (half-close) socket} -setup {
+    set echo [makeFile {
+	proc accept {s args} {set ::sok $s}
+	set s [socket -server accept 0]
+	puts [lindex [fconfigure $s -sockname] 2]
+	flush stdout
+	vwait ::sok
+	fconfigure $sok -buffering line
+	while {[gets $sok line]>=0} {puts $sok $line}
+	puts $sok DONE
+	exit 0
+    } echo.tcl]
+    variable done
+    unset -nocomplain done
+    set done ""
+    set timer ""
+    set ff [openpipe r $echo]
+    gets $ff port
+} -body {
+    set s [socket 127.0.0.1 $port]
+    puts $s Hey
+    close $s w
+    set timer [after 1000 [namespace code {set done Failed}]]
+    set acc {}
+    fileevent $s readable [namespace code {
+	if {[gets $s line]<0} {
+	    set done Succeeded
+	} else {
+	    lappend acc $line
+	}
+    }]
+    vwait [namespace which -variable done]
+    list $done $acc
+} -cleanup {
+    catch {close $s}
+    close $ff
+    after cancel $timer
+    removeFile echo.tcl
+} -result {Succeeded {Hey DONE}}
+
+test chan-io-29.1 {Tcl_WriteChars, channel not writable} -body {
+    chan puts stdin hello
+} -returnCodes error -result {channel "stdin" wasn't opened for writing}
+test chan-io-29.2 {Tcl_WriteChars, empty string} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -eofchar {}
+    chan puts -nonewline $f ""
+    chan close $f
+    file size $path(test1)
+} -result 0
+test chan-io-29.3 {Tcl_WriteChars, nonempty string} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -eofchar {}
+    chan puts -nonewline $f hello
+    chan close $f
+    file size $path(test1)
+} -result 5
+test chan-io-29.4 {Tcl_WriteChars, buffering in full buffering mode} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -buffering full -eofchar {}
+    chan puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+    chan flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+} -cleanup {
+    chan close $f
+} -result {6 0 0 6}
+test chan-io-29.5 {Tcl_WriteChars, buffering in line buffering mode} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -buffering line -eofchar {}
+    chan puts -nonewline $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+    chan puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+} -cleanup {
+    chan close $f
+} -result {5 0 0 11}
+test chan-io-29.6 {Tcl_WriteChars, buffering in no buffering mode} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -buffering none -eofchar {}
+    chan puts -nonewline $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+    chan puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+} -cleanup {
+    chan close $f
+} -result {0 5 0 11}
+test chan-io-29.7 {Tcl_Flush, full buffering} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -buffering full -eofchar {}
+    chan puts -nonewline $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+    chan puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+    chan flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+} -cleanup {
+    chan close $f
+} -result {5 0 11 0 0 11}
+test chan-io-29.8 {Tcl_Flush, full buffering} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -buffering line
+    chan puts -nonewline $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+    chan flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+    chan puts $f hello
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+    chan flush $f
+    lappend l [testchannel outputbuffered $f]
+    lappend l [file size $path(test1)]
+} -cleanup {
+    chan close $f
+} -result {5 0 0 5 0 11 0 11}
+test chan-io-29.9 {Tcl_Flush, channel not writable} -body {
+    chan flush stdin
+} -returnCodes error -result {channel "stdin" wasn't opened for writing}
+test chan-io-29.10 {Tcl_WriteChars, looping and buffering} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    set f2 [open $path(longfile) r]
+    for {set x 0} {$x < 10} {incr x} {
+	chan puts $f1 [chan gets $f2]
+    }
+    chan close $f2
+    chan close $f1
+    file size $path(test1)
+} -result 387
+test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -eofchar {}
+    set f2 [open $path(longfile) r]
+    for {set x 0} {$x < 10} {incr x} {
+	chan puts -nonewline $f1 [chan gets $f2]
+    }
+    chan close $f1
+    chan close $f2
+    file size $path(test1)
+} -result 377
+test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup {
+    file delete $path(test1)
+    file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 "set f1 \[[list open $path(longfile) r]]"
+    chan puts $f1 {
+	for {set x 0} {$x < 10} {incr x} {
+	    chan puts [chan gets $f1]
+	}
+    }
+    chan close $f1
+    set f1 [openpipe r $path(pipe)]
+    set f2 [open $path(longfile) r]
+    set y ok
+    for {set x 0} {$x < 10} {incr x} {
+	set l1 [chan gets $f1]
+	set l2 [chan gets $f2]
+	if {$l1 ne $l2} {
+	    set y broken:$x
+	}
+    }
+    return $y
+} -cleanup {
+    chan close $f1
+    chan close $f2
+} -result ok
+test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} -setup {
+    file delete $path(test1)
+    file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {
+	chan puts [chan gets stdin]
+	chan puts [chan gets stdin]
+    }
+    chan close $f1
+    set y ok
+    set f1 [openpipe r+ $path(pipe)]
+    chan configure $f1 -buffering line
+    set f2 [open $path(longfile) r]
+    set line [chan gets $f2]
+    chan puts $f1 $line
+    set backline [chan gets $f1]
+    if {$line ne $backline} {
+	set y broken1
+    }
+    set line [chan gets $f2]
+    chan puts $f1 $line
+    set backline [chan gets $f1]
+    if {$line ne $backline} {
+	set y broken2
+    }
+    return $y
+} -cleanup {
+    chan close $f1
+    chan close $f2
+} -result ok
+test chan-io-29.14 {Tcl_WriteChars, buffering and implicit flush at chan close} -setup {
+    file delete $path(test3)
+} -body {
+    set f [open $path(test3) w]
+    chan puts -nonewline $f "Text1"
+    chan puts -nonewline $f " Text 2"
+    chan puts $f " Text 3"
+    chan close $f
+    set f [open $path(test3) r]
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result {Text1 Text 2 Text 3}
+test chan-io-29.15 {Tcl_Flush, channel not open for writing} -setup {
+    file delete $path(test1)
+    set fd [open $path(test1) w]
+    chan close $fd
+} -body {
+    set fd [open $path(test1) r]
+    chan flush $fd
+} -returnCodes error -cleanup {
+    catch {chan close $fd}
+} -match glob -result {channel "*" wasn't opened for writing}
+test chan-io-29.16 {Tcl_Flush on pipe opened only for reading} -setup {
+    set fd [openpipe r cat longfile]
+} -constraints {stdio openpipe} -body {
+    chan flush $fd
+} -returnCodes error -cleanup {
+    catch {chan close $fd}
+} -match glob -result {channel "*" wasn't opened for writing}
+test chan-io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf
+    chan puts $f1 hello
+    chan puts $f1 hello
+    chan puts $f1 hello
+    chan flush $f1
+    file size $path(test1)
+} -cleanup {
+    chan close $f1
+} -result 18
+test chan-io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} -setup {
+    file delete $path(test1)
+    set x ""
+    set f1 [open $path(test1) w]
+} -body {
+    chan configure $f1 -translation lf
+    chan puts $f1 hello
+    chan puts $f1 hello
+    chan puts $f1 hello
+    chan flush $f1
+    lappend x [file size $path(test1)]
+    chan puts $f1 hello
+    chan flush $f1
+    lappend x [file size $path(test1)]
+    chan puts $f1 hello
+    chan flush $f1
+    lappend x [file size $path(test1)]
+} -cleanup {
+    chan close $f1
+} -result {18 24 30}
+test chan-io-29.19 {Explicit and implicit flushes} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    set x ""
+    chan puts $f1 hello
+    chan puts $f1 hello
+    chan puts $f1 hello
+    chan flush $f1
+    lappend x [file size $path(test1)]
+    chan puts $f1 hello
+    chan flush $f1
+    lappend x [file size $path(test1)]
+    chan puts $f1 hello
+    chan close $f1
+    lappend x [file size $path(test1)]
+} -result {18 24 30}
+test chan-io-29.20 {Implicit flush when buffer is full} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
+    for {set x 0} {$x < 100} {incr x} {
+      chan puts $f1 $line
+    }
+    set z ""
+    lappend z [file size $path(test1)]
+    for {set x 0} {$x < 100} {incr x} {
+	chan puts $f1 $line
+    }
+    lappend z [file size $path(test1)]
+    chan close $f1
+    lappend z [file size $path(test1)]
+} -result {4096 12288 12600}
+test chan-io-29.21 {Tcl_Flush to pipe} -setup {
+    file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {set x [chan read stdin 6]}
+    chan puts $f1 {set cnt [string length $x]}
+    chan puts $f1 {chan puts "read $cnt characters"}
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    chan puts $f1 hello
+    chan flush $f1
+    chan gets $f1
+} -cleanup {
+    catch {chan close $f1}
+} -result "read 6 characters"
+test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup {
+    file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {
+	chan configure stdout -buffering full
+	chan puts hello
+	chan puts hello
+	chan flush stdout
+	chan gets stdin
+	chan puts bye
+	chan flush stdout
+    }
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    set x ""
+    lappend x [chan gets $f1]
+    lappend x [chan gets $f1]
+    chan puts $f1 hello
+    chan flush $f1
+    lappend x [chan gets $f1]
+} -cleanup {
+    chan close $f1
+} -result {hello hello bye}
+test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} -setup {
+    file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {
+	chan puts hello
+	chan puts hello
+	chan gets stdin
+	chan puts bye
+    }
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    set x ""
+    lappend x [chan gets $f1]
+    lappend x [chan gets $f1]
+    chan puts $f1 hello
+    chan flush $f1
+    lappend x [chan gets $f1]
+} -cleanup {
+    chan close $f1
+} -result {hello hello bye}
+test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} -setup {
+    variable x {}
+} -body {
+    set f [open $path(test3) w]
+    chan puts $f "Line 1"
+    chan puts $f "Line 2"
+    set f2 [open $path(test3)]
+    lappend x [chan read -nonewline $f2]
+    chan close $f2
+    chan flush $f
+    set f2 [open $path(test3)]
+    lappend x [chan read -nonewline $f2]
+} -cleanup {
+    chan close $f2
+    chan close $f
+} -result "{} {Line 1\nLine 2}"
+test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
+    file delete $path(test3)
+} -constraints {stdio openpipe fileevent} -body {
+    set f [openpipe w $path(cat) | [interpreter] $path(cat) > $path(test3)]
+    chan puts $f "Line 1"
+    chan puts $f "Line 2"
+    chan close $f
+    after 100
+    set f [open $path(test3) r]
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "Line 1\nLine 2\n"
+test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs openpipe} -body {
+    set f [open "|[list cat -u]" r+]
+    chan puts $f "Line1"
+    chan flush $f
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result {Line1}
+test chan-io-29.27 {Tcl_Flush on chan closed pipeline} -setup {
+    file delete $path(pipe)
+    set f [open $path(pipe) w]
+    chan puts $f {exit}
+    chan close $f
+} -constraints {stdio openpipe} -body {
+    set f [openpipe r+ $path(pipe)]
+    chan gets $f
+    chan puts $f output
+    after 50
+    #
+    # The flush below will get a SIGPIPE. This is an expected part of the test
+    # and indicates that the test operates correctly. If you run this test
+    # under a debugger, the signal will by intercepted unless you disable the
+    # debugger's signal interception.
+    #
+    if {[catch {chan flush $f} msg]} {
+	set x [list 1 $msg $::errorCode]
+	catch {chan close $f}
+    } elseif {[catch {chan close $f} msg]} {
+	set x [list 1 $msg $::errorCode]
+    } else {
+	set x {this was supposed to fail and did not}
+    }
+    string tolower $x
+} -match glob -result {1 {error flushing "*": broken pipe} {posix epipe {broken pipe}}}
+test chan-io-29.28 {Tcl_WriteChars, lf mode} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f hello\nthere\nand\nhere
+    chan flush $f
+    file size $path(test1)
+} -cleanup {
+    chan close $f
+} -result 21
+test chan-io-29.29 {Tcl_WriteChars, cr mode} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr -eofchar {}
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    file size $path(test1)
+} -result 21
+test chan-io-29.30 {Tcl_WriteChars, crlf mode} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -eofchar {}
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    file size $path(test1)
+} -result 25
+test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
+    file delete $path(pipe)
+    file delete $path(output)
+} -constraints {stdio openpipe} -body {
+    set f [open $path(pipe) w]
+    chan puts $f "set f \[[list open $path(output)  w]]"
+    chan puts $f {chan configure $f -translation lf}
+    set x [list while {![chan eof stdin]}]
+    set x "$x {"
+    chan puts $f $x
+    chan puts $f {  chan puts -nonewline $f [chan read stdin 4096]}
+    chan puts $f {  chan flush $f}
+    chan puts $f "}"
+    chan puts $f {chan close $f}
+    chan close $f
+    set x 01234567890123456789012345678901
+    for {set i 0} {$i < 11} {incr i} {
+	set x "$x$x"
+    }
+    set f [open $path(output) w]
+    chan close $f
+    set f [openpipe r+ $path(pipe)]
+    chan configure $f -blocking off
+    chan puts -nonewline $f $x
+    chan close $f
+    set counter 0
+    while {([file size $path(output)] < 65536) && ($counter < 1000)} {
+	after 10 [list incr [namespace which -variable counter]]
+	vwait [namespace which -variable counter]
+    }
+    if {$counter == 1000} {
+	set result "file size only [file size $path(output)]"
+    } else {
+	set result ok
+    }
+    # allow a little time for the background process to chan close.
+    # otherwise, the following test fails on the [file delete $path(output)
+    # on Windows because a process still has the file open.
+    after 100 set v 1; vwait v
+    return $result
+} -result ok
+test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} -setup {
+    file delete $path(pipe)
+    file delete $path(output)
+} -constraints {stdio asyncPipeChan Close openpipe} -body {
+    set f [open $path(pipe) w]
+    chan puts $f "set f \[[list open $path(output) w]]"
+    chan puts $f {chan configure $f -translation lf}
+    set x [list while {![chan eof stdin]}]
+    set x "$x \{"
+    chan puts $f $x
+    chan puts $f {  after 20}
+    chan puts $f {  chan puts -nonewline $f [chan read stdin 1024]}
+    chan puts $f {  chan flush $f}
+    chan puts $f "\}"
+    chan puts $f {chan close $f}
+    chan close $f
+    set x 01234567890123456789012345678901
+    for {set i 0} {$i < 11} {incr i} {
+	set x "$x$x"
+    }
+    set f [open $path(output) w]
+    chan close $f
+    set f [openpipe r+ $path(pipe)]
+    chan configure $f -blocking off
+    chan puts -nonewline $f $x
+    chan close $f
+    set counter 0
+    while {([file size $path(output)] < 65536) && ($counter < 1000)} {
+	after 20 [list incr [namespace which -variable counter]]
+	vwait [namespace which -variable counter]
+    }
+    if {$counter == 1000} {
+	set result "file size only [file size $path(output)]"
+    } else {
+	set result ok
+    }
+} -result ok
+test chan-io-29.33 {Tcl_Flush, implicit flush on exit} -setup {
+    set f [open $path(script) w]
+    chan puts $f "set f \[[list open $path(test1) w]]"
+    chan puts $f {chan configure $f -translation lf
+	chan puts $f hello
+	chan puts $f bye
+	chan puts $f strange
+    }
+    chan close $f
+} -constraints exec -body {
+    exec [interpreter] $path(script)
+    set f [open $path(test1) r]
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\nbye\nstrange\n"
+test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -setup {
+    variable c 0
+    variable x running
+    set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
+    proc writelots {s l} {
+	for {set i 0} {$i < 2000} {incr i} {
+	    chan puts $s $l
+	}
+    }
+} -constraints {socket tempNotMac fileevent} -body {
+    proc accept {s a p} {
+	variable x
+	chan event $s readable [namespace code [list readit $s]]
+	chan configure $s -blocking off
+	set x accepted
+    }
+    proc readit {s} {
+	variable c
+	variable x
+	set l [chan gets $s]
+	if {[chan eof $s]} {
+	    chan close $s
+	    set x done
+	} elseif {([string length $l] > 0) || ![chan blocked $s]} {
+	    incr c
+	}
+    }
+    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]
+    vwait [namespace which -variable x]
+    chan configure $cs -blocking off
+    writelots $cs $l
+    chan close $cs
+    chan close $ss
+    vwait [namespace which -variable x]
+    return $c
+} -result 2000
+test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} -setup {
+    catch {interp delete x}
+    catch {interp delete y}
+} -constraints {socket tempNotMac fileevent} -body {
+    # On Mac, this test screws up sockets such that subsequent tests using
+    # port 2828 either cause errors or panic().
+    interp create x
+    interp create y
+    set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    proc accept {s a p} {
+	chan puts $s hello
+	chan close $s
+    }
+    set c [socket 127.0.0.1 [lindex [chan configure $s -sockname] 2]]
+    interp share {} $c x
+    interp share {} $c y
+    chan close $c
+    x eval {
+	proc readit {s} {
+	    chan gets $s
+	    if {[chan eof $s]} {
+		chan close $s
+	    }
+	}
+    }
+    y eval {
+	proc readit {s} {
+	    chan gets $s
+	    if {[chan eof $s]} {
+		chan close $s
+	    }
+	}
+    }
+    x eval "chan event $c readable \{readit $c\}"
+    y eval "chan event $c readable \{readit $c\}"
+    y eval [list chan close $c]
+    update
+} -cleanup {
+    chan close $s
+    interp delete x
+    interp delete y
+} -result ""
+
+# Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.
+
+test chan-io-30.1 {Tcl_Write lf, Tcl_Read lf} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.2 {Tcl_Write lf, Tcl_Read cr} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.3 {Tcl_Write lf, Tcl_Read crlf} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.4 {Tcl_Write cr, Tcl_Read cr} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.5 {Tcl_Write cr, Tcl_Read lf} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\rthere\rand\rhere\r"
+test chan-io-30.6 {Tcl_Write cr, Tcl_Read crlf} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\rthere\rand\rhere\r"
+test chan-io-30.7 {Tcl_Write crlf, Tcl_Read crlf} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\nthere\nand\nhere\n"
+test chan-io-30.8 {Tcl_Write crlf, Tcl_Read lf} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\r\nthere\r\nand\r\nhere\r\n"
+test chan-io-30.9 {Tcl_Write crlf, Tcl_Read cr} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result "hello\n\nthere\n\nand\n\nhere\n\n"
+test chan-io-30.10 {Tcl_Write lf, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    list [chan read $f] [chan configure $f -translation]
+} -cleanup {
+    chan close $f
+} -result {{hello
+there
+and
+here
+} auto}
+test chan-io-30.11 {Tcl_Write cr, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    list [chan read $f] [chan configure $f -translation]
+} -cleanup {
+    chan close $f
+} -result {{hello
+there
+and
+here
+} auto}
+test chan-io-30.12 {Tcl_Write crlf, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    list [chan read $f] [chan configure $f -translation]
+} -cleanup {
+    chan close $f
+} -result {{hello
+there
+and
+here
+} auto}
+test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    set line "123456789ABCDE"	;# 14 char plus crlf
+    chan puts -nonewline $f x	;# shift crlf across block boundary
+    for {set i 0} {$i < 700} {incr i} {
+	chan puts $f $line
+    }
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto
+    string length [chan read $f]
+} -cleanup {
+    chan close $f
+} -result [expr 700*15+1]
+test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    set line "123456789ABCDE"	;# 14 char plus crlf
+    chan puts -nonewline $f x	;# shift crlf across block boundary
+    for {set i 0} {$i < 700} {incr i} {
+	chan puts $f $line
+    }
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf
+    string length [chan read $f]
+} -cleanup {
+    chan close $f
+} -result [expr 700*15+1]
+test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\nand\rhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result {hello
+there
+and
+here
+}
+test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f hello\nthere\nand\rhere\n\x1a
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result {hello
+there
+and
+here
+}
+test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -constraints {win} -body {
+    set f [open $path(test1) w]
+    chan configure $f -eofchar \x1a -translation lf
+    chan puts $f hello\nthere\nand\rhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result {hello
+there
+and
+here
+}
+test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    set s [format "abc\ndef\n%cghi\nqrs" 26]
+    chan puts $f $s
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    set l ""
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1 {} 1}
+test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    set s [format "abc\ndef\n%cghi\nqrs" 26]
+    chan puts $f $s
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    set l ""
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1 {} 1}
+test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf -eofchar {}
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result "abc def 0 \x1aghi 0 qrs 0 {} 1"
+test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr -eofchar {}
+    set x [chan gets $f]
+    lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {1 1 {} 1}
+test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f [format "abc\ndef\n%cghi\nqrs" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf -eofchar {}
+    set x [chan gets $f]
+    lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {1 1 {} 1}
+test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f [format abc\ndef\n%cqrs\ntuv 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {8 1}
+test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    chan puts $f $c
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf -eofchar \x1a
+    list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {8 1}
+test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    chan puts $f $c
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {8 1}
+test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    chan puts $f $c
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr -eofchar \x1a
+    list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {8 1}
+test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    chan puts $f $c
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {8 1}
+test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    set c [format abc\ndef\n%cqrs\ntuv 26]
+    chan puts $f $c
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf -eofchar \x1a
+    list [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {8 1}
+
+# Test end of line translations. Functions tested are Tcl_Write and
+# Tcl_Gets.
+
+test chan-io-31.1 {Tcl_Write lf, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+} -cleanup {
+    chan close $f
+} -result {hello 6 auto there 12 auto}
+test chan-io-31.2 {Tcl_Write cr, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+} -cleanup {
+    chan close $f
+} -result {hello 6 auto there 12 auto}
+test chan-io-31.3 {Tcl_Write crlf, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+} -cleanup {
+    chan close $f
+} -result {hello 7 auto there 14 auto}
+test chan-io-31.4 {Tcl_Write lf, Tcl_Gets lf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+} -cleanup {
+    chan close $f
+} -result {hello 6 lf there 12 lf}
+test chan-io-31.5 {Tcl_Write lf, Tcl_Gets cr} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr
+    lappend l [string length [chan gets $f]]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {21 21 cr 1 {} 21 cr 1}
+test chan-io-31.6 {Tcl_Write lf, Tcl_Gets crlf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf
+    lappend l [string length [chan gets $f]]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {21 21 crlf 1 {} 21 crlf 1}
+test chan-io-31.7 {Tcl_Write cr, Tcl_Gets cr} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {hello 6 cr 0 there 12 cr 0}
+test chan-io-31.8 {Tcl_Write cr, Tcl_Gets lf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf
+    lappend l [string length [chan gets $f]]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {21 21 lf 1 {} 21 lf 1}
+test chan-io-31.9 {Tcl_Write cr, Tcl_Gets crlf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf
+    lappend l [string length [chan gets $f]]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {21 21 crlf 1 {} 21 crlf 1}
+test chan-io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {hello 7 crlf 0 there 14 crlf 0}
+test chan-io-31.11 {Tcl_Write crlf, Tcl_Gets cr} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+    lappend l [string length [chan gets $f]]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {hello 6 cr 0 6 13 cr 0}
+test chan-io-31.12 {Tcl_Write crlf, Tcl_Gets lf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts $f hello\nthere\nand\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf
+    lappend l [string length [chan gets $f]]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+    lappend l [string length [chan gets $f]]
+    lappend l [chan tell $f]
+    lappend l [chan configure $f -translation]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {6 7 lf 0 6 14 lf 0}
+test chan-io-31.13 {binary mode is synonym of lf mode} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation binary
+    chan configure $f -translation
+} -cleanup {
+    chan close $f
+} -result lf
+#
+# Test chan-io-9.14 has been removed because "auto" output translation mode is
+# not supoprted.
+#
+test chan-io-31.14 {Tcl_Write mixed, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f hello\nthere\rand\r\nhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {hello there and here 0 {} 1}
+test chan-io-31.15 {Tcl_Write mixed, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f hello\nthere\rand\r\nhere\r
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {hello there and here 0 {} 1}
+test chan-io-31.16 {Tcl_Write mixed, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f hello\nthere\rand\r\nhere\n
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {hello there and here 0 {} 1}
+test chan-io-31.17 {Tcl_Write mixed, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f hello\nthere\rand\r\nhere\r\n
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {hello there and here 0 {} 1}
+test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {hello there and here 0 {} 1}
+test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -eofchar \x1a -translation lf
+    chan puts $f hello\nthere\nand\rhere
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {hello there and here 0 {} 1}
+test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a
+    chan configure $f -translation auto
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1}
+test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1}
+test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf -eofchar {}
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr -eofchar {}
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr -eofchar {}
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -eofchar {}
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf -eofchar {}
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1}
+test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf -eofchar \x1a
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1}
+test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr -eofchar {}
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1}
+test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr -eofchar {}
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr -eofchar \x1a
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1}
+test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -eofchar {}
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1}
+test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -eofchar {}
+    chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf -eofchar \x1a
+    lappend l [chan gets $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {abc def 0 {} 1}
+test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} -setup {
+    file delete $path(test1)
+    set c ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    set line "123456789ABCDE"	;# 14 char plus crlf
+    chan puts -nonewline $f x	;# shift crlf across block boundary
+    for {set i 0} {$i < 700} {incr i} {
+	chan puts $f $line
+    }
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf 
+    while {[chan gets $f line] >= 0} {
+	append c $line\n
+    }
+    chan close $f
+    string length $c
+} -result [expr 700*15+1]
+test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
+    file delete $path(test1)
+    set c ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    set line "123456789ABCDE"	;# 14 char plus crlf
+    chan puts -nonewline $f x	;# shift crlf across block boundary
+    for {set i 0} {$i < 700} {incr i} {
+	chan puts $f $line
+    }
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto
+    while {[chan gets $f line] >= 0} {
+	append c $line\n
+    }
+    chan close $f
+    string length $c
+} -result [expr 700*15+1]
+
+# Test Tcl_Read and buffering.
+
+test chan-io-32.1 {Tcl_Read, channel not readable} -body {
+    read stdout
+} -returnCodes error -result {channel "stdout" wasn't opened for reading}
+test chan-io-32.2 {Tcl_Read, zero byte count} {
+    chan read stdin 0
+} ""
+test chan-io-32.3 {Tcl_Read, negative byte count} -setup {
+    set f [open $path(longfile) r]
+} -body {
+    chan read $f -1
+} -returnCodes error -cleanup {
+    chan close $f
+} -result {expected non-negative integer but got "-1"}
+test chan-io-32.4 {Tcl_Read, positive byte count} -body {
+    set f [open $path(longfile) r]
+    string length [chan read $f 1024]
+} -cleanup {
+    chan close $f
+} -result 1024
+test chan-io-32.5 {Tcl_Read, multiple buffers} -body {
+    set f [open $path(longfile) r]
+    chan configure $f -buffersize 100
+    string length [chan read $f 1024]
+} -cleanup {
+    chan close $f
+} -result 1024
+test chan-io-32.6 {Tcl_Read, very large read} {
+    set f1 [open $path(longfile) r]
+    set z [chan read $f1 1000000]
+    chan close $f1
+    set l [string length $z]
+    set x ok
+    set z [file size $path(longfile)]
+    if {$z != $l} {
+	set x "$z != $l"
+    }
+    set x
+} ok
+test chan-io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+    set f1 [open $path(longfile) r]
+    chan configure $f1 -blocking off
+    set z [chan read $f1 20]
+    chan close $f1
+    set l [string length $z]
+    set x ok
+    if {$l != 20} {
+	set x "$l != 20"
+    }
+    set x
+} ok
+test chan-io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
+    set f1 [open $path(longfile) r]
+    chan configure $f1 -blocking off
+    set z [chan read $f1 1000000]
+    chan close $f1
+    set x ok
+    set l [string length $z]
+    set z [file size $path(longfile)]
+    if {$z != $l} {
+	set x "$z != $l"
+    }
+    set x
+} ok
+test chan-io-32.9 {Tcl_Read, read to end of file} {
+    set f1 [open $path(longfile) r]
+    set z [chan read $f1]
+    chan close $f1
+    set l [string length $z]
+    set x ok
+    set z [file size $path(longfile)]
+    if {$z != $l} {
+	set x "$z != $l"
+    }
+    set x
+} ok
+test chan-io-32.10 {Tcl_Read from a pipe} -setup {
+    file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {chan puts [chan gets stdin]}
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    chan puts $f1 hello
+    chan flush $f1
+    chan read $f1
+} -cleanup {
+    chan close $f1
+} -result "hello\n"
+test chan-io-32.11 {Tcl_Read from a pipe} -setup {
+    file delete $path(pipe)
+    set x ""
+} -constraints {stdio openpipe} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {chan puts [chan gets stdin]}
+    chan puts $f1 {chan puts [chan gets stdin]}
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    chan puts $f1 hello
+    chan flush $f1
+    lappend x [chan read $f1 6]
+    chan puts $f1 hello
+    chan flush $f1
+    lappend x [chan read $f1]
+} -cleanup {
+    chan close $f1
+} -result {{hello
+} {hello
+}}
+test chan-io-32.12 {Tcl_Read, -nonewline} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan puts $f1 hello
+    chan puts $f1 bye
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan read -nonewline $f1
+} -cleanup {
+    chan close $f1
+} -result {hello
+bye}
+test chan-io-32.13 {Tcl_Read, -nonewline} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan puts $f1 hello
+    chan puts $f1 bye
+    chan close $f1
+    set f1 [open $path(test1) r]
+    set c [chan read -nonewline $f1]
+    list [string length $c] $c
+} -cleanup {
+    chan close $f1
+} -result {9 {hello
+bye}}
+test chan-io-32.14 {Tcl_Read, reading in small chunks} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan puts $f "Two lines: this one"
+    chan puts $f "and this one"
+    chan close $f
+    set f [open $path(test1)]
+    list [chan read $f 1] [chan read $f 2] [chan read $f]
+} -cleanup {
+    chan close $f
+} -result {T wo { lines: this one
+and this one
+}}
+test chan-io-32.15 {Tcl_Read, asking for more input than available} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan puts $f "Two lines: this one"
+    chan puts $f "and this one"
+    chan close $f
+    set f [open $path(test1)]
+    chan read $f 100
+} -cleanup {
+    chan close $f
+} -result {Two lines: this one
+and this one
+}
+test chan-io-32.16 {Tcl_Read, read to end of file with -nonewline} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan puts $f "Two lines: this one"
+    chan puts $f "and this one"
+    chan close $f
+    set f [open $path(test1)]
+    chan read -nonewline $f
+} -cleanup {
+    chan close $f
+} -result {Two lines: this one
+and this one}
+
+# Test Tcl_Gets.
+
+test chan-io-33.1 {Tcl_Gets, reading what was written} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan puts $f1 "first line"
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan gets $f1
+} -cleanup {
+    chan close $f1
+} -result {first line}
+test chan-io-33.2 {Tcl_Gets into variable} {
+    set f1 [open $path(longfile) r]
+    set c [chan gets $f1 x]
+    set l [string length x]
+    set z ok
+    if {$l != $l} {
+	set z broken
+    }
+    chan close $f1
+    set z
+} ok
+test chan-io-33.3 {Tcl_Gets from pipe} -setup {
+    file delete $path(pipe)
+} -constraints {stdio openpipe} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {chan puts [chan gets stdin]}
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    chan puts $f1 hello
+    chan flush $f1
+    chan gets $f1
+} -cleanup {
+    chan close $f1
+} -result hello
+test chan-io-33.4 {Tcl_Gets with long line} -setup {
+    file delete $path(test3)
+} -body {
+    set f [open $path(test3) w]
+    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    chan puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    chan close $f
+    set f [open $path(test3)]
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+test chan-io-33.5 {Tcl_Gets with long line} {
+    set f [open $path(test3)]
+    set x [chan gets $f y]
+    chan close $f
+    list $x $y
+} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+test chan-io-33.6 {Tcl_Gets and end of file} -setup {
+    file delete $path(test3)
+    set x {}
+} -body {
+    set f [open $path(test3) w]
+    chan puts -nonewline $f "Test1\nTest2"
+    chan close $f
+    set f [open $path(test3)]
+    set y {}
+    lappend x [chan gets $f y] $y
+    set y {}
+    lappend x [chan gets $f y] $y
+    set y {}
+    lappend x [chan gets $f y] $y
+} -cleanup {
+    chan close $f
+} -result {5 Test1 5 Test2 -1 {}}
+test chan-io-33.7 {Tcl_Gets and bad variable} -setup {
+    set f [open $path(test3) w]
+    chan puts $f "Line 1"
+    chan puts $f "Line 2"
+    chan close $f
+    catch {unset x}
+    set f [open $path(test3) r]
+} -body {
+    set x 24
+    chan gets $f x(0)
+} -returnCodes error -cleanup {
+    chan close $f
+} -result {can't set "x(0)": variable isn't array}
+test chan-io-33.8 {Tcl_Gets, exercising double buffering} {
+    set f [open $path(test3) w]
+    chan configure $f -translation lf -eofchar {}
+    set x ""
+    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
+    for {set y 0} {$y < 100} {incr y} {chan puts $f $x}
+    chan close $f
+    set f [open $path(test3) r]
+    chan configure $f -translation lf
+    for {set y 0} {$y < 100} {incr y} {chan gets $f}
+    chan close $f
+    set y
+} 100
+test chan-io-33.9 {Tcl_Gets, exercising double buffering} {
+    set f [open $path(test3) w]
+    chan configure $f -translation lf -eofchar {}
+    set x ""
+    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
+    for {set y 0} {$y < 200} {incr y} {chan puts $f $x}
+    chan close $f
+    set f [open $path(test3) r]
+    chan configure $f -translation lf
+    for {set y 0} {$y < 200} {incr y} {chan gets $f}
+    chan close $f
+    set y
+} 200
+test chan-io-33.10 {Tcl_Gets, exercising double buffering} {
+    set f [open $path(test3) w]
+    chan configure $f -translation lf -eofchar {}
+    set x ""
+    for {set y 0} {$y < 99} {incr y} {set x "a$x"}
+    for {set y 0} {$y < 300} {incr y} {chan puts $f $x}
+    chan close $f
+    set f [open $path(test3) r]
+    chan configure $f -translation lf
+    for {set y 0} {$y < 300} {incr y} {chan gets $f}
+    chan close $f
+    set y
+} 300
+
+# Test Tcl_Seek and Tcl_Tell.
+
+test chan-io-34.1 {Tcl_Seek to current position at start of file} -body {
+    set f1 [open $path(longfile) r]
+    chan seek $f1 0 current
+    chan tell $f1
+} -cleanup {
+    chan close $f1
+} -result 0
+test chan-io-34.2 {Tcl_Seek to offset from start} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan seek $f1 10 start
+    chan tell $f1
+} -cleanup {
+    chan close $f1
+} -result 10
+test chan-io-34.3 {Tcl_Seek to end of file} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan seek $f1 0 end
+    chan tell $f1
+} -cleanup {
+    chan close $f1
+} -result 54
+test chan-io-34.4 {Tcl_Seek to offset from end of file} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan seek $f1 -10 end
+    chan tell $f1
+} -cleanup {
+    chan close $f1
+} -result 44
+test chan-io-34.5 {Tcl_Seek to offset from current position} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan seek $f1 10 current
+    chan seek $f1 10 current
+    chan tell $f1
+} -cleanup {
+    chan close $f1
+} -result 20
+test chan-io-34.6 {Tcl_Seek to offset from end of file} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan seek $f1 -10 end
+    list [chan tell $f1] [chan read $f1]
+} -cleanup {
+    chan close $f1
+} -result {44 {rstuvwxyz
+}}
+test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan seek $f1 -10 end
+    set c1 [chan tell $f1]
+    set r1 [chan read $f1 5]
+    chan seek $f1 0 current
+    list $c1 $r1 [chan tell $f1]
+} -cleanup {
+    chan close $f1
+} -result {44 rstuv 49}
+test chan-io-34.8 {Tcl_Seek on pipes: not supported} -setup {
+    set pipe [openpipe]
+} -constraints {stdio openpipe} -body {
+    chan seek $pipe 0 current
+} -returnCodes error -cleanup {
+    chan close $pipe
+} -match glob -result {error during seek on "*": invalid argument}
+test chan-io-34.9 {Tcl_Seek, testing buffered input flushing} -setup {
+    file delete $path(test3)
+} -body {
+    set f [open $path(test3) w]
+    chan configure $f -eofchar {}
+    chan puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+    chan close $f
+    set f [open $path(test3) RDWR]
+    set x [chan read $f 1]
+    chan seek $f 3
+    lappend x [chan read $f 1]
+    chan seek $f 0 start
+    lappend x [chan read $f 1]
+    chan seek $f 10 current
+    lappend x [chan read $f 1]
+    chan seek $f -2 end
+    lappend x [chan read $f 1]
+    chan seek $f 50 end
+    lappend x [chan read $f 1]
+    chan seek $f 1
+    lappend x [chan read $f 1]
+} -cleanup {
+    chan close $f
+} -result {a d a l Y {} b}
+set path(test3) [makeFile {} test3]
+test chan-io-34.10 {Tcl_Seek testing flushing of buffered input} {
+    set f [open $path(test3) w]
+    chan configure $f -translation lf
+    chan puts $f xyz\n123
+    chan close $f
+    set f [open $path(test3) r+]
+    chan configure $f -translation lf
+    set x [chan gets $f]
+    chan seek $f 0 current
+    chan puts $f 456
+    chan close $f
+    list $x [viewFile test3]
+} "xyz {xyz
+456}"
+test chan-io-34.11 {Tcl_Seek testing flushing of buffered output} {
+    set f [open $path(test3) w]
+    chan puts $f xyz\n123
+    chan close $f
+    set f [open $path(test3) w+]
+    chan puts $f xyzzy
+    chan seek $f 2
+    set x [chan gets $f]
+    chan close $f
+    list $x [viewFile test3]
+} "zzy xyzzy"
+test chan-io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
+    set f [open $path(test3) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f xyz\n123
+    chan close $f
+    set f [open $path(test3) a+]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f xyzzy
+    chan flush $f
+    set x [chan tell $f]
+    chan seek $f -4 cur
+    set y [chan gets $f]
+    chan close $f
+    list $x [viewFile test3] $y
+} {14 {xyz
+123
+xyzzy} zzy}
+test chan-io-34.13 {Tcl_Tell at start of file} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan tell $f1
+} -cleanup {
+    chan close $f1
+} -result 0
+test chan-io-34.14 {Tcl_Tell after seek to end of file} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan seek $f1 0 end
+    chan tell $f1
+} -cleanup {
+    chan close $f1
+} -result 54
+test chan-io-34.15 {Tcl_Tell combined with seeking} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -eofchar {}
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan puts $f1 "abcdefghijklmnopqrstuvwxyz"
+    chan close $f1
+    set f1 [open $path(test1) r]
+    chan seek $f1 10 start
+    set c1 [chan tell $f1]
+    chan seek $f1 10 current
+    list $c1 [chan tell $f1]
+} -cleanup {
+    chan close $f1
+} -result {10 20}
+test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints {stdio openpipe} -body {
+    set f1 [openpipe]
+    chan tell $f1
+} -cleanup {
+    chan close $f1
+} -result -1
+test chan-io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+    set f1 [openpipe]
+    chan puts $f1 {chan puts hello}
+    chan flush $f1
+    set c [chan tell $f1]
+    chan gets $f1
+    chan close $f1
+    set c
+} -1
+test chan-io-34.18 {Tcl_Tell combined with seeking and reading} -setup {
+    file delete $path(test2)
+} -body {
+    set f [open $path(test2) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n"
+    chan close $f
+    set f [open $path(test2)]
+    chan configure $f -translation lf
+    set x [chan tell $f]
+    chan read $f 3
+    lappend x [chan tell $f]
+    chan seek $f 2
+    lappend x [chan tell $f]
+    chan seek $f 10 current
+    lappend x [chan tell $f]
+    chan seek $f 0 end
+    lappend x [chan tell $f]
+} -cleanup {
+    chan close $f
+} -result {0 3 2 12 30}
+test chan-io-34.19 {Tcl_Tell combined with opening in append mode} -body {
+    set f [open $path(test3) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f "abcdefghijklmnopqrstuvwxyz"
+    chan puts $f "abcdefghijklmnopqrstuvwxyz"
+    chan close $f
+    set f [open $path(test3) a]
+    chan tell $f
+} -cleanup {
+    chan close $f
+} -result 54
+test chan-io-34.20 {Tcl_Tell combined with writing} -setup {
+    set l ""
+} -body {
+    set f [open $path(test3) w]
+    chan seek $f 29 start
+    lappend l [chan tell $f]
+    chan puts -nonewline $f a
+    chan seek $f 39 start
+    lappend l [chan tell $f]
+    chan puts -nonewline $f a
+    lappend l [chan tell $f]
+    chan seek $f 407 end
+    lappend l [chan tell $f]
+} -cleanup {
+    chan close $f
+} -result {29 39 40 447}
+test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} -setup {
+    file delete $path(test3)
+    set l ""
+} -constraints {largefileSupport} -body {
+    set f [open $path(test3) w]
+    chan configure $f -encoding binary
+    lappend l [chan tell $f]
+    chan puts -nonewline $f abcdef
+    lappend l [chan tell $f]
+    chan flush $f
+    lappend l [chan tell $f]
+    # 4GB offset!
+    chan seek $f 0x100000000
+    lappend l [chan tell $f]
+    chan puts -nonewline $f abcdef
+    lappend l [chan tell $f]
+    chan close $f
+    lappend l [file size $f]
+    # truncate...
+    chan close [open $path(test3) w]
+    lappend l [file size $f]
+} -result {0 6 6 4294967296 4294967302 4294967302 0}
+
+# Test Tcl_Eof
+
+test chan-io-35.1 {Tcl_Eof} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan puts $f hello
+    chan puts $f hello
+    chan close $f
+    set f [open $path(test1)]
+    set x [chan eof $f]
+    lappend x [chan eof $f]
+    chan gets $f
+    lappend x [chan eof $f]
+    chan gets $f
+    lappend x [chan eof $f]
+    chan gets $f
+    lappend x [chan eof $f]
+    lappend x [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {0 0 0 0 1 1}
+test chan-io-35.2 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
+    file delete $path(pipe)
+} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {chan gets stdin}
+    chan puts $f1 {chan puts hello}
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    chan puts $f1 hello
+    set x [chan eof $f1]
+    chan flush $f1
+    lappend x [chan eof $f1]
+    chan gets $f1
+    lappend x [chan eof $f1]
+    chan gets $f1
+    lappend x [chan eof $f1]
+} -cleanup {
+    chan close $f1
+} -result {0 0 0 1}
+test chan-io-35.3 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
+    file delete $path(pipe)
+} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {chan gets stdin}
+    chan puts $f1 {chan puts hello}
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    chan puts $f1 hello
+    set x [chan eof $f1]
+    chan flush $f1
+    lappend x [chan eof $f1]
+    chan gets $f1
+    lappend x [chan eof $f1]
+    chan gets $f1
+    lappend x [chan eof $f1]
+    chan gets $f1
+    lappend x [chan eof $f1]
+    chan gets $f1
+    lappend x [chan eof $f1]
+} -cleanup {
+    chan close $f1
+} -result {0 0 0 1 1 1}
+test chan-io-35.4 {Tcl_Eof, eof detection on nonblocking file} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {nonBlockFiles} -body {
+    chan close [open $path(test1) w]
+    set f [open $path(test1) r]
+    chan configure $f -blocking off
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {{} 1}
+test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} -setup {
+    file delete $path(pipe)
+    set l ""
+} -constraints {stdio openpipe} -body {
+    set f [open $path(pipe) w]
+    chan puts $f {
+	exit
+    }
+    chan close $f
+    set f [openpipe r $path(pipe)]
+    lappend l [chan gets $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {{} 1}
+test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar \x1a
+    chan puts $f abc\ndef
+    chan close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {9 8 1}
+test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar \x1a
+    chan puts $f abc\ndef
+    chan close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation lf -eofchar \x1a
+    list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {9 8 1}
+test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr -eofchar \x1a
+    chan puts $f abc\ndef
+    chan close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {9 8 1}
+test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr -eofchar \x1a
+    chan puts $f abc\ndef
+    chan close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation cr -eofchar \x1a
+    list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {9 8 1}
+test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -eofchar \x1a
+    chan puts $f abc\ndef
+    chan close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {11 8 1}
+test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -eofchar \x1a
+    chan puts $f abc\ndef
+    chan close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf -eofchar \x1a
+    list $s [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {11 8 1}
+test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
+    chan close $f
+    set c [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {17 8 1}
+test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
+    chan close $f
+    set c [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation lf -eofchar \x1a
+    list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {17 8 1}
+test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr -eofchar {}
+    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
+    chan close $f
+    set c [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {17 8 1}
+test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr -eofchar {}
+    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
+    chan close $f
+    set c [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation cr -eofchar \x1a
+    list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {17 8 1}
+test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -eofchar {}
+    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
+    chan close $f
+    set c [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {21 8 1}
+test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf -eofchar {}
+    chan puts $f [format abc\ndef\n%cqrs\nuvw 26]
+    chan close $f
+    set c [file size $path(test1)]
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf -eofchar \x1a
+    list $c [string length [chan read $f]] [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {21 8 1}
+
+# Test Tcl_InputBlocked
+
+test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup {
+    set x ""
+} -constraints {stdio openpipe} -body {
+    set f1 [openpipe]
+    chan puts $f1 {chan puts hello_from_pipe}
+    chan flush $f1
+    chan gets $f1
+    chan configure $f1 -blocking off -buffering full
+    chan puts $f1 {chan puts hello}
+    lappend x [chan gets $f1]
+    lappend x [chan blocked $f1]
+    chan flush $f1
+    after 200
+    lappend x [chan gets $f1]
+    lappend x [chan blocked $f1]
+    lappend x [chan gets $f1]
+    lappend x [chan blocked $f1]
+} -cleanup {
+    chan close $f1
+} -result {{} 1 hello 0 {} 1}
+test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} -setup {
+    set x ""
+} -constraints {stdio openpipe} -body {
+    set f1 [openpipe]
+    chan configure $f1 -buffering line
+    chan puts $f1 {chan puts hello_from_pipe}
+    lappend x [chan gets $f1]
+    lappend x [chan blocked $f1]
+    chan puts $f1 {exit}
+    lappend x [chan gets $f1]
+    lappend x [chan blocked $f1]
+    lappend x [chan eof $f1]
+} -cleanup {
+    chan close $f1
+} -result {hello_from_pipe 0 {} 0 1}
+test chan-io-36.3 {Tcl_InputBlocked vs files, short read} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan puts $f abcdefghijklmnop
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [chan blocked $f]
+    lappend l [chan read $f 3]
+    lappend l [chan blocked $f]
+    lappend l [chan read -nonewline $f]
+    lappend l [chan blocked $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {0 abc 0 defghijklmnop 0 1}
+test chan-io-36.4 {Tcl_InputBlocked vs files, event driven read} -setup {
+    file delete $path(test1)
+    set l ""
+    variable x
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan puts $f abcdefghijklmnop
+    chan close $f
+    set f [open $path(test1) r]
+    chan event $f readable [namespace code {
+	lappend l [chan read $f 3]
+	if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
+    }]
+    vwait [namespace which -variable x]
+    return $l
+} -result {abc def ghi jkl mno {p
+} eof}
+test chan-io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {nonBlockFiles} -body {
+    set f [open $path(test1) w]
+    chan puts $f abcdefghijklmnop
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -blocking off
+    lappend l [chan blocked $f]
+    lappend l [chan read $f 3]
+    lappend l [chan blocked $f]
+    lappend l [chan read -nonewline $f]
+    lappend l [chan blocked $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result {0 abc 0 defghijklmnop 0 1}
+test chan-io-36.6 {Tcl_InputBlocked vs files, event driven read} -setup {
+    file delete $path(test1)
+    set l ""
+    variable x
+} -constraints {nonBlockFiles fileevent} -body {
+    set f [open $path(test1) w]
+    chan puts $f abcdefghijklmnop
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -blocking off
+    chan event $f readable [namespace code {
+	lappend l [chan read $f 3]
+	if {[chan eof $f]} {lappend l eof; chan close $f; set x done}
+    }]
+    vwait [namespace which -variable x]
+    return $l
+} -result {abc def ghi jkl mno {p
+} eof}
+
+# Test Tcl_InputBuffered
+
+test chan-io-37.1 {Tcl_InputBuffered} -setup {
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(longfile) r]
+    chan configure $f -buffersize 4096
+    chan read $f 3
+    lappend l [testchannel inputbuffered $f]
+    lappend l [chan tell $f]
+} -cleanup {
+    chan close $f
+} -result {4093 3}
+test chan-io-37.2 {Tcl_InputBuffered, test input flushing on seek} -setup {
+    set l ""
+} -constraints {testchannel} -body {
+    set f [open $path(longfile) r]
+    chan configure $f -buffersize 4096
+    chan read $f 3
+    lappend l [testchannel inputbuffered $f]
+    lappend l [chan tell $f]
+    chan seek $f 0 current
+    lappend l [testchannel inputbuffered $f]
+    lappend l [chan tell $f]
+} -cleanup {
+    chan close $f
+} -result {4093 3 0 3}
+
+# Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize
+
+test chan-io-38.1 {Tcl_GetChannelBufferSize, default buffer size} -body {
+    set f [open $path(longfile) r]
+    chan configure $f -buffersize
+} -cleanup {
+    chan close $f
+} -result 4096
+test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} -setup {
+    set l ""
+} -body {
+    set f [open $path(longfile) r]
+    lappend l [chan configure $f -buffersize]
+    chan configure $f -buffersize 10000
+    lappend l [chan configure $f -buffersize]
+    chan configure $f -buffersize 1
+    lappend l [chan configure $f -buffersize]
+    chan configure $f -buffersize -1
+    lappend l [chan configure $f -buffersize]
+    chan configure $f -buffersize 0
+    lappend l [chan configure $f -buffersize]
+    chan configure $f -buffersize 100000
+    lappend l [chan configure $f -buffersize]
+    chan configure $f -buffersize 10000000
+    lappend l [chan configure $f -buffersize]
+} -cleanup {
+    chan close $f
+} -result {4096 10000 1 1 1 100000 1048576}
+test chan-io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
+    # This test crashes the interp if Bug #427196 is not fixed
+    set chan [open [info script] r]
+    chan configure $chan -buffersize 10
+    set var [chan read $chan 2]
+    chan configure $chan -buffersize 32
+    append var [chan read $chan]
+    chan close $chan
+} {}
+
+# Test Tcl_SetChannelOption, Tcl_GetChannelOption
+
+test chan-io-39.1 {Tcl_GetChannelOption} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -blocking
+} -cleanup {
+    chan close $f1
+} -result 1
+#
+# Test 17.2 was removed.
+#
+test chan-io-39.2 {Tcl_GetChannelOption} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -buffering
+} -cleanup {
+    chan close $f1
+} -result full
+test chan-io-39.3 {Tcl_GetChannelOption} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -buffering line
+    chan configure $f1 -buffering
+} -cleanup {
+    chan close $f1
+} -result line
+test chan-io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f1 [open $path(test1) w]
+    lappend l [chan configure $f1 -buffering]
+    chan configure $f1 -buffering line
+    lappend l [chan configure $f1 -buffering]
+    chan configure $f1 -buffering none
+    lappend l [chan configure $f1 -buffering]
+    chan configure $f1 -buffering line
+    lappend l [chan configure $f1 -buffering]
+    chan configure $f1 -buffering full
+    lappend l [chan configure $f1 -buffering]
+} -cleanup {
+    chan close $f1
+} -result {full line none line full}
+test chan-io-39.5 {Tcl_GetChannelOption, invariance} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f1 [open $path(test1) w]
+    lappend l [chan configure $f1 -buffering]
+    lappend l [list [catch {chan configure $f1 -buffering green} msg] $msg]
+    lappend l [chan configure $f1 -buffering]
+} -cleanup {
+    chan close $f1
+} -result {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
+test chan-io-39.6 {Tcl_SetChannelOption, multiple options} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -buffering line
+    chan puts $f1 hello
+    chan puts $f1 bye
+    file size $path(test1)
+} -cleanup {
+    chan close $f1
+} -result 10
+test chan-io-39.7 {Tcl_SetChannelOption, buffering, translation} -setup {
+    file delete $path(test1)
+    set x ""
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf
+    chan puts $f1 hello
+    chan puts $f1 bye
+    chan configure $f1 -buffering line
+    lappend x [file size $path(test1)]
+    chan puts $f1 really_bye
+    lappend x [file size $path(test1)]
+} -cleanup {
+    chan close $f1
+} -result {0 21}
+test chan-io-39.8 {Tcl_SetChannelOption, different buffering options} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f1 [open $path(test1) w]
+    chan configure $f1 -translation lf -buffering none -eofchar {}
+    chan puts -nonewline $f1 hello
+    lappend l [file size $path(test1)]
+    chan puts -nonewline $f1 hello
+    lappend l [file size $path(test1)]
+    chan configure $f1 -buffering full
+    chan puts -nonewline $f1 hello
+    lappend l [file size $path(test1)]
+    chan configure $f1 -buffering none
+    lappend l [file size $path(test1)]
+    chan puts -nonewline $f1 hello
+    lappend l [file size $path(test1)]
+    chan close $f1
+    lappend l [file size $path(test1)]
+} -result {5 10 10 10 20 20}
+test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} -setup {
+    file delete $path(test1)
+    set x ""
+} -constraints {nonBlockFiles} -body {
+    set f1 [open $path(test1) w]
+    chan close $f1
+    set f1 [open $path(test1) r]
+    lappend x [chan configure $f1 -blocking]
+    chan configure $f1 -blocking off
+    lappend x [chan configure $f1 -blocking]
+    lappend x [chan gets $f1]
+    lappend x [chan read $f1 1000]
+    lappend x [chan blocked $f1]
+    lappend x [chan eof $f1]
+} -cleanup {
+    chan close $f1
+} -result {1 0 {} {} 0 1}
+test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} -setup {
+    file delete $path(pipe)
+    set x ""
+} -constraints {stdio openpipe} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {
+	chan gets stdin
+	after 100
+	chan puts hi
+	chan gets stdin
+    }
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    chan configure $f1 -blocking off -buffering line
+    lappend x [chan configure $f1 -blocking]
+    lappend x [chan gets $f1]
+    lappend x [chan blocked $f1]
+    chan configure $f1 -blocking on
+    chan puts $f1 hello
+    chan configure $f1 -blocking off
+    lappend x [chan gets $f1]
+    lappend x [chan blocked $f1]
+    chan configure $f1 -blocking on
+    chan puts $f1 bye
+    chan configure $f1 -blocking off
+    lappend x [chan gets $f1]
+    lappend x [chan blocked $f1]
+    chan configure $f1 -blocking on
+    lappend x [chan configure $f1 -blocking]
+    lappend x [chan gets $f1]
+    lappend x [chan blocked $f1]
+    lappend x [chan eof $f1]
+    lappend x [chan gets $f1]
+    lappend x [chan eof $f1]
+} -cleanup {
+    chan close $f1
+} -result {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
+test chan-io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -buffersize -10
+    chan configure $f -buffersize
+} -cleanup {
+    chan close $f
+} -result 1
+test chan-io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -buffersize 10000000
+    chan configure $f -buffersize
+} -cleanup {
+    chan close $f
+} -result 1048576
+test chan-io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -buffersize 40000
+    chan configure $f -buffersize
+} -cleanup {
+    chan close $f
+} -result 40000
+test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -encoding {} 
+    chan puts -nonewline $f \xe7\x89\xa6
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -encoding utf-8
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result \u7266
+test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
+    file delete $path(test1)
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -encoding binary
+    chan puts -nonewline $f \xe7\x89\xa6
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -encoding utf-8
+    chan read $f
+} -cleanup {
+    chan close $f
+} -result \u7266
+test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+} -body {
+    chan configure $f -encoding foobar
+} -returnCodes error -cleanup {
+    chan close $f
+} -result {unknown encoding "foobar"}
+test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup {
+    variable x {}
+} -constraints {stdio openpipe fileevent} -body {
+    set f [openpipe r+ $path(cat)]
+    chan configure $f -encoding binary
+    chan puts -nonewline $f "\xe7"
+    chan flush $f
+    chan configure $f -encoding utf-8 -blocking 0
+    chan event $f readable [namespace code { lappend x [chan read $f] }]
+    vwait [namespace which -variable x]
+    after 300 [namespace code { lappend x timeout }]
+    vwait [namespace which -variable x]
+    chan configure $f -encoding utf-8
+    vwait [namespace which -variable x]
+    after 300 [namespace code { lappend x timeout }]
+    vwait [namespace which -variable x]
+    chan configure $f -encoding binary
+    vwait [namespace which -variable x]
+    after 300 [namespace code { lappend x timeout }]
+    vwait [namespace which -variable x]
+    return $x
+} -cleanup {
+    chan close $f
+} -result "{} timeout {} timeout \xe7 timeout"
+test chan-io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
+	-constraints {socket} -body {
+    proc accept {s a p} {chan close $s}
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set port [lindex [chan configure $s1 -sockname] 2]
+    set s2 [socket 127.0.0.1 $port]
+    update
+    chan configure $s2 -translation {auto lf}
+    chan configure $s2 -translation
+} -cleanup {
+    chan close $s1
+    chan close $s2
+} -result {auto lf}
+test chan-io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
+	-constraints {socket} -body {
+    proc accept {s a p} {chan close $s}
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set port [lindex [chan configure $s1 -sockname] 2]
+    set s2 [socket 127.0.0.1 $port]
+    update
+    chan configure $s2 -translation {auto crlf}
+    chan configure $s2 -translation
+} -cleanup {
+    chan close $s1
+    chan close $s2
+} -result {auto crlf}
+test chan-io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
+	-constraints {socket} -body {
+    proc accept {s a p} {chan close $s}
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set port [lindex [chan configure $s1 -sockname] 2]
+    set s2 [socket 127.0.0.1 $port]
+    update
+    chan configure $s2 -translation {auto cr}
+    chan configure $s2 -translation
+} -cleanup {
+    chan close $s1
+    chan close $s2
+} -result {auto cr}
+test chan-io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
+	-constraints {socket} -body {
+    proc accept {s a p} {chan close $s}
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set port [lindex [chan configure $s1 -sockname] 2]
+    set s2 [socket 127.0.0.1 $port]
+    update
+    chan configure $s2 -translation {auto auto}
+    chan configure $s2 -translation
+} -cleanup {
+    chan close $s1
+    chan close $s2
+} -result {auto crlf}
+test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
+    file delete $path(test1)
+    set l ""
+} -constraints {unix} -body {
+    set f1 [open $path(test1) w+]
+    lappend l [chan configure $f1 -eofchar]
+    chan configure $f1 -eofchar {ON GO}
+    lappend l [chan configure $f1 -eofchar]
+    chan configure $f1 -eofchar D
+    lappend l [chan configure $f1 -eofchar]
+} -cleanup {
+    chan close $f1
+} -result {{{} {}} {O G} {D D}}
+test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
+    file delete $path(test1)
+    set l [list]
+} -body {
+    set f1 [open $path(test1) w+]
+    chan configure $f1 -eofchar {ON GO}
+    lappend l [chan configure $f1 -eofchar]
+    chan configure $f1 -eofchar D
+    lappend l [chan configure $f1 -eofchar]
+    lappend l [list [catch {chan configure $f1 -eofchar {1 2 3}} msg] $msg]
+} -cleanup {
+    chan close $f1
+} -result {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}}
+test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\
+        writeable, it should still have valid -eofchar and -translation options} -setup {
+    set l [list]
+} -body {
+    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    lappend l [chan configure $sock -eofchar] \
+	[chan configure $sock -translation]
+} -cleanup {
+    chan close $sock
+} -result {{{}} auto}
+test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\
+        writable so we can't change -eofchar or -translation} -setup {
+    set l [list]
+} -body { 
+    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    chan configure $sock -eofchar D -translation lf
+    lappend l [chan configure $sock -eofchar] \
+	[chan configure $sock -translation]
+} -cleanup {
+    chan close $sock
+} -result {{{}} auto}
+
+test chan-io-40.1 {POSIX open access modes: RDWR} -setup {
+    file delete $path(test3)
+} -body {
+    set f [open $path(test3) w]
+    chan puts $f xyzzy
+    chan close $f
+    set f [open $path(test3) RDWR]
+    chan puts -nonewline $f "ab"
+    chan seek $f 0 current
+    set x [chan gets $f]
+    chan close $f
+    set f [open $path(test3) r]
+    lappend x [chan gets $f]
+} -cleanup {
+    chan close $f
+} -result {zzy abzzy}
+test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
+    file delete $path(test3)
+} -constraints {unix} -body {
+    set f [open $path(test3) {WRONLY CREAT} 0600]
+    file stat $path(test3) stats
+    set x [format "0%o" [expr $stats(mode)&0o777]]
+    chan puts $f "line 1"
+    chan close $f
+    set f [open $path(test3) r]
+    lappend x [chan gets $f]
+} -cleanup {
+    chan close $f
+} -result {0600 {line 1}}
+test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
+    file delete $path(test3)
+} -constraints {unix umask} -body {
+    # This test only works if your umask is 2, like ouster's.
+    chan close [open $path(test3) {WRONLY CREAT}]
+    file stat $path(test3) stats
+    format "0%o" [expr $stats(mode)&0o777]
+} -result [format %04o [expr {0o666 & ~ $umaskValue}]]
+test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
+    file delete $path(test3)
+} -body {
+    set f [open $path(test3) w]
+    chan configure $f -eofchar {}
+    chan puts $f xyzzy
+    chan close $f
+    set f [open $path(test3) {WRONLY CREAT}]
+    chan configure $f -eofchar {}
+    chan puts -nonewline $f "ab"
+    chan close $f
+    set f [open $path(test3) r]
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result abzzy
+test chan-io-40.5 {POSIX open access modes: APPEND} -setup {
+    file delete $path(test3)
+    set x ""
+} -body {
+    set f [open $path(test3) w]
+    chan configure $f -translation lf -eofchar {}
+    chan puts $f xyzzy
+    chan close $f
+    set f [open $path(test3) {WRONLY APPEND}]
+    chan configure $f -translation lf
+    chan puts $f "new line"
+    chan seek $f 0
+    chan puts $f "abc"
+    chan close $f
+    set f [open $path(test3) r]
+    chan configure $f -translation lf
+    chan seek $f 6 current
+    lappend x [chan gets $f]
+    lappend x [chan gets $f]
+} -cleanup {
+    chan close $f
+} -result {{new line} abc}
+test chan-io-40.6 {POSIX open access modes: EXCL} -match regexp -setup {
+    file delete $path(test3)
+} -body {
+    set f [open $path(test3) w]
+    chan puts $f xyzzy
+    chan close $f
+    open $path(test3) {WRONLY CREAT EXCL}
+} -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists}
+test chan-io-40.7 {POSIX open access modes: EXCL} -setup {
+    file delete $path(test3)
+} -body {
+    set f [open $path(test3) {WRONLY CREAT EXCL}]
+    chan configure $f -eofchar {}
+    chan puts $f "A test line"
+    chan close $f
+    viewFile test3
+} -result {A test line}
+test chan-io-40.8 {POSIX open access modes: TRUNC} -setup {
+    file delete $path(test3)
+} -body {
+    set f [open $path(test3) w]
+    chan puts $f xyzzy
+    chan close $f
+    set f [open $path(test3) {WRONLY TRUNC}]
+    chan puts $f abc
+    chan close $f
+    set f [open $path(test3) r]
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result abc
+test chan-io-40.9 {POSIX open access modes: NONBLOCK} -setup {
+    file delete $path(test3)
+} -constraints {nonPortable unix} -body {
+    set f [open $path(test3) {WRONLY NONBLOCK CREAT}]
+    chan puts $f "NONBLOCK test"
+    chan close $f
+    set f [open $path(test3) r]
+    chan gets $f
+} -cleanup {
+    chan close $f
+} -result {NONBLOCK test}
+test chan-io-40.10 {POSIX open access modes: RDONLY} -body {
+    set f [open $path(test1) w]
+    chan puts $f "two lines: this one"
+    chan puts $f "and this"
+    chan close $f
+    set f [open $path(test1) RDONLY]
+    list [chan gets $f] [catch {chan puts $f Test} msg] $msg
+} -cleanup {
+    chan close $f
+} -match glob -result {{two lines: this one} 1 {channel "*" wasn't opened for writing}}
+test chan-io-40.11 {POSIX open access modes: RDONLY} -match regexp -body {
+    file delete $path(test3)
+    open $path(test3) RDONLY
+} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
+test chan-io-40.12 {POSIX open access modes: WRONLY} -match regexp -body {
+    file delete $path(test3)
+    open $path(test3) WRONLY
+} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
+test chan-io-40.13 {POSIX open access modes: WRONLY} -body {
+    makeFile xyzzy test3
+    set f [open $path(test3) WRONLY]
+    chan configure $f -eofchar {}
+    chan puts -nonewline $f "ab"
+    chan seek $f 0 current
+    set x [list [catch {chan gets $f} msg] $msg]
+    chan close $f
+    lappend x [viewFile test3]
+} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy} 
+test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body {
+    file delete $path(test3)
+    open $path(test3) RDWR
+} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
+test chan-io-40.15 {POSIX open access modes: RDWR} {
+    makeFile xyzzy test3
+    set f [open $path(test3) RDWR]
+    chan puts -nonewline $f "ab"
+    chan seek $f 0 current
+    set x [chan gets $f]
+    chan close $f
+    lappend x [viewFile test3]
+} {zzy abzzy}
+test chan-io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup {
+    makeFile {Some text} _test_ ~
+} -body {
+    file exists [file join $::env(HOME) _test_]
+} -cleanup {
+    removeFile _test_ ~
+} -result 1
+test chan-io-40.17 {tilde substitution in open} -setup {
+    set home $::env(HOME)
+} -body {
+    unset ::env(HOME)
+    open ~/foo
+} -returnCodes error -cleanup {
+    set ::env(HOME) $home
+} -result {couldn't find HOME environment variable to expand path}
+
+test chan-io-41.1 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+    chan event foo
+} -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"}
+test chan-io-41.2 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+    chan event foo bar baz q
+} -returnCodes error -result {wrong # args: should be "chan event channelId event ?script?"}
+test chan-io-41.3 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+    chan event gorp readable
+} -returnCodes error -result {can not find channel named "gorp"}
+test chan-io-41.4 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+    chan event gorp writable
+} -returnCodes error -result {can not find channel named "gorp"}
+test chan-io-41.5 {Tcl_FileeventCmd: errors} -constraints fileevent -body {
+    chan event gorp who-knows
+} -returnCodes error -result {bad event name "who-knows": must be readable or writable}
+
+#
+# Test chan event on a file
+#
+
+set path(foo) [makeFile {} foo]
+set f [open $path(foo) w+]
+
+test chan-io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} {fileevent} {
+    list [chan event $f readable] [chan event $f writable]
+} {{} {}}
+test chan-io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} {
+    set result {}
+    chan event $f r "first script"
+    lappend result [chan event $f readable]
+    chan event $f r "new script"
+    lappend result [chan event $f readable]
+    chan event $f r "yet another"
+    lappend result [chan event $f readable]
+    chan event $f r ""
+    lappend result [chan event $f readable]
+} {{first script} {new script} {yet another} {}}
+test chan-io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
+    set result {}
+    chan event $f r "first scr\0ipt"
+    lappend result [string length [chan event $f readable]]
+    chan event $f r "new scr\0ipt"
+    lappend result [string length [chan event $f readable]]
+    chan event $f r "yet ano\0ther"
+    lappend result [string length [chan event $f readable]]
+    chan event $f r ""
+    lappend result [chan event $f readable]
+} {13 11 12 {}}
+
+test chan-io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} {
+    set result {}
+    chan event $f readable "script 1"
+    lappend result [chan event $f readable] [chan event $f writable]
+    chan event $f writable "write script"
+    lappend result [chan event $f readable] [chan event $f writable]
+    chan event $f readable {}
+    lappend result [chan event $f readable] [chan event $f writable]
+    chan event $f writable {}
+    lappend result [chan event $f readable] [chan event $f writable]
+} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
+test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
+    set result {}
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
+    chan event $f r "chan read f"
+    chan event $f2 r "chan read f2"
+    chan event $f3 r "chan read f3"
+    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
+    chan event $f2 r {}
+    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
+    chan event $f3 r {}
+    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
+    chan event $f r {}
+    lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
+} -cleanup {
+    catch {chan close $f2}
+    catch {chan close $f3}
+} -result {{} {} {} {chan read f} {chan read f2} {chan read f3} {chan read f} {} {chan read f3} {chan read f} {} {} {} {} {}}
+
+test chan-io-44.1 {FileEventProc procedure: normal read event} -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+    chan event $f2 readable [namespace code {
+	set x [chan gets $f2]; chan event $f2 readable {}
+    }]
+    chan puts $f2 text; chan flush $f2
+    variable x initial
+    vwait [namespace which -variable x]
+    return $x
+} -cleanup {
+    catch {chan close $f2}
+    catch {chan close $f3}
+} -result {text}
+test chan-io-44.2 {FileEventProc procedure: error in read event} -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
+    proc myHandler {msg options} {
+	variable x $msg
+    }
+    set handler [interp bgerror {}]
+    interp bgerror {} [namespace which myHandler]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+    chan event $f2 readable {error bogus}
+    chan puts $f2 text; chan flush $f2
+    variable x initial
+    vwait [namespace which -variable x]
+    list $x [chan event $f2 readable]
+} -cleanup {
+    interp bgerror {} $handler
+    catch {chan close $f2}
+    catch {chan close $f3}
+} -result {bogus {}}
+test chan-io-44.3 {FileEventProc procedure: normal write event} -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+    chan event $f2 writable [namespace code {
+	lappend x "triggered"
+	incr count -1
+	if {$count <= 0} {
+	    chan event $f2 writable {}
+	}
+    }]
+    variable x initial
+    set count 3
+    vwait [namespace which -variable x]
+    vwait [namespace which -variable x]
+    vwait [namespace which -variable x]
+    return $x
+} -cleanup {
+    catch {chan close $f2}
+    catch {chan close $f3}
+} -result {initial triggered triggered triggered}
+test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
+    proc myHandler {msg options} {
+	variable x $msg
+    }
+    set handler [interp bgerror {}]
+    interp bgerror {} [namespace which myHandler]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
+    chan event $f2 writable {error bad-write}
+    variable x initial
+    vwait [namespace which -variable x]
+    list $x [chan event $f2 writable]
+} -cleanup {
+    interp bgerror {} $handler
+    catch {chan close $f2}
+    catch {chan close $f3}
+} -result {bad-write {}}
+test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+    set f4 [openpipe r $path(cat) << foo]
+    chan event $f4 readable [namespace code {
+	if {[chan gets $f4 line] < 0} {
+	    lappend x eof
+	    chan event $f4 readable {}
+	} else {
+	    lappend x $line
+	}
+    }]
+    variable x initial
+    vwait [namespace which -variable x]
+    vwait [namespace which -variable x]
+    chan close $f4
+    set x
+} {initial foo eof}
+
+chan close $f
+makeFile "foo bar" foo
+
+test chan-io-45.1 {DeleteFileEvent, cleanup on chan close} {fileevent} {
+    set f [open $path(foo) r]
+    chan event $f readable [namespace code {
+	lappend x "binding triggered: \"[chan gets $f]\""
+	chan event $f readable {}
+    }]
+    chan close $f
+    set x initial
+    after 100 [namespace code {
+	set y done
+    }]
+    variable y
+    vwait [namespace which -variable y]
+    set x
+} {initial}
+test chan-io-45.2 {DeleteFileEvent, cleanup on chan close} {fileevent} {
+    set f  [open $path(foo) r]
+    set f2 [open $path(foo) r]
+    chan event $f readable [namespace code {
+	lappend x "f triggered: \"[chan gets $f]\""
+	chan event $f readable {}
+    }]
+    chan event $f2 readable [namespace code {
+	lappend x "f2 triggered: \"[chan gets $f2]\""
+	chan event $f2 readable {}
+    }]
+    chan close $f
+    variable x initial
+    vwait [namespace which -variable x]
+    chan close $f2
+    set x
+} {initial {f2 triggered: "foo bar"}}
+test chan-io-45.3 {DeleteFileEvent, cleanup on chan close} {fileevent} {
+    set f  [open $path(foo) r]
+    set f2 [open $path(foo) r]
+    set f3 [open $path(foo) r]
+    chan event $f readable {f script}
+    chan event $f2 readable {f2 script}
+    chan event $f3 readable {f3 script}
+    set x {}
+    chan close $f2
+    lappend x [catch {chan event $f readable} msg] $msg \
+	    [catch {chan event $f2 readable}] \
+	    [catch {chan event $f3 readable} msg] $msg
+    chan close $f3
+    lappend x [catch {chan event $f readable} msg] $msg \
+	    [catch {chan event $f2 readable}] \
+	    [catch {chan event $f3 readable}]
+    chan close $f
+    lappend x [catch {chan event $f readable}] \
+	    [catch {chan event $f2 readable}] \
+	    [catch {chan event $f3 readable}]
+} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}
+
+# Execute these tests only if the "testfevent" command is present.
+
+test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
+    testfevent create
+    set script "set f \[[list open $path(foo) r]]\n"
+    append script {
+	set x "no event"
+	chan event $f readable [namespace code {
+	    set x "f triggered: [chan gets $f]"
+	    chan event $f readable {}
+	}]
+    }
+    testfevent cmd $script
+    after 1	;# We must delay because Windows takes a little time to notice
+    update
+    testfevent cmd {chan close $f}
+    list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
+} {{f triggered: foo bar} after}
+test chan-io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
+    testfevent create
+    testfevent cmd {
+        variable x 0
+        after 100 {set x triggered}
+        vwait [namespace which -variable x]
+        set x
+    }
+} {triggered}
+test chan-io-46.3 {Tcl event loop vs multiple interpreters} testfevent {
+    testfevent create
+    testfevent cmd {
+        set x 0
+        after 10 {lappend x timer}
+        after 30
+        set result $x
+        update idletasks
+        lappend result $x
+        update
+        lappend result $x
+    }
+} {0 0 {0 timer}}
+
+test chan-io-47.1 {chan event vs multiple interpreters} -setup {
+    set f  [open $path(foo) r]
+    set f2 [open $path(foo) r]
+    set f3 [open $path(foo) r]
+    set x {}
+} -constraints {testfevent fileevent} -body {
+    chan event $f readable {script 1}
+    testfevent create
+    testfevent share $f2
+    testfevent cmd "chan event $f2 readable {script 2}"
+    chan event $f3 readable {sript 3}
+    lappend x [chan event $f2 readable]
+    testfevent delete
+    lappend x [chan event $f readable] [chan event $f2 readable] \
+        [chan event $f3 readable]
+} -cleanup {
+    chan close $f
+    chan close $f2
+    chan close $f3
+} -result {{} {script 1} {} {sript 3}}
+test chan-io-47.2 {deleting chan event on interpreter delete} -setup {
+    set f  [open $path(foo) r]
+    set f2 [open $path(foo) r]
+    set f3 [open $path(foo) r]
+    set f4 [open $path(foo) r]
+} -constraints {testfevent fileevent} -body {
+    chan event $f readable {script 1}
+    testfevent create
+    testfevent share $f2
+    testfevent share $f3
+    testfevent cmd "chan event $f2 readable {script 2}
+        chan event $f3 readable {script 3}"
+    chan event $f4 readable {script 4}
+    testfevent delete
+    list [chan event $f readable] [chan event $f2 readable] \
+	[chan event $f3 readable] [chan event $f4 readable]
+} -cleanup {
+    chan close $f
+    chan close $f2
+    chan close $f3
+    chan close $f4
+} -result {{script 1} {} {} {script 4}}
+test chan-io-47.3 {deleting chan event on interpreter delete} -setup {
+    set f  [open $path(foo) r]
+    set f2 [open $path(foo) r]
+    set f3 [open $path(foo) r]
+    set f4 [open $path(foo) r]
+} -constraints {testfevent fileevent} -body {
+    testfevent create
+    testfevent share $f3
+    testfevent share $f4
+    chan event $f readable {script 1}
+    chan event $f2 readable {script 2}
+    testfevent cmd "chan event $f3 readable {script 3}
+      chan event $f4 readable {script 4}"
+    testfevent delete
+    list [chan event $f readable] [chan event $f2 readable] \
+	[chan event $f3 readable] [chan event $f4 readable]
+} -cleanup {
+    chan close $f
+    chan close $f2
+    chan close $f3
+    chan close $f4
+} -result {{script 1} {script 2} {} {}}
+test chan-io-47.4 {file events on shared files and multiple interpreters} -setup {
+    set f  [open $path(foo) r]
+    set f2 [open $path(foo) r]
+} -constraints {testfevent fileevent} -body {
+    testfevent create
+    testfevent share $f
+    testfevent cmd "chan event $f readable {script 1}"
+    chan event $f readable {script 2}
+    chan event $f2 readable {script 3}
+    list [chan event $f2 readable] [testfevent cmd "chan event $f readable"] \
+	[chan event $f readable]
+} -cleanup {
+    testfevent delete
+    chan close $f
+    chan close $f2
+} -result {{script 3} {script 1} {script 2}}
+test chan-io-47.5 {file events on shared files, deleting file events} -setup {
+    set f [open $path(foo) r]
+} -body {
+    testfevent create
+    testfevent share $f
+    testfevent cmd "chan event $f readable {script 1}"
+    chan event $f readable {script 2}
+    testfevent cmd "chan event $f readable {}"
+    list [testfevent cmd "chan event $f readable"] [chan event $f readable]
+} -constraints {testfevent fileevent} -cleanup {
+    testfevent delete
+    chan close $f
+} -result {{} {script 2}}
+test chan-io-47.6 {file events on shared files, deleting file events} -setup {
+    set f [open $path(foo) r]
+} -body {
+    testfevent create
+    testfevent share $f
+    testfevent cmd "chan event $f readable {script 1}"
+    chan event $f readable {script 2}
+    chan event $f readable {}
+    list [testfevent cmd "chan event $f readable"] [chan event $f readable]
+} -constraints {testfevent fileevent} -cleanup {
+    testfevent delete
+    chan close $f
+} -result {{script 1} {}}
+
+set path(bar) [makeFile {} bar]
+
+test chan-io-48.1 {testing readability conditions} {fileevent} {
+    set f [open $path(bar) w]
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan close $f
+    set f [open $path(bar) r]
+    chan event $f readable [namespace code {
+	lappend l called
+	if {[chan eof $f]} {
+	    chan close $f
+	    set x done
+	} else {
+	    chan gets $f
+	}
+    }]
+    set l ""
+    variable x not_done
+    vwait [namespace which -variable x]
+    list $x $l
+} {done {called called called called called called called}}
+test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
+    set f [open $path(bar) w]
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan close $f
+    set f [open $path(bar) r]
+    chan event $f readable [namespace code {
+	lappend l called
+	if {[chan eof $f]} {
+	    chan close $f
+	    set x done
+	} else {
+	    chan gets $f
+	}
+    }]
+    chan configure $f -blocking off
+    set l ""
+    variable x not_done
+    vwait [namespace which -variable x]
+    list $x $l
+} {done {called called called called called called called}}
+set path(my_script) [makeFile {} my_script]
+test chan-io-48.3 {testing readability conditions} -setup {
+    set l ""
+} -constraints {stdio unix nonBlockFiles openpipe fileevent} -body {
+    set f [open $path(bar) w]
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan puts $f abcdefg
+    chan close $f
+    set f [open $path(my_script) w]
+    chan puts $f {
+	proc copy_slowly {f} {
+	    while {![chan eof $f]} {
+		chan puts [chan gets $f]
+		after 200
+	    }
+	    chan close $f
+	}
+    }
+    chan close $f
+    set f [openpipe]
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	    set x done
+	} else {
+	    chan gets $f
+	    lappend l [chan blocked $f]
+	    chan gets $f
+	    lappend l [chan blocked $f]
+	}
+    }]
+    chan configure $f -buffering line
+    chan configure $f -blocking off
+    variable x not_done
+    chan puts $f [list source $path(my_script)]
+    chan puts $f "set f \[[list open $path(bar) r]]"
+    chan puts $f {copy_slowly $f}
+    chan puts $f {exit}
+    vwait [namespace which -variable x]
+    list $x $l
+} -cleanup {
+    chan close $f
+} -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
+test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation auto -eofchar \x1a
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation auto
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation lf
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation lf -eofchar \x1a
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation cr
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation cr
+    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation cr -eofchar \x1a
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -eofchar \x1a -translation crlf
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} -setup {
+    file delete $path(test1)
+    set c 0
+    set l ""
+} -constraints {fileevent} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation crlf
+    chan puts -nonewline $f [format "abc\ndef\n%c" 26]
+    chan close $f
+    set f [open $path(test1) r]
+    chan configure $f -translation crlf -eofchar \x1a
+    chan event $f readable [namespace code {
+	if {[chan eof $f]} {
+	   set x done
+	   chan close $f
+	} else {
+	   lappend l [chan gets $f]
+	   incr c
+	}
+    }]
+    variable x
+    vwait [namespace which -variable x]
+    list $c $l
+} -result {3 {abc def {}}}
+
+test chan-io-49.1 {testing crlf reading, leftover cr disgorgment} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "a\rb\rc\r\n"
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [file size $path(test1)]
+    chan configure $f -translation crlf
+    lappend l [chan read $f 1]
+    lappend l [chan tell $f]
+    lappend l [chan read $f 1]
+    lappend l [chan tell $f]
+    lappend l [chan read $f 1]
+    lappend l [chan tell $f]
+    lappend l [chan read $f 1]
+    lappend l [chan tell $f]
+    lappend l [chan read $f 1]
+    lappend l [chan tell $f]
+    lappend l [chan read $f 1]
+    lappend l [chan tell $f]
+    lappend l [chan eof $f]
+    lappend l [chan read $f 1]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 {
+} 7 0 {} 1"
+test chan-io-49.2 {testing crlf reading, leftover cr disgorgment} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "a\rb\rc\r\n"
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [file size $path(test1)]
+    chan configure $f -translation crlf
+    lappend l [chan read $f 2]
+    lappend l [chan tell $f]
+    lappend l [chan read $f 2]
+    lappend l [chan tell $f]
+    lappend l [chan read $f 2]
+    lappend l [chan tell $f]
+    lappend l [chan eof $f]
+    lappend l [chan read $f 2]
+    lappend l [chan tell $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
+test chan-io-49.3 {testing crlf reading, leftover cr disgorgment} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "a\rb\rc\r\n"
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [file size $path(test1)]
+    chan configure $f -translation crlf
+    lappend l [chan read $f 3]
+    lappend l [chan tell $f]
+    lappend l [chan read $f 3]
+    lappend l [chan tell $f]
+    lappend l [chan eof $f]
+    lappend l [chan read $f 3]
+    lappend l [chan tell $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
+test chan-io-49.4 {testing crlf reading, leftover cr disgorgment} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "a\rb\rc\r\n"
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [file size $path(test1)]
+    chan configure $f -translation crlf
+    lappend l [chan read $f 3]
+    lappend l [chan tell $f]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan eof $f]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
+test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} -setup {
+    file delete $path(test1)
+    set l ""
+} -body {
+    set f [open $path(test1) w]
+    chan configure $f -translation lf
+    chan puts -nonewline $f "a\rb\rc\r\n"
+    chan close $f
+    set f [open $path(test1) r]
+    lappend l [file size $path(test1)]
+    chan configure $f -translation crlf
+    lappend l [set x [chan gets $f]]
+    lappend l [chan tell $f]
+    lappend l [chan gets $f]
+    lappend l [chan tell $f]
+    lappend l [chan eof $f]
+} -cleanup {
+    chan close $f
+} -result [list 7 a\rb\rc 7 {} 7 1]
+
+test chan-io-50.1 {testing handler deletion} -setup {
+    file delete $path(test1)
+} -constraints {testchannelevent} -body {
+    set f [open $path(test1) w]
+    chan close $f
+    set f [open $path(test1) r]
+    testchannelevent $f add readable [namespace code {
+	variable z called
+	testchannelevent $f delete 0
+    }]
+    variable z not_called
+    update
+    return $z
+} -cleanup {
+    chan close $f
+} -result called
+test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
+    file delete $path(test1)
+    chan close [open $path(test1) w]
+    set z ""
+} -constraints {testchannelevent} -body {
+    set f [open $path(test1) r]
+    testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+    proc delhandler {f i} {
+	variable z
+	lappend z "called delhandler $f $i"
+	testchannelevent $f delete 0
+    }
+    update
+    string equal $z \
+	[list [list called delhandler $f 0] [list called delhandler $f 1]]
+} -cleanup {
+    chan close $f
+} -result 1
+test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
+    file delete $path(test1)
+    chan close [open $path(test1) w]
+    set z ""
+} -constraints {testchannelevent} -body {
+    set f [open $path(test1) r]
+    testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+    testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+    proc notcalled {f i} {
+	variable z
+	lappend z "notcalled was called!! $f $i"
+    }
+    proc delhandler {f i} {
+	variable z
+	testchannelevent $f delete 1
+	lappend z "delhandler $f $i called"
+	testchannelevent $f delete 0
+	lappend z "delhandler $f $i deleted myself"
+    }
+    update
+    string equal $z \
+	[list [list delhandler $f 0 called] \
+	      [list delhandler $f 0 deleted myself]]
+} -cleanup {
+    chan close $f
+} -result 1
+test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    chan close $f
+} -constraints {testchannelevent} -body {
+    set f [open $path(test1) r]
+    testchannelevent $f add readable [namespace code {
+	if {$u eq "recursive"} {
+	    testchannelevent $f delete 0
+	    lappend z "delrecursive deleting recursive"
+	} else {
+	    lappend z "delrecursive calling recursive"
+	    set u recursive
+	    update
+	}
+    }]
+    variable u toplevel
+    variable z ""
+    update
+    return $z
+} -cleanup {
+    chan close $f
+} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
+test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    chan close $f
+} -constraints {testchannelevent} -body {
+    set f [open $path(test1) r]
+    testchannelevent $f add readable [namespace code [list notcalled $f]]
+    testchannelevent $f add readable [namespace code [list del $f]]
+    proc notcalled {f} {
+	variable z
+	lappend z "notcalled was called!! $f"
+    }
+    proc del {f} {
+	variable u
+	variable z
+	if {$u eq "recursive"} {
+	    testchannelevent $f delete 1
+	    testchannelevent $f delete 0
+	    lappend z "del deleted notcalled"
+	    lappend z "del deleted myself"
+	} else {
+	    set u recursive
+	    lappend z "del calling recursive"
+	    update
+	    lappend z "del after update"
+	}
+    }
+    set z ""
+    set u toplevel
+    update
+    return $z
+} -cleanup {
+    chan close $f
+} -result [list {del calling recursive} {del deleted notcalled} \
+	       {del deleted myself} {del after update}]
+test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    chan close $f
+} -constraints {testchannelevent} -body {
+    set f [open $path(test1) r]
+    testchannelevent $f add readable [namespace code [list second $f]]
+    testchannelevent $f add readable [namespace code [list first $f]]
+    proc first {f} {
+	variable u
+	variable z
+	if {$u eq "toplevel"} {
+	    lappend z "first called"
+	    set u first
+	    update
+	    lappend z "first after update"
+	} else {
+	    lappend z "first called not toplevel"
+	}
+    }
+    proc second {f} {
+	variable u
+	variable z
+	if {$u eq "first"} {
+	    lappend z "second called, first time"
+	    set u second
+	    testchannelevent $f delete 0
+	} elseif {$u eq "second"} {
+	    lappend z "second called, second time"
+	    testchannelevent $f delete 0
+	} else {
+	    lappend z "second called, cannot happen!"
+	    testchannelevent $f removeall
+	}
+    }
+    set z ""
+    set u toplevel
+    update
+    return $z
+} -cleanup {
+    chan close $f
+} -result [list {first called} {first called not toplevel} \
+	       {second called, first time} {second called, second time} \
+	       {first after update}]
+
+test chan-io-51.1 {Test old socket deletion on Macintosh} -setup {
+    set x 0
+    set result ""
+    variable wait ""
+} -constraints {socket} -body {
+    proc accept {s a p} {
+	variable x
+	chan configure $s -blocking off
+	chan puts $s "sock[incr x]"
+	chan close $s
+	variable wait done
+    }
+    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set port [lindex [chan configure $ss -sockname] 2]
+    set cs [socket 127.0.0.1 $port]
+    vwait [namespace which -variable wait]
+    lappend result [chan gets $cs]
+    chan close $cs
+    set cs [socket 127.0.0.1 $port]
+    vwait [namespace which -variable wait]
+    lappend result [chan gets $cs]
+    chan close $cs
+    set cs [socket 127.0.0.1 $port]
+    vwait [namespace which -variable wait]
+    lappend result [chan gets $cs]
+    chan close $cs
+    set cs [socket 127.0.0.1 $port]
+    vwait [namespace which -variable wait]
+    lappend result [chan gets $cs]
+} -cleanup {
+    chan close $cs
+    chan close $ss
+} -result {sock1 sock2 sock3 sock4}
+
+test chan-io-52.1 {TclCopyChannel} -constraints {fcopy} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan copy $f1 $f2 -command " # "
+    chan copy $f1 $f2
+} -returnCodes error -cleanup {
+    chan close $f1
+    chan close $f2
+} -match glob -result {channel "*" is busy}
+test chan-io-52.2 {TclCopyChannel} -constraints {fcopy} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    set f3 [open $thisScript]
+    chan copy $f1 $f2 -command " # "
+    chan copy $f3 $f2
+} -returnCodes error -cleanup {
+    chan close $f1
+    chan close $f2
+    chan close $f3
+} -match glob -result {channel "*" is busy}
+test chan-io-52.3 {TclCopyChannel} -constraints {fcopy} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan configure $f1 -translation lf -blocking 0
+    chan configure $f2 -translation cr -blocking 0
+    set s0 [chan copy $f1 $f2]
+    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+    chan close $f1
+    chan close $f2
+    set s1 [file size $thisScript]
+    set s2 [file size $path(test1)]
+    if {($s1 == $s2) && ($s0 == $s1)} {
+        lappend result ok
+    }
+    return $result
+} -result {0 0 ok}
+test chan-io-52.4 {TclCopyChannel} -constraints {fcopy} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan configure $f1 -translation lf -blocking 0
+    chan configure $f2 -translation cr -blocking 0
+    chan copy $f1 $f2 -size 40
+    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+    chan close $f1
+    chan close $f2
+    lappend result [file size $path(test1)]
+} -result {0 0 40}
+test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan configure $f1 -translation lf -blocking 0
+    chan configure $f2 -translation lf -blocking 0
+    chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
+    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+    chan close $f1
+    chan close $f2
+    if {[file size $thisScript] == [file size $path(test1)]} {
+        lappend result ok
+    }
+    return $result
+} -result {0 0 ok}
+test chan-io-52.5a {TclCopyChannel, all, other negative value} -setup {
+    file delete $path(test1)
+} -constraints {fcopy} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan configure $f1 -translation lf -blocking 0
+    chan configure $f2 -translation lf -blocking 0
+    chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
+    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+    chan close $f1
+    chan close $f2
+    if {[file size $thisScript] == [file size $path(test1)]} {
+        lappend result ok
+    }
+    return $result
+} -result {0 0 ok}
+test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -setup {
+    file delete $path(test1)
+} -constraints {fcopy} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan configure $f1 -translation lf -blocking 0
+    chan configure $f2 -translation lf -blocking 0
+    chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
+    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+    chan close $f1
+    chan close $f2
+    if {[file size $thisScript] ==  [file size $path(test1)]} {
+        lappend result ok
+    }
+    return $result
+} -result {0 0 ok}
+test chan-io-52.6 {TclCopyChannel} -setup {
+    file delete $path(test1)
+} -constraints {fcopy} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan configure $f1 -translation lf -blocking 0
+    chan configure $f2 -translation lf -blocking 0
+    set s0 [chan copy $f1 $f2 -size [expr [file size $thisScript] + 5]]
+    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+    chan close $f1
+    chan close $f2
+    set s1 [file size $thisScript]
+    set s2 [file size $path(test1)]
+    if {($s1 == $s2) && ($s0 == $s1)} {
+        lappend result ok
+    }
+    return $result
+} -result {0 0 ok}
+test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
+    file delete $path(test1)
+} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan configure $f1 -translation lf -blocking 0
+    chan configure $f2 -translation lf -blocking 0
+    chan copy $f1 $f2
+    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+    if {[file size $thisScript] == [file size $path(test1)]} {
+        lappend result ok
+    }
+    return $result
+} -cleanup {
+    chan close $f1
+    chan close $f2
+} -result {0 0 ok}
+test chan-io-52.8 {TclCopyChannel} -setup {
+    file delete $path(test1)
+    file delete $path(pipe)
+} -constraints {stdio openpipe fcopy} -body {
+    set f1 [open $path(pipe) w]
+    chan configure $f1 -translation lf
+    chan puts $f1 "
+	chan puts ready
+	chan gets stdin
+	set f1 \[open [list $thisScript] r\]
+	chan configure \$f1 -translation lf
+	chan puts \[chan read \$f1 100\]
+	chan close \$f1
+    "
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    chan configure $f1 -translation lf
+    chan gets $f1
+    chan puts $f1 ready
+    chan flush $f1
+    set f2 [open $path(test1) w]
+    chan configure $f2 -translation lf
+    set s0 [chan copy $f1 $f2 -size 40]
+    catch {chan close $f1}
+    chan close $f2
+    list $s0 [file size $path(test1)]
+} -result {40 40}
+# Empty files, to register them with the test facility
+set path(kyrillic.txt)   [makeFile {} kyrillic.txt]
+set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt]
+set path(utf8-rp.txt)    [makeFile {} utf8-rp.txt]
+# Create kyrillic file, use lf translation to avoid os eol issues
+set out [open $path(kyrillic.txt) w]
+chan configure $out -encoding koi8-r -translation lf
+chan puts       $out "\u0410\u0410"
+chan close      $out
+test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
+    # Copy kyrillic to UTF-8, using chan copy.
+    set in  [open $path(kyrillic.txt) r]
+    set out [open $path(utf8-fcopy.txt) w]
+    chan configure $in  -encoding koi8-r -translation lf
+    chan configure $out -encoding utf-8 -translation lf
+    chan copy $in $out
+    chan close $in
+    chan close $out
+    # Do the same again, but differently (read/chan puts).
+    set in  [open $path(kyrillic.txt) r]
+    set out [open $path(utf8-rp.txt) w]
+    chan configure $in  -encoding koi8-r -translation lf
+    chan configure $out -encoding utf-8 -translation lf
+    chan puts -nonewline $out [chan read $in]
+    chan close $in
+    chan close $out
+    list [file size $path(kyrillic.txt)] \
+	    [file size $path(utf8-fcopy.txt)] \
+	    [file size $path(utf8-rp.txt)]
+} {3 5 5}
+test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
+    # encoding to binary (=> implies that the internal utf-8 is written)
+    set in  [open $path(kyrillic.txt) r]
+    set out [open $path(utf8-fcopy.txt) w]
+    chan configure $in  -encoding koi8-r -translation lf
+    # -translation binary is also -encoding binary
+    chan configure $out -translation binary
+    chan copy $in $out
+    chan close $in
+    chan close $out
+    file size $path(utf8-fcopy.txt)
+} 5
+test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
+    # binary to encoding => the input has to be in utf-8 to make sense to the
+    # encoder
+    set in  [open $path(utf8-fcopy.txt) r]
+    set out [open $path(kyrillic.txt) w]
+    # -translation binary is also -encoding binary
+    chan configure $in  -translation binary
+    chan configure $out -encoding koi8-r -translation lf
+    chan copy $in $out
+    chan close $in
+    chan close $out
+    file size $path(kyrillic.txt)
+} 3
+
+test chan-io-53.1 {CopyData} -setup {
+    file delete $path(test1)
+} -constraints {fcopy} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan configure $f1 -translation lf -blocking 0
+    chan configure $f2 -translation cr -blocking 0
+    chan copy $f1 $f2 -size 0
+    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+    chan close $f1
+    chan close $f2
+    lappend result [file size $path(test1)]
+} -result {0 0 0}
+test chan-io-53.2 {CopyData} -setup {
+    file delete $path(test1)
+} -constraints {fcopy} -body {
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    chan configure $f1 -translation lf -blocking 0
+    chan configure $f2 -translation cr -blocking 0
+    chan copy $f1 $f2 -command [namespace code {set s0}]
+    set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
+    variable s0
+    vwait [namespace which -variable s0]
+    chan close $f1
+    chan close $f2
+    set s1 [file size $thisScript]
+    set s2 [file size $path(test1)]
+    if {($s1 == $s2) && ($s0 == $s1)} {
+        lappend result ok
+    }
+    return $result
+} -result {0 0 ok}
+test chan-io-53.3 {CopyData: background read underflow} -setup {
+    file delete $path(test1)
+    file delete $path(pipe)
+} -constraints {stdio unix openpipe fcopy} -body {
+    set f1 [open $path(pipe) w]
+    chan puts -nonewline $f1 {
+	chan puts ready
+	chan flush stdout			;# Don't assume line buffered!
+	chan copy stdin stdout -command { set x }
+	vwait x
+	set f [}
+    chan puts $f1 [list open $path(test1) w]]
+    chan puts $f1 {
+	chan configure $f -translation lf
+	chan puts $f "done"
+	chan close $f
+    }
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    set result [chan gets $f1]
+    chan puts $f1 line1
+    chan flush $f1
+    lappend result [chan gets $f1]
+    chan puts $f1 line2
+    chan flush $f1
+    lappend result [chan gets $f1]
+    chan close $f1
+    after 500
+    set f [open $path(test1)]
+    lappend result [chan read $f]
+} -cleanup {
+    chan close $f
+} -result "ready line1 line2 {done\n}"
+test chan-io-53.4 {CopyData: background write overflow} -setup {
+    set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
+    variable x
+    for {set x 0} {$x < 12} {incr x} {
+	append big $big
+    }
+    file delete $path(test1)
+    file delete $path(pipe)
+} -constraints {stdio unix openpipe fileevent fcopy} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {
+	chan puts ready
+	chan copy stdin stdout -command { set x }
+	vwait x
+	set f [open $path(test1) w]
+	chan configure $f -translation lf
+	chan puts $f "done"
+	chan close $f
+    }
+    chan close $f1
+    set f1 [openpipe r+ $path(pipe)]
+    set result [chan gets $f1]
+    chan configure $f1 -blocking 0
+    chan puts $f1 $big
+    chan flush $f1
+    after 500
+    set result ""
+    chan event $f1 read [namespace code {
+	append result [chan read $f1 1024]
+	if {[string length $result] >= [string length $big]} {
+	    set x done
+	}
+    }]
+    vwait [namespace which -variable x]
+    return $x
+} -cleanup {
+    set big {}
+    chan close $f1
+} -result done
+set result {}
+proc FcopyTestAccept {sock args} {
+    after 1000 "chan close $sock"
+}
+proc FcopyTestDone {bytes {error {}}} {
+    variable fcopyTestDone
+    if {[string length $error]} {
+	set fcopyTestDone 1
+    } else {
+	set fcopyTestDone 0
+    }
+}
+test chan-io-53.5 {CopyData: error during chan copy} {socket fcopy} {
+    variable fcopyTestDone
+    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
+    set in [open $thisScript]	;# 126 K
+    set out [socket 127.0.0.1 [lindex [chan configure $listen -sockname] 2]]
+    catch {unset fcopyTestDone}
+    chan close $listen	;# This means the socket open never really succeeds
+    chan copy $in $out -command [namespace code FcopyTestDone]
+    variable fcopyTestDone
+    if ![info exists fcopyTestDone] {
+	vwait [namespace which -variable fcopyTestDone]		;# The error occurs here in the b.g.
+    }
+    chan close $in
+    chan close $out
+    set fcopyTestDone	;# 1 for error condition
+} 1
+test chan-io-53.6 {CopyData: error during chan copy} -setup {
+    variable fcopyTestDone
+    file delete $path(pipe)
+    file delete $path(test1)
+    catch {unset fcopyTestDone}
+} -constraints {stdio openpipe fcopy} -body {
+    set f1 [open $path(pipe) w]
+    chan puts $f1 "exit 1"
+    chan close $f1
+    set in [openpipe r+ $path(pipe)]
+    set out [open $path(test1) w]
+    chan copy $in $out -command [namespace code FcopyTestDone]
+    variable fcopyTestDone
+    if ![info exists fcopyTestDone] {
+	vwait [namespace which -variable fcopyTestDone]
+    }
+    return $fcopyTestDone	;# 0 for plain end of file
+} -cleanup {
+    catch {chan close $in}
+    chan close $out
+} -result 0
+proc doFcopy {in out {bytes 0} {error {}}} {
+    variable fcopyTestDone
+    variable fcopyTestCount
+    incr fcopyTestCount $bytes
+    if {[string length $error]} {
+	set fcopyTestDone 1
+    } elseif {[chan eof $in]} {
+	set fcopyTestDone 0
+    } else {
+        # Delay next chan copy to wait for size>0 input bytes
+        after 100 [list chan copy $in $out -size 1000 \
+		-command [namespace code [list doFcopy $in $out]]]
+    }
+}
+test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup {
+    variable fcopyTestDone
+    file delete $path(pipe)
+    catch {unset fcopyTestDone}
+} -constraints {stdio openpipe fcopy} -body {
+    set fcopyTestCount 0
+    set f1 [open $path(pipe) w]
+    chan puts $f1 {
+	# Write  10 bytes / 10 msec
+	proc Write {count} {
+	    chan puts -nonewline "1234567890"
+	    if {[incr count -1]} {
+	        after 10 [list Write $count]
+	    } else {
+	        set ::ready 1
+	    }
+	}
+	chan configure stdout -buffering none
+	Write 345 ;# 3450 bytes ~3.45 sec
+	vwait ready
+	exit 0
+    }
+    chan close $f1
+    set in [openpipe r+ $path(pipe) &]
+    set out [open $path(test1) w]
+    doFcopy $in $out
+    variable fcopyTestDone
+    if {![info exists fcopyTestDone]} {
+	vwait [namespace which -variable fcopyTestDone]
+    }
+    # -1=error 0=script error N=number of bytes
+    expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
+} -cleanup {
+    catch {chan close $in}
+    chan close $out
+} -result {3450}
+test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
+    # copy progress callback. errors out intentionally
+    proc cmd args {
+	lappend ::RES "CMD $args"
+	error !STOP
+    }
+    # capture callback error here
+    proc ::bgerror args {
+	lappend ::RES "bgerror/OK $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 {
+    # Record input size, so that result is always defined
+    lappend ::RES [file size $bar]
+    # Run the copy. Should not invoke -command now.
+    chan copy $f $g -size 2 -command [namespace code cmd]
+    # Check that -command was not called synchronously
+    set sbs [file size $bar]
+    lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs
+    # Now let the async part happen. Should capture the error in cmd via
+    # bgerror. If not break the event loop via timer.
+    set token [after 1000 {
+	lappend ::RES {bgerror/FAIL timeout}
+	set ::forever has-been-reached
+    }]
+    vwait ::forever
+    catch {after cancel $token}
+    # Report
+    return $::RES
+} -cleanup {
+    chan close $f
+    chan close $g
+    catch {unset ::RES}
+    catch {unset ::forever}
+    rename ::bgerror {}
+    removeFile foo
+    removeFile bar
+} -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}}
+test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -setup {
+    # copy progress callback.
+    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] ; chan configure $f -translation binary
+    set g [open $bar w] ; chan configure $g -translation binary -buffering none
+} -constraints {stdio openpipe fcopy} -body {
+    # Initialize and force eof on the input.
+    chan seek $f 0 end ; chan read $f 1
+    set ::RES [chan eof $f]
+    # Run the copy. Should not invoke -command now.
+    chan copy $f $g -size 2 -command [namespace code 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
+    return $::RES
+} -cleanup {
+    chan close $f
+    chan close $g
+    catch {unset ::RES}
+    catch {unset ::forever}
+    removeFile foo
+    removeFile bar
+} -result {1 sync/OK {CMD 0}}
+test chan-io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
+    set out [makeFile {} out]
+    set err [makeFile {} err]
+    set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
+    chan configure $pipe -translation binary -buffering line
+    chan puts $pipe {
+	chan configure stdout -translation binary -buffering line
+	chan puts stderr Waiting...
+	after 1000
+	foreach x {a b c} {
+	    chan puts stderr Looping...
+	    chan puts $x
+	    after 500
+	}
+	proc bye args {
+	    if {[chan gets stdin line]<0} {
+		chan puts stderr "CHILD: EOF detected, exiting"
+		exit
+	    } else {
+		chan puts stderr "CHILD: ignoring line: $line"
+	    }
+	}
+	chan puts stderr Now-sleeping-forever
+	chan event stdin readable bye
+	vwait forever
+    }
+    proc ::done args {
+	set ::forever OK
+	return
+    }
+    set ::forever {}
+    set out [open $out w]
+} -constraints {stdio openpipe fcopy} -body {
+    chan copy $pipe $out -size 6 -command ::done
+    set token [after 5000 {
+	set ::forever {fcopy hangs}
+    }]
+    vwait ::forever
+    catch {after cancel $token}
+    set ::forever
+} -cleanup {
+    chan close $pipe
+    rename ::done {}
+    if {[testConstraint win]} {
+	after 1000;		# Allow Windows time to figure out that the
+                                # process is gone
+    }
+    catch {close $out}
+    catch {removeFile out}
+    catch {removeFile err}
+    catch {unset ::forever}
+} -result OK
+test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
+    set err [makeFile {} err]
+    set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
+    chan configure $pipe -translation binary -buffering line
+    chan puts $pipe {
+	chan configure stderr -buffering line
+	# Kill server when pipe closed by invoker.
+	proc bye args {
+	    if {![chan eof stdin]} { chan gets stdin ; return }
+	    chan puts stderr BYE
+	    exit
+	}
+	# Server code. Bi-directional copy between 2 sockets.
+	proc geof {sok} {
+	    chan puts stderr DONE/$sok
+	    chan close $sok
+	}
+	proc new {sok args} {
+	    chan puts stderr NEW/$sok
+	    global l srv
+	    chan configure $sok -translation binary -buffering none
+	    lappend l $sok
+	    if {[llength $l] == 2} {
+		chan close $srv
+		foreach {a b} $l break
+		chan copy $a $b -command [list geof $a]
+		chan copy $b $a -command [list geof $b]
+		chan puts stderr 2COPY
+	    }
+	    chan puts stderr ...
+	}
+	chan puts stderr SRV
+	set l {}
+	set srv [socket -server new 9999]
+	chan puts stderr WAITING
+	chan event stdin readable bye
+	chan puts OK
+	vwait forever
+    }
+    # wait for OK from server.
+    chan gets $pipe
+    # Now the two clients.
+    proc done {sock} {
+	if {[chan eof $sock]} { chan close $sock ; return }
+	lappend ::forever [chan gets $sock]
+	return
+    }
+    set a [socket 127.0.0.1 9999]
+    set b [socket 127.0.0.1 9999]
+    chan configure $a -translation binary -buffering none
+    chan configure $b -translation binary -buffering none
+    chan event  $a readable [namespace code "done $a"]
+    chan event  $b readable [namespace code "done $b"]
+} -constraints {stdio openpipe fcopy} -body {
+    # Now pass data through the server in both directions.
+    set ::forever {}
+    chan puts $a AB
+    vwait ::forever
+    chan puts $b BA
+    vwait ::forever
+    set ::forever
+} -cleanup {
+    catch {chan close $a}
+    catch {chan close $b}
+    chan close $pipe
+    if {[testConstraint win]} {
+	after 1000		;# Give Windows time to kill the process
+    }
+    removeFile err
+    catch {unset ::forever}
+} -result {AB BA}
+
+test chan-io-54.1 {Recursive channel events} {socket fileevent} {
+    # This test checks to see if file events are delivered during recursive
+    # event loops when there is buffered data on the channel.
+    proc accept {s a p} {
+	variable as
+	chan configure $s -translation lf
+	chan puts $s "line 1\nline2\nline3"
+	chan flush $s
+	set as $s
+    }
+    proc readit {s next} {
+	variable x
+	variable result
+	lappend result $next
+	if {$next == 1} {
+	    chan event $s readable [namespace code [list readit $s 2]]
+	    vwait [namespace which -variable x]
+	}
+	incr x
+    }
+    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    # We need to delay on some systems until the creation of the server socket
+    # completes.
+    set done 0
+    for {set i 0} {$i < 10} {incr i} {
+	if {![catch {
+	    set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]
+	}]} then {
+	    set done 1
+	    break
+	}
+	after 100
+    }
+    if {$done == 0} {
+	chan close $ss
+	error "failed to connect to server"
+    }
+    variable result {}
+    variable x 0
+    variable as
+    vwait [namespace which -variable as]
+    chan configure $cs -translation lf
+    lappend result [chan gets $cs]
+    chan configure $cs -blocking off
+    chan event $cs readable [namespace code [list readit $cs 1]]
+    set a [after 2000 [namespace code { set x failure }]]
+    vwait [namespace which -variable x]
+    after cancel $a
+    chan close $as
+    chan close $ss
+    chan close $cs
+    list $result $x
+} {{{line 1} 1 2} 2}
+test chan-io-54.2 {Testing for busy-wait in recursive channel events} -setup {
+    set accept {}
+    set after {}
+    variable done 0
+} -constraints {socket fileevent} -body {
+    variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    proc accept {s a p} {
+	variable counter 0
+	variable accept $s
+	chan configure $s -blocking off -buffering line -translation lf
+	chan event $s readable [namespace code "doit $s"]
+    }
+    proc doit {s} {
+	variable counter
+	variable after
+	incr counter
+	if {[chan gets $s] eq ""} {
+	    chan event $s readable [namespace code "doit1 $s"]
+	    set after [after 1000 [namespace code {
+		chan puts $writer hello
+		chan flush $writer
+		set done 1
+	    }]]
+	}
+    }
+    proc doit1 {s} {
+	variable counter
+	variable accept
+	incr counter
+	chan gets $s
+	chan close $s
+	set accept {}
+    }
+    proc producer {} {
+	variable s
+	variable writer
+	set writer [socket 127.0.0.1 [lindex [chan configure $s -sockname] 2]]
+	chan configure $writer -buffering line
+	chan puts -nonewline $writer hello
+	chan flush $writer
+    }
+    producer
+    vwait [namespace which -variable done]
+    chan close $writer
+    chan close $s
+    after cancel $after
+    return $counter
+} -cleanup {
+    if {$accept ne {}} {chan close $accept}
+} -result 1
+
+set path(fooBar) [makeFile {} fooBar]
+
+test chan-io-55.1 {ChannelEventScriptInvoker: deletion} -constraints {
+    fileevent
+} -setup {
+    variable x
+    proc eventScript {fd} {
+	variable x
+	chan close $fd
+	error "planned error"
+	set x whoops
+    }
+    proc myHandler args {
+	variable x got_error
+    }
+    set handler [interp bgerror {}]
+    interp bgerror {} [namespace which myHandler]
+} -body {
+    set f [open $path(fooBar) w]
+    chan event $f writable [namespace code [list eventScript $f]]
+    variable x not_done
+    vwait [namespace which -variable x]
+    return $x
+} -cleanup {
+    interp bgerror {} $handler
+} -result {got_error}
+
+test chan-io-56.1 {ChannelTimerProc} {testchannelevent} {
+    set f [open $path(fooBar) w]
+    chan puts $f "this is a test"
+    chan close $f
+    set f [open $path(fooBar) r]
+    testchannelevent $f add readable [namespace code {
+	chan read $f 1
+	incr x
+    }]
+    variable x 0
+    vwait [namespace which -variable x]
+    vwait [namespace which -variable x]
+    set result $x
+    testchannelevent $f set 0 none
+    after idle [namespace code {set y done}]
+    variable y
+    vwait [namespace which -variable y]
+    chan close $f
+    lappend result $y
+} {2 done}
+
+test chan-io-57.1 {buffered data and file events, gets} -setup {
+    variable s2
+} -constraints {fileevent} -body {
+    proc accept {sock args} {
+	variable s2
+	set s2 $sock
+    }
+    set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]]
+    vwait [namespace which -variable s2]
+    update
+    chan event $s2 readable [namespace code {lappend result readable}]
+    chan puts $s "12\n34567890"
+    chan flush $s
+    variable result [chan gets $s2]
+    after 1000 [namespace code {lappend result timer}]
+    vwait [namespace which -variable result]
+    lappend result [chan gets $s2]
+    vwait [namespace which -variable result]
+    return $result
+} -cleanup {
+    chan close $s
+    chan close $s2
+    chan close $server
+} -result {12 readable 34567890 timer}
+test chan-io-57.2 {buffered data and file events, read} -setup {
+    variable s2
+} -constraints {fileevent} -body {
+    proc accept {sock args} {
+	variable s2
+	set s2 $sock
+    }
+    set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set s [socket 127.0.0.1 [lindex [chan configure $server -sockname] 2]]
+    vwait [namespace which -variable s2]
+    update
+    chan event $s2 readable [namespace code {lappend result readable}]
+    chan puts -nonewline $s "1234567890"
+    chan flush $s
+    variable result [chan read $s2 1]
+    after 1000 [namespace code {lappend result timer}]
+    vwait [namespace which -variable result]
+    lappend result [chan read $s2 9]
+    vwait [namespace which -variable result]
+    return $result
+} -cleanup {
+    chan close $s
+    chan close $s2
+    chan close $server
+} -result {1 readable 234567890 timer}
+
+test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} {
+    set out [open $path(script) w]
+    chan puts $out {
+	chan puts "normal message from pipe"
+	chan puts stderr "error message from pipe"
+	exit 1
+    }
+    proc readit {pipe} {
+	variable x
+	variable result
+	if {[chan eof $pipe]} {
+	    set x [catch {chan close $pipe} line]
+	    lappend result catch $line
+	} else {
+	    chan gets $pipe line
+	    lappend result chan gets $line
+	}
+    }
+    chan close $out
+    set pipe [openpipe r $path(script)]
+    chan event $pipe readable [namespace code [list readit $pipe]]
+    variable x ""
+    set result ""
+    vwait [namespace which -variable x]
+    list $x $result
+} {1 {chan gets {normal message from pipe} chan gets {} catch {error message from pipe}}}
+
+test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
+    # TIP #10
+    # More complicated tests (like that the reference changes as a channel is
+    # moved from thread to thread) can be done only in the extension which
+    # fully implements the moving of channels between threads, i.e. 'Threads'.
+    set f [open $path(longfile) r]
+    set result [testchannel mthread $f]
+    chan close $f
+    string equal $result [testmainthread]
+} {1}
+
+test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} {
+    # This test will hang in older revisions of the core.
+    set out [open $path(script) w]
+    chan puts $out {
+	chan puts [encoding convertfrom identity \xe2]
+	exit 1
+    }
+    proc readit {pipe} {
+	variable x
+	variable result
+	if {[chan eof $pipe]} {
+	    set x [catch {chan close $pipe} line]
+	    lappend result catch $line
+	} else {
+	    chan gets $pipe line
+	    lappend result gets $line
+	}
+    }
+    chan close $out
+    set pipe [openpipe r $path(script)]
+    chan event $pipe readable [namespace code [list readit $pipe]]
+    variable x ""
+    set result ""
+    vwait [namespace which -variable x]
+    # cut of the remainder of the error stack, especially the filename
+    set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
+    list $x $result
+} {1 {gets {} catch {error writing "stdout": invalid argument}}}
+
+test chan-io-61.1 {Reset eof state after changing the eof char} -setup {
+    set datafile [makeFile {} eofchar]
+    set f [open $datafile w]
+    chan configure $f -translation binary
+    chan puts -nonewline $f [string repeat "Ho hum\n" 11]
+    chan puts $f =
+    set line [string repeat "Ge gla " 4]
+    chan puts -nonewline $f [string repeat [string trimright $line]\n 834]
+    chan close $f
+} -body {
+    set f [open $datafile r]
+    chan configure $f -eofchar =
+    set res {}
+    lappend res [chan read $f; chan tell $f]
+    chan configure $f -eofchar {}
+    lappend res [chan read $f 1]
+    lappend res [chan read $f; chan tell $f]
+    # Any seek zaps the internals into a good state.
+    #chan seek $f 0 start
+    #chan seek $f 0 current
+    #lappend res [chan read $f; chan tell $f]
+} -cleanup {
+    chan close $f
+    removeFile eofchar
+} -result {77 = 23431}
+
+# Test the cutting and splicing of channels, this is incidentially the
+# attach/detach facility of package Thread, but __without any safeguards__. It
+# can also be used to emulate transfer of channels between threads, and is
+# used for that here.
+
+test chan-io-70.0 {Cutting & Splicing channels} -setup {
+    set f [makeFile {... dummy ...} cutsplice]
+    set res {}
+} -constraints {testchannel} -body {
+    set c [open $f r]
+    lappend res [catch {chan seek $c 0 start}]
+    testchannel cut $c
+    lappend res [catch {chan seek $c 0 start}]
+    testchannel splice $c
+    lappend res [catch {chan seek $c 0 start}]
+} -cleanup {
+    chan close $c
+    removeFile cutsplice
+} -result {0 1 0}
+
+test chan-io-70.1 {Transfer channel} -setup {
+    set f [makeFile {... dummy ...} cutsplice]
+    set res {}
+} -constraints {testchannel thread} -body {
+    set c [open $f r]
+    lappend res [catch {chan seek $c 0 start}]
+    testchannel cut $c
+    lappend res [catch {chan seek $c 0 start}]
+    set tid [thread::create -preserved]
+    thread::send $tid [list set c $c]
+    thread::send $tid {load {} Tcltest}
+    lappend res [thread::send $tid {
+	testchannel splice $c
+	set res [catch {chan seek $c 0 start}]
+	chan close $c
+	set res
+    }]
+} -cleanup {
+    thread::release $tid
+    removeFile cutsplice
+} -result {0 1 0}
+
+# ### ### ### ######### ######### #########
+
+foreach {n msg expected} {
+     0 {}                                 {}
+     1 {{message only}}                   {{message only}}
+     2 {-options x}                       {-options x}
+     3 {-options {x y} {the message}}     {-options {x y} {the message}}
+
+     4 {-code 1     -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     5 {-code 0     -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     6 {-code 1     -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     7 {-code 0     -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     8 {-code error -level 0 -f ba snarf} {-code error -level 0 -f ba snarf}
+     9 {-code ok    -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    10 {-code error -level 5 -f ba snarf} {-code error -level 0 -f ba snarf}
+    11 {-code ok    -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    12 {-code boss  -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    13 {-code boss  -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    14 {-code 1     -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    15 {-code 0     -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    16 {-code 1     -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    17 {-code 0     -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    18 {-code error -level 0 -f ba}       {-code error -level 0 -f ba}
+    19 {-code ok    -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    20 {-code error -level 5 -f ba}       {-code error -level 0 -f ba}
+    21 {-code ok    -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    22 {-code boss  -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    23 {-code boss  -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    24 {-code 1     -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    25 {-code 0     -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    26 {-code error -level X -f ba snarf} {-code error -level 0 -f ba snarf}
+    27 {-code ok    -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    28 {-code boss  -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    29 {-code 1     -level X -f ba}       {-code 1     -level 0 -f ba}
+    30 {-code 0     -level X -f ba}       {-code 1     -level 0 -f ba}
+    31 {-code error -level X -f ba}       {-code error -level 0 -f ba}
+    32 {-code ok    -level X -f ba}       {-code 1     -level 0 -f ba}
+    33 {-code boss  -level X -f ba}       {-code 1     -level 0 -f ba}
+
+    34 {-code 1 -code 1     -level 0 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    35 {-code 1 -code 0     -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    36 {-code 1 -code 1     -level 5 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    37 {-code 1 -code 0     -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    38 {-code 1 -code error -level 0 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+    39 {-code 1 -code ok    -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    40 {-code 1 -code error -level 5 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+    41 {-code 1 -code ok    -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    42 {-code 1 -code boss  -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    43 {-code 1 -code boss  -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    44 {-code 1 -code 1     -level 0 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    45 {-code 1 -code 0     -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    46 {-code 1 -code 1     -level 5 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    47 {-code 1 -code 0     -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    48 {-code 1 -code error -level 0 -f ba}       {-code 1 -code error -level 0 -f ba}
+    49 {-code 1 -code ok    -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    50 {-code 1 -code error -level 5 -f ba}       {-code 1 -code error -level 0 -f ba}
+    51 {-code 1 -code ok    -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    52 {-code 1 -code boss  -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    53 {-code 1 -code boss  -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    54 {-code 1 -code 1     -level X -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    55 {-code 1 -code 0     -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    56 {-code 1 -code error -level X -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+    57 {-code 1 -code ok    -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    58 {-code 1 -code boss  -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    59 {-code 1 -code 1     -level X -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    60 {-code 1 -code 0     -level X -f ba}       {-code 1             -level 0 -f ba}
+    61 {-code 1 -code error -level X -f ba}       {-code 1 -code error -level 0 -f ba}
+    62 {-code 1 -code ok    -level X -f ba}       {-code 1             -level 0 -f ba}
+    63 {-code 1 -code boss  -level X -f ba}       {-code 1             -level 0 -f ba}
+
+    64 {-code 0 -code 1     -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    65 {-code 0 -code 0     -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    66 {-code 0 -code 1     -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    67 {-code 0 -code 0     -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    68 {-code 0 -code error -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    69 {-code 0 -code ok    -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    70 {-code 0 -code error -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    71 {-code 0 -code ok    -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    72 {-code 0 -code boss  -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    73 {-code 0 -code boss  -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    74 {-code 0 -code 1     -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    75 {-code 0 -code 0     -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    76 {-code 0 -code 1     -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    77 {-code 0 -code 0     -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    78 {-code 0 -code error -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    79 {-code 0 -code ok    -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    80 {-code 0 -code error -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    81 {-code 0 -code ok    -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    82 {-code 0 -code boss  -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    83 {-code 0 -code boss  -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    84 {-code 0 -code 1     -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    85 {-code 0 -code 0     -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    86 {-code 0 -code error -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    87 {-code 0 -code ok    -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    88 {-code 0 -code boss  -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    89 {-code 0 -code 1     -level X -f ba}       {-code 1 -level 0 -f ba}
+    90 {-code 0 -code 0     -level X -f ba}       {-code 1 -level 0 -f ba}
+    91 {-code 0 -code error -level X -f ba}       {-code 1 -level 0 -f ba}
+    92 {-code 0 -code ok    -level X -f ba}       {-code 1 -level 0 -f ba}
+    93 {-code 0 -code boss  -level X -f ba}       {-code 1 -level 0 -f ba}
+
+    94 {-code 1     -code 1 -level 0 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    95 {-code 0     -code 1 -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    96 {-code 1     -code 1 -level 5 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    97 {-code 0     -code 1 -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    98 {-code error -code 1 -level 0 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+    99 {-code ok    -code 1 -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a0 {-code error -code 1 -level 5 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+    a1 {-code ok    -code 1 -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a2 {-code boss  -code 1 -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a3 {-code boss  -code 1 -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a4 {-code 1     -code 1 -level 0 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    a5 {-code 0     -code 1 -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    a6 {-code 1     -code 1 -level 5 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    a7 {-code 0     -code 1 -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    a8 {-code error -code 1 -level 0 -f ba}       {-code error -code 1 -level 0 -f ba}
+    a9 {-code ok    -code 1 -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    b0 {-code error -code 1 -level 5 -f ba}       {-code error -code 1 -level 0 -f ba}
+    b1 {-code ok    -code 1 -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    b2 {-code boss  -code 1 -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    b3 {-code boss  -code 1 -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    b4 {-code 1     -code 1 -level X -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    b5 {-code 0     -code 1 -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    b6 {-code error -code 1 -level X -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+    b7 {-code ok    -code 1 -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    b8 {-code boss  -code 1 -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    b9 {-code 1     -code 1 -level X -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    c0 {-code 0     -code 1 -level X -f ba}       {-code 1             -level 0 -f ba}
+    c1 {-code error -code 1 -level X -f ba}       {-code error -code 1 -level 0 -f ba}
+    c2 {-code ok    -code 1 -level X -f ba}       {-code 1             -level 0 -f ba}
+    c3 {-code boss  -code 1 -level X -f ba}       {-code 1             -level 0 -f ba}
+
+    c4 {-code 1     -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c5 {-code 0     -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c6 {-code 1     -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c7 {-code 0     -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c8 {-code error -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c9 {-code ok    -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d0 {-code error -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d1 {-code ok    -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d2 {-code boss  -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d3 {-code boss  -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d4 {-code 1     -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    d5 {-code 0     -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    d6 {-code 1     -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    d7 {-code 0     -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    d8 {-code error -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    d9 {-code ok    -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    e0 {-code error -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    e1 {-code ok    -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    e2 {-code boss  -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    e3 {-code boss  -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    e4 {-code 1     -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e5 {-code 0     -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e6 {-code error -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e7 {-code ok    -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e8 {-code boss  -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e9 {-code 1     -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f0 {-code 0     -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f1 {-code error -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f2 {-code ok    -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f3 {-code boss  -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+} {
+    test chan-io-71.$n {Tcl_SetChannelError} -setup {
+	set f [makeFile {... dummy ...} cutsplice]
+    } -constraints {testchannel} -body {
+	set c [open $f r]
+	testchannel setchannelerror $c [lrange $msg 0 end]
+    } -cleanup {
+	chan close $c
+	removeFile cutsplice
+    } -result [lrange $expected 0 end]
+    test chan-io-72.$n {Tcl_SetChannelErrorInterp} -setup {
+	set f [makeFile {... dummy ...} cutsplice]
+    } -constraints {testchannel} -body {
+	set c [open $f r]
+	testchannel setchannelerrorinterp $c [lrange $msg 0 end]
+    } -cleanup {
+	chan close $c
+	removeFile cutsplice
+    } -result [lrange $expected 0 end]
+}
+
+test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} -body {
+    # Test for Bug 1847044 - don't spoil type unless we have a valid channel
+    chan close [lreplace [list a] 0 end]
+} -returnCodes error -match glob -result *
+
+# ### ### ### ######### ######### #########
+
+# cleanup
+foreach file [list fooBar longfile script output test1 pipe my_script \
+	test2 test3 cat kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
+    removeFile $file
+}
+cleanupTests
+}
+namespace delete ::tcl::test::io
diff --git a/tests/clock.test b/tests/clock.test
index b8c864d..8debba1 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -10,38 +10,28 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: clock.test,v 1.56 2005/07/15 22:32:24 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-if { $::tcl_platform(platform) eq {windows} } {
-    if { [catch { package require registry 1.1 }] } {
-	
-	# HIDEOUS KLUDGE: [package require registry 1.1] has failed.
-	# This failure likely means that we're running in Tcl's build
-	# directory instead of the install directory.  We recover by
-	# trying to load tclreg*.dll directly.
-	
-	if { [catch { 
-	    load [lindex \
-		      [glob -directory \
-			   [file join \
-				[pwd] \
-				[file dirname [info nameofexecutable]]] \
-			   tclReg*.dll] \
-		      0] registry
-	}] } {
-	    # Still no registry!
-	    namespace eval ::tcl::clock [set NoRegistry {}]
-	}
+if {[testConstraint win]} {
+    if {[catch {
+	    ::tcltest::loadTestedCommands
+	    package require registry
+	}]} {
+	namespace eval ::tcl::clock {variable NoRegistry {}}
     }
 }
+
 package require msgcat 1.4
 
+testConstraint detroit \
+    [expr {![catch {clock format 0 -timezone :America/Detroit -format %z}]}]
+testConstraint y2038 \
+    [expr {[clock format 2158894800 -format %z -timezone :America/Detroit] eq {-0400}}]
+
 # TEST PLAN
 
 # clock-1:
@@ -216,6 +206,8 @@ namespace eval ::tcl::clock {
 	LOCALE_DATE_FORMAT {die %Od mensis %Om annoque %EY}
 	LOCALE_TIME_FORMAT {%OH h %OM m %OS s}
 	LOCALE_DATE_TIME_FORMAT {%Ex %EX}
+	BCE {Before Christ}
+	CE {Anno Domini}
     }
 }
 
@@ -233,6 +225,7 @@ namespace eval ::testClock {
 	[dict create \
 	     HKEY_CURRENT_USER\\Control\ Panel\\International \
 	     [dict create \
+		  locale 0409 \
 		  sShortDate dd-MMM-yyyy \
 		  sLongDate "'the' dd''' day of' MMMM yyyy" \
 		  sTimeFormat "h:mm:ss tt"] \
@@ -241,8 +234,8 @@ namespace eval ::testClock {
 		  Bias 300 \
 		  StandardBias 0 \
 		  DaylightBias -60 \
-		  StandardStart \x00\x00\x0a\x00\x05\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \
-		  DaylightStart \x00\x00\x04\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]]
+		  StandardStart \x00\x00\x0b\x00\x01\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00 \
+		  DaylightStart \x00\x00\x03\x00\x02\x00\x02\x00\x00\x00\x00\x00\x00\x00\x00\x00]]
 }
 
 
@@ -261,7 +254,7 @@ proc ::testClock::registry { cmd path key } {
 
 test clock-1.0 "clock format - wrong # args" {
     list [catch {clock format} msg] $msg $::errorCode
-} {1 {wrong # args: should be "::tcl::clock::format clockval ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
+} {1 {wrong # args: should be "clock format clockval ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"} {CLOCK wrongNumArgs}}
 
 test clock-1.1 "clock format - bad time" {
     list [catch {clock format foo} msg] $msg
@@ -275,9 +268,13 @@ test clock-1.3 "clock format - empty val" {
     clock format 0 -gmt 1 -format ""
 } {}
 
-test clock-1.4 "clock format - bad flag" {
+test clock-1.4 "clock format - bad flag" {*}{
+    -body {
     list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
-} {1 {bad switch "-oops", must be -format, -gmt, -locale or -timezone} {CLOCK badSwitch -oops}}
+    } 
+    -match glob
+    -result {1 {bad switch "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badSwitch -oops}}
+}
 
 test clock-1.5 "clock format - bad timezone" {
     list [catch {clock format 0 -format "%s" -timezone :NOWHERE} msg] $msg $::errorCode
@@ -287,6 +284,10 @@ test clock-1.6 "clock format - gmt + timezone" {
     list [catch {clock format 0 -timezone :GMT -gmt true} msg] $msg $::errorCode
 } {1 {cannot use -gmt and -timezone in same call} {CLOCK gmtWithTimezone}}
 
+test clock-1.7 "clock format - option abbreviations" {
+    clock format 0 -g true -f "%Y-%m-%d"
+} 1970-01-01
+
 # BEGIN testcases2
 
 # Test formatting of Gregorian year, month, day, all formats
@@ -12416,1775 +12417,2297 @@ test clock-2.2424 {conversion of 2065-12-31} {
 
 # BEGIN testcases3
 test clock-3.1 {ISO week-based calendar 1871-W52-1} {
-    clock format -3093206400 -format {%a %A %g %G %u %V %w} -gmt true; # 1871-W52-1
-} {Mon Monday 71 1871 1 52 1}
-test clock-3.2 {ISO week-based calendar 1871-W52-7} {
-    clock format -3092688000 -format {%a %A %g %G %u %V %w} -gmt true; # 1871-W52-7
-} {Sun Sunday 71 1871 7 52 0}
-test clock-3.3 {ISO week-based calendar 1872-W01-1} {
-    clock format -3092601600 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W01-1
-} {Mon Monday 72 1872 1 01 1}
-test clock-3.4 {ISO week-based calendar 1872-W01-7} {
-    clock format -3092083200 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W01-7
-} {Sun Sunday 72 1872 7 01 0}
-test clock-3.5 {ISO week-based calendar 1872-W02-1} {
-    clock format -3091996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W02-1
-} {Mon Monday 72 1872 1 02 1}
-test clock-3.6 {ISO week-based calendar 1872-W52-1} {
-    clock format -3061756800 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W52-1
-} {Mon Monday 72 1872 1 52 1}
-test clock-3.7 {ISO week-based calendar 1872-W52-7} {
-    clock format -3061238400 -format {%a %A %g %G %u %V %w} -gmt true; # 1872-W52-7
-} {Sun Sunday 72 1872 7 52 0}
-test clock-3.8 {ISO week-based calendar 1873-W01-1} {
-    clock format -3061152000 -format {%a %A %g %G %u %V %w} -gmt true; # 1873-W01-1
-} {Mon Monday 73 1873 1 01 1}
-test clock-3.9 {ISO week-based calendar 1873-W01-3} {
-    clock format -3060979200 -format {%a %A %g %G %u %V %w} -gmt true; # 1873-W01-3
-} {Wed Wednesday 73 1873 3 01 3}
-test clock-3.10 {ISO week-based calendar 1873-W01-7} {
-    clock format -3060633600 -format {%a %A %g %G %u %V %w} -gmt true; # 1873-W01-7
-} {Sun Sunday 73 1873 7 01 0}
-test clock-3.11 {ISO week-based calendar 1873-W02-1} {
-    clock format -3060547200 -format {%a %A %g %G %u %V %w} -gmt true; # 1873-W02-1
-} {Mon Monday 73 1873 1 02 1}
-test clock-3.12 {ISO week-based calendar 1875-W52-1} {
-    clock format -2966803200 -format {%a %A %g %G %u %V %w} -gmt true; # 1875-W52-1
-} {Mon Monday 75 1875 1 52 1}
-test clock-3.13 {ISO week-based calendar 1875-W52-6} {
-    clock format -2966371200 -format {%a %A %g %G %u %V %w} -gmt true; # 1875-W52-6
-} {Sat Saturday 75 1875 6 52 6}
-test clock-3.14 {ISO week-based calendar 1875-W52-7} {
-    clock format -2966284800 -format {%a %A %g %G %u %V %w} -gmt true; # 1875-W52-7
-} {Sun Sunday 75 1875 7 52 0}
-test clock-3.15 {ISO week-based calendar 1876-W01-1} {
-    clock format -2966198400 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W01-1
-} {Mon Monday 76 1876 1 01 1}
-test clock-3.16 {ISO week-based calendar 1876-W01-7} {
-    clock format -2965680000 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W01-7
-} {Sun Sunday 76 1876 7 01 0}
-test clock-3.17 {ISO week-based calendar 1876-W02-1} {
-    clock format -2965593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W02-1
-} {Mon Monday 76 1876 1 02 1}
-test clock-3.18 {ISO week-based calendar 1876-W52-1} {
-    clock format -2935353600 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W52-1
-} {Mon Monday 76 1876 1 52 1}
-test clock-3.19 {ISO week-based calendar 1876-W52-7} {
-    clock format -2934835200 -format {%a %A %g %G %u %V %w} -gmt true; # 1876-W52-7
-} {Sun Sunday 76 1876 7 52 0}
-test clock-3.20 {ISO week-based calendar 1877-W01-1} {
-    clock format -2934748800 -format {%a %A %g %G %u %V %w} -gmt true; # 1877-W01-1
-} {Mon Monday 77 1877 1 01 1}
-test clock-3.21 {ISO week-based calendar 1877-W01-7} {
-    clock format -2934230400 -format {%a %A %g %G %u %V %w} -gmt true; # 1877-W01-7
-} {Sun Sunday 77 1877 7 01 0}
-test clock-3.22 {ISO week-based calendar 1877-W02-1} {
-    clock format -2934144000 -format {%a %A %g %G %u %V %w} -gmt true; # 1877-W02-1
-} {Mon Monday 77 1877 1 02 1}
-test clock-3.23 {ISO week-based calendar 1879-W52-1} {
-    clock format -2841004800 -format {%a %A %g %G %u %V %w} -gmt true; # 1879-W52-1
-} {Mon Monday 79 1879 1 52 1}
-test clock-3.24 {ISO week-based calendar 1879-W52-7} {
-    clock format -2840486400 -format {%a %A %g %G %u %V %w} -gmt true; # 1879-W52-7
-} {Sun Sunday 79 1879 7 52 0}
-test clock-3.25 {ISO week-based calendar 1880-W01-1} {
-    clock format -2840400000 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W01-1
-} {Mon Monday 80 1880 1 01 1}
-test clock-3.26 {ISO week-based calendar 1880-W01-4} {
-    clock format -2840140800 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W01-4
-} {Thu Thursday 80 1880 4 01 4}
-test clock-3.27 {ISO week-based calendar 1880-W01-7} {
-    clock format -2839881600 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W01-7
-} {Sun Sunday 80 1880 7 01 0}
-test clock-3.28 {ISO week-based calendar 1880-W02-1} {
-    clock format -2839795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W02-1
-} {Mon Monday 80 1880 1 02 1}
-test clock-3.29 {ISO week-based calendar 1880-W53-1} {
-    clock format -2808950400 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W53-1
-} {Mon Monday 80 1880 1 53 1}
-test clock-3.30 {ISO week-based calendar 1880-W53-6} {
-    clock format -2808518400 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W53-6
-} {Sat Saturday 80 1880 6 53 6}
-test clock-3.31 {ISO week-based calendar 1880-W53-7} {
-    clock format -2808432000 -format {%a %A %g %G %u %V %w} -gmt true; # 1880-W53-7
-} {Sun Sunday 80 1880 7 53 0}
-test clock-3.32 {ISO week-based calendar 1881-W01-1} {
-    clock format -2808345600 -format {%a %A %g %G %u %V %w} -gmt true; # 1881-W01-1
-} {Mon Monday 81 1881 1 01 1}
-test clock-3.33 {ISO week-based calendar 1881-W01-7} {
-    clock format -2807827200 -format {%a %A %g %G %u %V %w} -gmt true; # 1881-W01-7
-} {Sun Sunday 81 1881 7 01 0}
-test clock-3.34 {ISO week-based calendar 1881-W02-1} {
-    clock format -2807740800 -format {%a %A %g %G %u %V %w} -gmt true; # 1881-W02-1
-} {Mon Monday 81 1881 1 02 1}
-test clock-3.35 {ISO week-based calendar 1883-W52-1} {
-    clock format -2714601600 -format {%a %A %g %G %u %V %w} -gmt true; # 1883-W52-1
-} {Mon Monday 83 1883 1 52 1}
-test clock-3.36 {ISO week-based calendar 1883-W52-7} {
-    clock format -2714083200 -format {%a %A %g %G %u %V %w} -gmt true; # 1883-W52-7
-} {Sun Sunday 83 1883 7 52 0}
-test clock-3.37 {ISO week-based calendar 1884-W01-1} {
-    clock format -2713996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W01-1
-} {Mon Monday 84 1884 1 01 1}
-test clock-3.38 {ISO week-based calendar 1884-W01-2} {
-    clock format -2713910400 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W01-2
-} {Tue Tuesday 84 1884 2 01 2}
-test clock-3.39 {ISO week-based calendar 1884-W01-7} {
-    clock format -2713478400 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W01-7
-} {Sun Sunday 84 1884 7 01 0}
-test clock-3.40 {ISO week-based calendar 1884-W02-1} {
-    clock format -2713392000 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W02-1
-} {Mon Monday 84 1884 1 02 1}
-test clock-3.41 {ISO week-based calendar 1884-W52-1} {
-    clock format -2683152000 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W52-1
-} {Mon Monday 84 1884 1 52 1}
-test clock-3.42 {ISO week-based calendar 1884-W52-7} {
-    clock format -2682633600 -format {%a %A %g %G %u %V %w} -gmt true; # 1884-W52-7
-} {Sun Sunday 84 1884 7 52 0}
-test clock-3.43 {ISO week-based calendar 1885-W01-1} {
-    clock format -2682547200 -format {%a %A %g %G %u %V %w} -gmt true; # 1885-W01-1
-} {Mon Monday 85 1885 1 01 1}
-test clock-3.44 {ISO week-based calendar 1885-W01-4} {
-    clock format -2682288000 -format {%a %A %g %G %u %V %w} -gmt true; # 1885-W01-4
-} {Thu Thursday 85 1885 4 01 4}
-test clock-3.45 {ISO week-based calendar 1885-W01-7} {
-    clock format -2682028800 -format {%a %A %g %G %u %V %w} -gmt true; # 1885-W01-7
-} {Sun Sunday 85 1885 7 01 0}
-test clock-3.46 {ISO week-based calendar 1885-W02-1} {
-    clock format -2681942400 -format {%a %A %g %G %u %V %w} -gmt true; # 1885-W02-1
-} {Mon Monday 85 1885 1 02 1}
-test clock-3.47 {ISO week-based calendar 1887-W52-1} {
-    clock format -2588198400 -format {%a %A %g %G %u %V %w} -gmt true; # 1887-W52-1
-} {Mon Monday 87 1887 1 52 1}
-test clock-3.48 {ISO week-based calendar 1887-W52-6} {
-    clock format -2587766400 -format {%a %A %g %G %u %V %w} -gmt true; # 1887-W52-6
-} {Sat Saturday 87 1887 6 52 6}
-test clock-3.49 {ISO week-based calendar 1887-W52-7} {
-    clock format -2587680000 -format {%a %A %g %G %u %V %w} -gmt true; # 1887-W52-7
-} {Sun Sunday 87 1887 7 52 0}
-test clock-3.50 {ISO week-based calendar 1888-W01-1} {
-    clock format -2587593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W01-1
-} {Mon Monday 88 1888 1 01 1}
-test clock-3.51 {ISO week-based calendar 1888-W01-7} {
-    clock format -2587075200 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W01-7
-} {Sun Sunday 88 1888 7 01 0}
-test clock-3.52 {ISO week-based calendar 1888-W02-1} {
-    clock format -2586988800 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W02-1
-} {Mon Monday 88 1888 1 02 1}
-test clock-3.53 {ISO week-based calendar 1888-W52-1} {
-    clock format -2556748800 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W52-1
-} {Mon Monday 88 1888 1 52 1}
-test clock-3.54 {ISO week-based calendar 1888-W52-7} {
-    clock format -2556230400 -format {%a %A %g %G %u %V %w} -gmt true; # 1888-W52-7
-} {Sun Sunday 88 1888 7 52 0}
-test clock-3.55 {ISO week-based calendar 1889-W01-1} {
-    clock format -2556144000 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W01-1
-} {Mon Monday 89 1889 1 01 1}
-test clock-3.56 {ISO week-based calendar 1889-W01-2} {
-    clock format -2556057600 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W01-2
-} {Tue Tuesday 89 1889 2 01 2}
-test clock-3.57 {ISO week-based calendar 1889-W01-7} {
-    clock format -2555625600 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W01-7
-} {Sun Sunday 89 1889 7 01 0}
-test clock-3.58 {ISO week-based calendar 1889-W02-1} {
-    clock format -2555539200 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W02-1
-} {Mon Monday 89 1889 1 02 1}
-test clock-3.59 {ISO week-based calendar 1889-W52-1} {
-    clock format -2525299200 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W52-1
-} {Mon Monday 89 1889 1 52 1}
-test clock-3.60 {ISO week-based calendar 1889-W52-7} {
-    clock format -2524780800 -format {%a %A %g %G %u %V %w} -gmt true; # 1889-W52-7
-} {Sun Sunday 89 1889 7 52 0}
-test clock-3.61 {ISO week-based calendar 1890-W01-1} {
-    clock format -2524694400 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W01-1
-} {Mon Monday 90 1890 1 01 1}
-test clock-3.62 {ISO week-based calendar 1890-W01-3} {
-    clock format -2524521600 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W01-3
-} {Wed Wednesday 90 1890 3 01 3}
-test clock-3.63 {ISO week-based calendar 1890-W01-7} {
-    clock format -2524176000 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W01-7
-} {Sun Sunday 90 1890 7 01 0}
-test clock-3.64 {ISO week-based calendar 1890-W02-1} {
-    clock format -2524089600 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W02-1
-} {Mon Monday 90 1890 1 02 1}
-test clock-3.65 {ISO week-based calendar 1890-W52-1} {
-    clock format -2493849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W52-1
-} {Mon Monday 90 1890 1 52 1}
-test clock-3.66 {ISO week-based calendar 1890-W52-7} {
-    clock format -2493331200 -format {%a %A %g %G %u %V %w} -gmt true; # 1890-W52-7
-} {Sun Sunday 90 1890 7 52 0}
-test clock-3.67 {ISO week-based calendar 1891-W01-1} {
-    clock format -2493244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W01-1
-} {Mon Monday 91 1891 1 01 1}
-test clock-3.68 {ISO week-based calendar 1891-W01-4} {
-    clock format -2492985600 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W01-4
-} {Thu Thursday 91 1891 4 01 4}
-test clock-3.69 {ISO week-based calendar 1891-W01-7} {
-    clock format -2492726400 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W01-7
-} {Sun Sunday 91 1891 7 01 0}
-test clock-3.70 {ISO week-based calendar 1891-W02-1} {
-    clock format -2492640000 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W02-1
-} {Mon Monday 91 1891 1 02 1}
-test clock-3.71 {ISO week-based calendar 1891-W53-1} {
-    clock format -2461795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W53-1
-} {Mon Monday 91 1891 1 53 1}
-test clock-3.72 {ISO week-based calendar 1891-W53-5} {
-    clock format -2461449600 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W53-5
-} {Fri Friday 91 1891 5 53 5}
-test clock-3.73 {ISO week-based calendar 1891-W53-7} {
-    clock format -2461276800 -format {%a %A %g %G %u %V %w} -gmt true; # 1891-W53-7
-} {Sun Sunday 91 1891 7 53 0}
-test clock-3.74 {ISO week-based calendar 1892-W01-1} {
-    clock format -2461190400 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W01-1
-} {Mon Monday 92 1892 1 01 1}
-test clock-3.75 {ISO week-based calendar 1892-W01-7} {
-    clock format -2460672000 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W01-7
-} {Sun Sunday 92 1892 7 01 0}
-test clock-3.76 {ISO week-based calendar 1892-W02-1} {
-    clock format -2460585600 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W02-1
-} {Mon Monday 92 1892 1 02 1}
-test clock-3.77 {ISO week-based calendar 1892-W52-1} {
-    clock format -2430345600 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W52-1
-} {Mon Monday 92 1892 1 52 1}
-test clock-3.78 {ISO week-based calendar 1892-W52-6} {
-    clock format -2429913600 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W52-6
-} {Sat Saturday 92 1892 6 52 6}
-test clock-3.79 {ISO week-based calendar 1892-W52-7} {
-    clock format -2429827200 -format {%a %A %g %G %u %V %w} -gmt true; # 1892-W52-7
-} {Sun Sunday 92 1892 7 52 0}
-test clock-3.80 {ISO week-based calendar 1893-W01-1} {
-    clock format -2429740800 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W01-1
-} {Mon Monday 93 1893 1 01 1}
-test clock-3.81 {ISO week-based calendar 1893-W01-7} {
-    clock format -2429222400 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W01-7
-} {Sun Sunday 93 1893 7 01 0}
-test clock-3.82 {ISO week-based calendar 1893-W02-1} {
-    clock format -2429136000 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W02-1
-} {Mon Monday 93 1893 1 02 1}
-test clock-3.83 {ISO week-based calendar 1893-W52-1} {
-    clock format -2398896000 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W52-1
-} {Mon Monday 93 1893 1 52 1}
-test clock-3.84 {ISO week-based calendar 1893-W52-7} {
-    clock format -2398377600 -format {%a %A %g %G %u %V %w} -gmt true; # 1893-W52-7
-} {Sun Sunday 93 1893 7 52 0}
-test clock-3.85 {ISO week-based calendar 1894-W01-1} {
-    clock format -2398291200 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W01-1
-} {Mon Monday 94 1894 1 01 1}
-test clock-3.86 {ISO week-based calendar 1894-W01-7} {
-    clock format -2397772800 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W01-7
-} {Sun Sunday 94 1894 7 01 0}
-test clock-3.87 {ISO week-based calendar 1894-W02-1} {
-    clock format -2397686400 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W02-1
-} {Mon Monday 94 1894 1 02 1}
-test clock-3.88 {ISO week-based calendar 1894-W52-1} {
-    clock format -2367446400 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W52-1
-} {Mon Monday 94 1894 1 52 1}
-test clock-3.89 {ISO week-based calendar 1894-W52-7} {
-    clock format -2366928000 -format {%a %A %g %G %u %V %w} -gmt true; # 1894-W52-7
-} {Sun Sunday 94 1894 7 52 0}
-test clock-3.90 {ISO week-based calendar 1895-W01-1} {
-    clock format -2366841600 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W01-1
-} {Mon Monday 95 1895 1 01 1}
-test clock-3.91 {ISO week-based calendar 1895-W01-2} {
-    clock format -2366755200 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W01-2
-} {Tue Tuesday 95 1895 2 01 2}
-test clock-3.92 {ISO week-based calendar 1895-W01-7} {
-    clock format -2366323200 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W01-7
-} {Sun Sunday 95 1895 7 01 0}
-test clock-3.93 {ISO week-based calendar 1895-W02-1} {
-    clock format -2366236800 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W02-1
-} {Mon Monday 95 1895 1 02 1}
-test clock-3.94 {ISO week-based calendar 1895-W52-1} {
-    clock format -2335996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W52-1
-} {Mon Monday 95 1895 1 52 1}
-test clock-3.95 {ISO week-based calendar 1895-W52-7} {
-    clock format -2335478400 -format {%a %A %g %G %u %V %w} -gmt true; # 1895-W52-7
-} {Sun Sunday 95 1895 7 52 0}
-test clock-3.96 {ISO week-based calendar 1896-W01-1} {
-    clock format -2335392000 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W01-1
-} {Mon Monday 96 1896 1 01 1}
-test clock-3.97 {ISO week-based calendar 1896-W01-3} {
-    clock format -2335219200 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W01-3
-} {Wed Wednesday 96 1896 3 01 3}
-test clock-3.98 {ISO week-based calendar 1896-W01-7} {
-    clock format -2334873600 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W01-7
-} {Sun Sunday 96 1896 7 01 0}
-test clock-3.99 {ISO week-based calendar 1896-W02-1} {
-    clock format -2334787200 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W02-1
-} {Mon Monday 96 1896 1 02 1}
-test clock-3.100 {ISO week-based calendar 1896-W53-1} {
-    clock format -2303942400 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W53-1
-} {Mon Monday 96 1896 1 53 1}
-test clock-3.101 {ISO week-based calendar 1896-W53-5} {
-    clock format -2303596800 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W53-5
-} {Fri Friday 96 1896 5 53 5}
-test clock-3.102 {ISO week-based calendar 1896-W53-7} {
-    clock format -2303424000 -format {%a %A %g %G %u %V %w} -gmt true; # 1896-W53-7
-} {Sun Sunday 96 1896 7 53 0}
-test clock-3.103 {ISO week-based calendar 1897-W01-1} {
-    clock format -2303337600 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W01-1
-} {Mon Monday 97 1897 1 01 1}
-test clock-3.104 {ISO week-based calendar 1897-W01-7} {
-    clock format -2302819200 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W01-7
-} {Sun Sunday 97 1897 7 01 0}
-test clock-3.105 {ISO week-based calendar 1897-W02-1} {
-    clock format -2302732800 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W02-1
-} {Mon Monday 97 1897 1 02 1}
-test clock-3.106 {ISO week-based calendar 1897-W52-1} {
-    clock format -2272492800 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W52-1
-} {Mon Monday 97 1897 1 52 1}
-test clock-3.107 {ISO week-based calendar 1897-W52-6} {
-    clock format -2272060800 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W52-6
-} {Sat Saturday 97 1897 6 52 6}
-test clock-3.108 {ISO week-based calendar 1897-W52-7} {
-    clock format -2271974400 -format {%a %A %g %G %u %V %w} -gmt true; # 1897-W52-7
-} {Sun Sunday 97 1897 7 52 0}
-test clock-3.109 {ISO week-based calendar 1898-W01-1} {
-    clock format -2271888000 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W01-1
-} {Mon Monday 98 1898 1 01 1}
-test clock-3.110 {ISO week-based calendar 1898-W01-7} {
-    clock format -2271369600 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W01-7
-} {Sun Sunday 98 1898 7 01 0}
-test clock-3.111 {ISO week-based calendar 1898-W02-1} {
-    clock format -2271283200 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W02-1
-} {Mon Monday 98 1898 1 02 1}
-test clock-3.112 {ISO week-based calendar 1898-W52-1} {
-    clock format -2241043200 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W52-1
-} {Mon Monday 98 1898 1 52 1}
-test clock-3.113 {ISO week-based calendar 1898-W52-6} {
-    clock format -2240611200 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W52-6
-} {Sat Saturday 98 1898 6 52 6}
-test clock-3.114 {ISO week-based calendar 1898-W52-7} {
-    clock format -2240524800 -format {%a %A %g %G %u %V %w} -gmt true; # 1898-W52-7
-} {Sun Sunday 98 1898 7 52 0}
-test clock-3.115 {ISO week-based calendar 1899-W01-1} {
-    clock format -2240438400 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W01-1
-} {Mon Monday 99 1899 1 01 1}
-test clock-3.116 {ISO week-based calendar 1899-W01-7} {
-    clock format -2239920000 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W01-7
-} {Sun Sunday 99 1899 7 01 0}
-test clock-3.117 {ISO week-based calendar 1899-W02-1} {
-    clock format -2239833600 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W02-1
-} {Mon Monday 99 1899 1 02 1}
-test clock-3.118 {ISO week-based calendar 1899-W52-1} {
-    clock format -2209593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W52-1
-} {Mon Monday 99 1899 1 52 1}
-test clock-3.119 {ISO week-based calendar 1899-W52-7} {
-    clock format -2209075200 -format {%a %A %g %G %u %V %w} -gmt true; # 1899-W52-7
-} {Sun Sunday 99 1899 7 52 0}
-test clock-3.120 {ISO week-based calendar 1900-W01-1} {
-    clock format -2208988800 -format {%a %A %g %G %u %V %w} -gmt true; # 1900-W01-1
-} {Mon Monday 00 1900 1 01 1}
-test clock-3.121 {ISO week-based calendar 1900-W01-7} {
-    clock format -2208470400 -format {%a %A %g %G %u %V %w} -gmt true; # 1900-W01-7
-} {Sun Sunday 00 1900 7 01 0}
-test clock-3.122 {ISO week-based calendar 1900-W02-1} {
-    clock format -2208384000 -format {%a %A %g %G %u %V %w} -gmt true; # 1900-W02-1
-} {Mon Monday 00 1900 1 02 1}
-test clock-3.123 {ISO week-based calendar 1943-W52-1} {
-    clock format -820972800 -format {%a %A %g %G %u %V %w} -gmt true; # 1943-W52-1
-} {Mon Monday 43 1943 1 52 1}
-test clock-3.124 {ISO week-based calendar 1943-W52-6} {
-    clock format -820540800 -format {%a %A %g %G %u %V %w} -gmt true; # 1943-W52-6
-} {Sat Saturday 43 1943 6 52 6}
-test clock-3.125 {ISO week-based calendar 1943-W52-7} {
-    clock format -820454400 -format {%a %A %g %G %u %V %w} -gmt true; # 1943-W52-7
-} {Sun Sunday 43 1943 7 52 0}
-test clock-3.126 {ISO week-based calendar 1944-W01-1} {
-    clock format -820368000 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W01-1
-} {Mon Monday 44 1944 1 01 1}
-test clock-3.127 {ISO week-based calendar 1944-W01-7} {
-    clock format -819849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W01-7
-} {Sun Sunday 44 1944 7 01 0}
-test clock-3.128 {ISO week-based calendar 1944-W02-1} {
-    clock format -819763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W02-1
-} {Mon Monday 44 1944 1 02 1}
-test clock-3.129 {ISO week-based calendar 1944-W52-1} {
-    clock format -789523200 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W52-1
-} {Mon Monday 44 1944 1 52 1}
-test clock-3.130 {ISO week-based calendar 1944-W52-7} {
-    clock format -789004800 -format {%a %A %g %G %u %V %w} -gmt true; # 1944-W52-7
-} {Sun Sunday 44 1944 7 52 0}
-test clock-3.131 {ISO week-based calendar 1945-W01-1} {
-    clock format -788918400 -format {%a %A %g %G %u %V %w} -gmt true; # 1945-W01-1
-} {Mon Monday 45 1945 1 01 1}
-test clock-3.132 {ISO week-based calendar 1945-W01-7} {
-    clock format -788400000 -format {%a %A %g %G %u %V %w} -gmt true; # 1945-W01-7
-} {Sun Sunday 45 1945 7 01 0}
-test clock-3.133 {ISO week-based calendar 1945-W02-1} {
-    clock format -788313600 -format {%a %A %g %G %u %V %w} -gmt true; # 1945-W02-1
-} {Mon Monday 45 1945 1 02 1}
-test clock-3.134 {ISO week-based calendar 1947-W52-1} {
-    clock format -695174400 -format {%a %A %g %G %u %V %w} -gmt true; # 1947-W52-1
-} {Mon Monday 47 1947 1 52 1}
-test clock-3.135 {ISO week-based calendar 1947-W52-7} {
-    clock format -694656000 -format {%a %A %g %G %u %V %w} -gmt true; # 1947-W52-7
-} {Sun Sunday 47 1947 7 52 0}
-test clock-3.136 {ISO week-based calendar 1948-W01-1} {
-    clock format -694569600 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W01-1
-} {Mon Monday 48 1948 1 01 1}
-test clock-3.137 {ISO week-based calendar 1948-W01-4} {
-    clock format -694310400 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W01-4
-} {Thu Thursday 48 1948 4 01 4}
-test clock-3.138 {ISO week-based calendar 1948-W01-7} {
-    clock format -694051200 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W01-7
-} {Sun Sunday 48 1948 7 01 0}
-test clock-3.139 {ISO week-based calendar 1948-W02-1} {
-    clock format -693964800 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W02-1
-} {Mon Monday 48 1948 1 02 1}
-test clock-3.140 {ISO week-based calendar 1948-W53-1} {
-    clock format -663120000 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W53-1
-} {Mon Monday 48 1948 1 53 1}
-test clock-3.141 {ISO week-based calendar 1948-W53-6} {
-    clock format -662688000 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W53-6
-} {Sat Saturday 48 1948 6 53 6}
-test clock-3.142 {ISO week-based calendar 1948-W53-7} {
-    clock format -662601600 -format {%a %A %g %G %u %V %w} -gmt true; # 1948-W53-7
-} {Sun Sunday 48 1948 7 53 0}
-test clock-3.143 {ISO week-based calendar 1949-W01-1} {
-    clock format -662515200 -format {%a %A %g %G %u %V %w} -gmt true; # 1949-W01-1
-} {Mon Monday 49 1949 1 01 1}
-test clock-3.144 {ISO week-based calendar 1949-W01-7} {
-    clock format -661996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1949-W01-7
-} {Sun Sunday 49 1949 7 01 0}
-test clock-3.145 {ISO week-based calendar 1949-W02-1} {
-    clock format -661910400 -format {%a %A %g %G %u %V %w} -gmt true; # 1949-W02-1
-} {Mon Monday 49 1949 1 02 1}
-test clock-3.146 {ISO week-based calendar 1951-W52-1} {
-    clock format -568771200 -format {%a %A %g %G %u %V %w} -gmt true; # 1951-W52-1
-} {Mon Monday 51 1951 1 52 1}
-test clock-3.147 {ISO week-based calendar 1951-W52-7} {
-    clock format -568252800 -format {%a %A %g %G %u %V %w} -gmt true; # 1951-W52-7
-} {Sun Sunday 51 1951 7 52 0}
-test clock-3.148 {ISO week-based calendar 1952-W01-1} {
-    clock format -568166400 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W01-1
-} {Mon Monday 52 1952 1 01 1}
-test clock-3.149 {ISO week-based calendar 1952-W01-2} {
-    clock format -568080000 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W01-2
-} {Tue Tuesday 52 1952 2 01 2}
-test clock-3.150 {ISO week-based calendar 1952-W01-7} {
-    clock format -567648000 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W01-7
-} {Sun Sunday 52 1952 7 01 0}
-test clock-3.151 {ISO week-based calendar 1952-W02-1} {
-    clock format -567561600 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W02-1
-} {Mon Monday 52 1952 1 02 1}
-test clock-3.152 {ISO week-based calendar 1952-W52-1} {
-    clock format -537321600 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W52-1
-} {Mon Monday 52 1952 1 52 1}
-test clock-3.153 {ISO week-based calendar 1952-W52-7} {
-    clock format -536803200 -format {%a %A %g %G %u %V %w} -gmt true; # 1952-W52-7
-} {Sun Sunday 52 1952 7 52 0}
-test clock-3.154 {ISO week-based calendar 1953-W01-1} {
-    clock format -536716800 -format {%a %A %g %G %u %V %w} -gmt true; # 1953-W01-1
-} {Mon Monday 53 1953 1 01 1}
-test clock-3.155 {ISO week-based calendar 1953-W01-4} {
-    clock format -536457600 -format {%a %A %g %G %u %V %w} -gmt true; # 1953-W01-4
-} {Thu Thursday 53 1953 4 01 4}
-test clock-3.156 {ISO week-based calendar 1953-W01-7} {
-    clock format -536198400 -format {%a %A %g %G %u %V %w} -gmt true; # 1953-W01-7
-} {Sun Sunday 53 1953 7 01 0}
-test clock-3.157 {ISO week-based calendar 1953-W02-1} {
-    clock format -536112000 -format {%a %A %g %G %u %V %w} -gmt true; # 1953-W02-1
-} {Mon Monday 53 1953 1 02 1}
-test clock-3.158 {ISO week-based calendar 1955-W52-1} {
-    clock format -442368000 -format {%a %A %g %G %u %V %w} -gmt true; # 1955-W52-1
-} {Mon Monday 55 1955 1 52 1}
-test clock-3.159 {ISO week-based calendar 1955-W52-6} {
-    clock format -441936000 -format {%a %A %g %G %u %V %w} -gmt true; # 1955-W52-6
-} {Sat Saturday 55 1955 6 52 6}
-test clock-3.160 {ISO week-based calendar 1955-W52-7} {
-    clock format -441849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1955-W52-7
-} {Sun Sunday 55 1955 7 52 0}
-test clock-3.161 {ISO week-based calendar 1956-W01-1} {
-    clock format -441763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W01-1
-} {Mon Monday 56 1956 1 01 1}
-test clock-3.162 {ISO week-based calendar 1956-W01-7} {
-    clock format -441244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W01-7
-} {Sun Sunday 56 1956 7 01 0}
-test clock-3.163 {ISO week-based calendar 1956-W02-1} {
-    clock format -441158400 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W02-1
-} {Mon Monday 56 1956 1 02 1}
-test clock-3.164 {ISO week-based calendar 1956-W52-1} {
-    clock format -410918400 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W52-1
-} {Mon Monday 56 1956 1 52 1}
-test clock-3.165 {ISO week-based calendar 1956-W52-7} {
-    clock format -410400000 -format {%a %A %g %G %u %V %w} -gmt true; # 1956-W52-7
-} {Sun Sunday 56 1956 7 52 0}
-test clock-3.166 {ISO week-based calendar 1957-W01-1} {
-    clock format -410313600 -format {%a %A %g %G %u %V %w} -gmt true; # 1957-W01-1
-} {Mon Monday 57 1957 1 01 1}
-test clock-3.167 {ISO week-based calendar 1957-W01-2} {
-    clock format -410227200 -format {%a %A %g %G %u %V %w} -gmt true; # 1957-W01-2
-} {Tue Tuesday 57 1957 2 01 2}
-test clock-3.168 {ISO week-based calendar 1957-W01-7} {
-    clock format -409795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1957-W01-7
-} {Sun Sunday 57 1957 7 01 0}
-test clock-3.169 {ISO week-based calendar 1957-W02-1} {
-    clock format -409708800 -format {%a %A %g %G %u %V %w} -gmt true; # 1957-W02-1
-} {Mon Monday 57 1957 1 02 1}
-test clock-3.170 {ISO week-based calendar 1958-W52-1} {
-    clock format -348019200 -format {%a %A %g %G %u %V %w} -gmt true; # 1958-W52-1
-} {Mon Monday 58 1958 1 52 1}
-test clock-3.171 {ISO week-based calendar 1958-W52-7} {
-    clock format -347500800 -format {%a %A %g %G %u %V %w} -gmt true; # 1958-W52-7
-} {Sun Sunday 58 1958 7 52 0}
-test clock-3.172 {ISO week-based calendar 1959-W01-1} {
-    clock format -347414400 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W01-1
-} {Mon Monday 59 1959 1 01 1}
-test clock-3.173 {ISO week-based calendar 1959-W01-4} {
-    clock format -347155200 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W01-4
-} {Thu Thursday 59 1959 4 01 4}
-test clock-3.174 {ISO week-based calendar 1959-W01-7} {
-    clock format -346896000 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W01-7
-} {Sun Sunday 59 1959 7 01 0}
-test clock-3.175 {ISO week-based calendar 1959-W02-1} {
-    clock format -346809600 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W02-1
-} {Mon Monday 59 1959 1 02 1}
-test clock-3.176 {ISO week-based calendar 1959-W53-1} {
-    clock format -315964800 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W53-1
-} {Mon Monday 59 1959 1 53 1}
-test clock-3.177 {ISO week-based calendar 1959-W53-5} {
-    clock format -315619200 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W53-5
-} {Fri Friday 59 1959 5 53 5}
-test clock-3.178 {ISO week-based calendar 1959-W53-7} {
-    clock format -315446400 -format {%a %A %g %G %u %V %w} -gmt true; # 1959-W53-7
-} {Sun Sunday 59 1959 7 53 0}
-test clock-3.179 {ISO week-based calendar 1960-W01-1} {
-    clock format -315360000 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W01-1
-} {Mon Monday 60 1960 1 01 1}
-test clock-3.180 {ISO week-based calendar 1960-W01-7} {
-    clock format -314841600 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W01-7
-} {Sun Sunday 60 1960 7 01 0}
-test clock-3.181 {ISO week-based calendar 1960-W02-1} {
-    clock format -314755200 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W02-1
-} {Mon Monday 60 1960 1 02 1}
-test clock-3.182 {ISO week-based calendar 1960-W52-1} {
-    clock format -284515200 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W52-1
-} {Mon Monday 60 1960 1 52 1}
-test clock-3.183 {ISO week-based calendar 1960-W52-6} {
-    clock format -284083200 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W52-6
-} {Sat Saturday 60 1960 6 52 6}
-test clock-3.184 {ISO week-based calendar 1960-W52-7} {
-    clock format -283996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1960-W52-7
-} {Sun Sunday 60 1960 7 52 0}
-test clock-3.185 {ISO week-based calendar 1961-W01-1} {
-    clock format -283910400 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W01-1
-} {Mon Monday 61 1961 1 01 1}
-test clock-3.186 {ISO week-based calendar 1961-W01-7} {
-    clock format -283392000 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W01-7
-} {Sun Sunday 61 1961 7 01 0}
-test clock-3.187 {ISO week-based calendar 1961-W02-1} {
-    clock format -283305600 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W02-1
-} {Mon Monday 61 1961 1 02 1}
-test clock-3.188 {ISO week-based calendar 1961-W52-1} {
-    clock format -253065600 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W52-1
-} {Mon Monday 61 1961 1 52 1}
-test clock-3.189 {ISO week-based calendar 1961-W52-7} {
-    clock format -252547200 -format {%a %A %g %G %u %V %w} -gmt true; # 1961-W52-7
-} {Sun Sunday 61 1961 7 52 0}
-test clock-3.190 {ISO week-based calendar 1962-W01-1} {
-    clock format -252460800 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W01-1
-} {Mon Monday 62 1962 1 01 1}
-test clock-3.191 {ISO week-based calendar 1962-W01-7} {
-    clock format -251942400 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W01-7
-} {Sun Sunday 62 1962 7 01 0}
-test clock-3.192 {ISO week-based calendar 1962-W02-1} {
-    clock format -251856000 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W02-1
-} {Mon Monday 62 1962 1 02 1}
-test clock-3.193 {ISO week-based calendar 1962-W52-1} {
-    clock format -221616000 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W52-1
-} {Mon Monday 62 1962 1 52 1}
-test clock-3.194 {ISO week-based calendar 1962-W52-7} {
-    clock format -221097600 -format {%a %A %g %G %u %V %w} -gmt true; # 1962-W52-7
-} {Sun Sunday 62 1962 7 52 0}
-test clock-3.195 {ISO week-based calendar 1963-W01-1} {
-    clock format -221011200 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W01-1
-} {Mon Monday 63 1963 1 01 1}
-test clock-3.196 {ISO week-based calendar 1963-W01-2} {
-    clock format -220924800 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W01-2
-} {Tue Tuesday 63 1963 2 01 2}
-test clock-3.197 {ISO week-based calendar 1963-W01-7} {
-    clock format -220492800 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W01-7
-} {Sun Sunday 63 1963 7 01 0}
-test clock-3.198 {ISO week-based calendar 1963-W02-1} {
-    clock format -220406400 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W02-1
-} {Mon Monday 63 1963 1 02 1}
-test clock-3.199 {ISO week-based calendar 1963-W52-1} {
-    clock format -190166400 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W52-1
-} {Mon Monday 63 1963 1 52 1}
-test clock-3.200 {ISO week-based calendar 1963-W52-7} {
-    clock format -189648000 -format {%a %A %g %G %u %V %w} -gmt true; # 1963-W52-7
-} {Sun Sunday 63 1963 7 52 0}
-test clock-3.201 {ISO week-based calendar 1964-W01-1} {
-    clock format -189561600 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W01-1
-} {Mon Monday 64 1964 1 01 1}
-test clock-3.202 {ISO week-based calendar 1964-W01-3} {
-    clock format -189388800 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W01-3
-} {Wed Wednesday 64 1964 3 01 3}
-test clock-3.203 {ISO week-based calendar 1964-W01-7} {
-    clock format -189043200 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W01-7
-} {Sun Sunday 64 1964 7 01 0}
-test clock-3.204 {ISO week-based calendar 1964-W02-1} {
-    clock format -188956800 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W02-1
-} {Mon Monday 64 1964 1 02 1}
-test clock-3.205 {ISO week-based calendar 1964-W53-1} {
-    clock format -158112000 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W53-1
-} {Mon Monday 64 1964 1 53 1}
-test clock-3.206 {ISO week-based calendar 1964-W53-5} {
-    clock format -157766400 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W53-5
-} {Fri Friday 64 1964 5 53 5}
-test clock-3.207 {ISO week-based calendar 1964-W53-7} {
-    clock format -157593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1964-W53-7
-} {Sun Sunday 64 1964 7 53 0}
-test clock-3.208 {ISO week-based calendar 1965-W01-1} {
-    clock format -157507200 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W01-1
-} {Mon Monday 65 1965 1 01 1}
-test clock-3.209 {ISO week-based calendar 1965-W01-7} {
-    clock format -156988800 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W01-7
-} {Sun Sunday 65 1965 7 01 0}
-test clock-3.210 {ISO week-based calendar 1965-W02-1} {
-    clock format -156902400 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W02-1
-} {Mon Monday 65 1965 1 02 1}
-test clock-3.211 {ISO week-based calendar 1965-W52-1} {
-    clock format -126662400 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W52-1
-} {Mon Monday 65 1965 1 52 1}
-test clock-3.212 {ISO week-based calendar 1965-W52-6} {
-    clock format -126230400 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W52-6
-} {Sat Saturday 65 1965 6 52 6}
-test clock-3.213 {ISO week-based calendar 1965-W52-7} {
-    clock format -126144000 -format {%a %A %g %G %u %V %w} -gmt true; # 1965-W52-7
-} {Sun Sunday 65 1965 7 52 0}
-test clock-3.214 {ISO week-based calendar 1966-W01-1} {
-    clock format -126057600 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W01-1
-} {Mon Monday 66 1966 1 01 1}
-test clock-3.215 {ISO week-based calendar 1966-W01-7} {
-    clock format -125539200 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W01-7
-} {Sun Sunday 66 1966 7 01 0}
-test clock-3.216 {ISO week-based calendar 1966-W02-1} {
-    clock format -125452800 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W02-1
-} {Mon Monday 66 1966 1 02 1}
-test clock-3.217 {ISO week-based calendar 1966-W52-1} {
-    clock format -95212800 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W52-1
-} {Mon Monday 66 1966 1 52 1}
-test clock-3.218 {ISO week-based calendar 1966-W52-6} {
-    clock format -94780800 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W52-6
-} {Sat Saturday 66 1966 6 52 6}
-test clock-3.219 {ISO week-based calendar 1966-W52-7} {
-    clock format -94694400 -format {%a %A %g %G %u %V %w} -gmt true; # 1966-W52-7
-} {Sun Sunday 66 1966 7 52 0}
-test clock-3.220 {ISO week-based calendar 1967-W01-1} {
-    clock format -94608000 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W01-1
-} {Mon Monday 67 1967 1 01 1}
-test clock-3.221 {ISO week-based calendar 1967-W01-7} {
-    clock format -94089600 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W01-7
-} {Sun Sunday 67 1967 7 01 0}
-test clock-3.222 {ISO week-based calendar 1967-W02-1} {
-    clock format -94003200 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W02-1
-} {Mon Monday 67 1967 1 02 1}
-test clock-3.223 {ISO week-based calendar 1967-W52-1} {
-    clock format -63763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W52-1
-} {Mon Monday 67 1967 1 52 1}
-test clock-3.224 {ISO week-based calendar 1967-W52-7} {
-    clock format -63244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1967-W52-7
-} {Sun Sunday 67 1967 7 52 0}
-test clock-3.225 {ISO week-based calendar 1968-W01-1} {
-    clock format -63158400 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W01-1
-} {Mon Monday 68 1968 1 01 1}
-test clock-3.226 {ISO week-based calendar 1968-W01-7} {
-    clock format -62640000 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W01-7
-} {Sun Sunday 68 1968 7 01 0}
-test clock-3.227 {ISO week-based calendar 1968-W02-1} {
-    clock format -62553600 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W02-1
-} {Mon Monday 68 1968 1 02 1}
-test clock-3.228 {ISO week-based calendar 1968-W52-1} {
-    clock format -32313600 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W52-1
-} {Mon Monday 68 1968 1 52 1}
-test clock-3.229 {ISO week-based calendar 1968-W52-7} {
-    clock format -31795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1968-W52-7
-} {Sun Sunday 68 1968 7 52 0}
-test clock-3.230 {ISO week-based calendar 1969-W01-1} {
-    clock format -31708800 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W01-1
-} {Mon Monday 69 1969 1 01 1}
-test clock-3.231 {ISO week-based calendar 1969-W01-3} {
-    clock format -31536000 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W01-3
-} {Wed Wednesday 69 1969 3 01 3}
-test clock-3.232 {ISO week-based calendar 1969-W01-7} {
-    clock format -31190400 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W01-7
-} {Sun Sunday 69 1969 7 01 0}
-test clock-3.233 {ISO week-based calendar 1969-W02-1} {
-    clock format -31104000 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W02-1
-} {Mon Monday 69 1969 1 02 1}
-test clock-3.234 {ISO week-based calendar 1969-W52-1} {
-    clock format -864000 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W52-1
-} {Mon Monday 69 1969 1 52 1}
-test clock-3.235 {ISO week-based calendar 1969-W52-7} {
-    clock format -345600 -format {%a %A %g %G %u %V %w} -gmt true; # 1969-W52-7
-} {Sun Sunday 69 1969 7 52 0}
-test clock-3.236 {ISO week-based calendar 1970-W01-1} {
-    clock format -259200 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W01-1
-} {Mon Monday 70 1970 1 01 1}
-test clock-3.237 {ISO week-based calendar 1970-W01-4} {
-    clock format 0 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W01-4
-} {Thu Thursday 70 1970 4 01 4}
-test clock-3.238 {ISO week-based calendar 1970-W01-7} {
-    clock format 259200 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W01-7
-} {Sun Sunday 70 1970 7 01 0}
-test clock-3.239 {ISO week-based calendar 1970-W02-1} {
-    clock format 345600 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W02-1
-} {Mon Monday 70 1970 1 02 1}
-test clock-3.240 {ISO week-based calendar 1970-W53-1} {
-    clock format 31190400 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W53-1
-} {Mon Monday 70 1970 1 53 1}
-test clock-3.241 {ISO week-based calendar 1970-W53-5} {
-    clock format 31536000 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W53-5
-} {Fri Friday 70 1970 5 53 5}
-test clock-3.242 {ISO week-based calendar 1970-W53-7} {
-    clock format 31708800 -format {%a %A %g %G %u %V %w} -gmt true; # 1970-W53-7
-} {Sun Sunday 70 1970 7 53 0}
-test clock-3.243 {ISO week-based calendar 1971-W01-1} {
-    clock format 31795200 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W01-1
-} {Mon Monday 71 1971 1 01 1}
-test clock-3.244 {ISO week-based calendar 1971-W01-7} {
-    clock format 32313600 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W01-7
-} {Sun Sunday 71 1971 7 01 0}
-test clock-3.245 {ISO week-based calendar 1971-W02-1} {
-    clock format 32400000 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W02-1
-} {Mon Monday 71 1971 1 02 1}
-test clock-3.246 {ISO week-based calendar 1971-W52-1} {
-    clock format 62640000 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W52-1
-} {Mon Monday 71 1971 1 52 1}
-test clock-3.247 {ISO week-based calendar 1971-W52-6} {
-    clock format 63072000 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W52-6
-} {Sat Saturday 71 1971 6 52 6}
-test clock-3.248 {ISO week-based calendar 1971-W52-7} {
-    clock format 63158400 -format {%a %A %g %G %u %V %w} -gmt true; # 1971-W52-7
-} {Sun Sunday 71 1971 7 52 0}
-test clock-3.249 {ISO week-based calendar 1972-W01-1} {
-    clock format 63244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W01-1
-} {Mon Monday 72 1972 1 01 1}
-test clock-3.250 {ISO week-based calendar 1972-W01-7} {
-    clock format 63763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W01-7
-} {Sun Sunday 72 1972 7 01 0}
-test clock-3.251 {ISO week-based calendar 1972-W02-1} {
-    clock format 63849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W02-1
-} {Mon Monday 72 1972 1 02 1}
-test clock-3.252 {ISO week-based calendar 1972-W52-1} {
-    clock format 94089600 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W52-1
-} {Mon Monday 72 1972 1 52 1}
-test clock-3.253 {ISO week-based calendar 1972-W52-7} {
-    clock format 94608000 -format {%a %A %g %G %u %V %w} -gmt true; # 1972-W52-7
-} {Sun Sunday 72 1972 7 52 0}
-test clock-3.254 {ISO week-based calendar 1973-W01-1} {
-    clock format 94694400 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W01-1
-} {Mon Monday 73 1973 1 01 1}
-test clock-3.255 {ISO week-based calendar 1973-W01-7} {
-    clock format 95212800 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W01-7
-} {Sun Sunday 73 1973 7 01 0}
-test clock-3.256 {ISO week-based calendar 1973-W02-1} {
-    clock format 95299200 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W02-1
-} {Mon Monday 73 1973 1 02 1}
-test clock-3.257 {ISO week-based calendar 1973-W52-1} {
-    clock format 125539200 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W52-1
-} {Mon Monday 73 1973 1 52 1}
-test clock-3.258 {ISO week-based calendar 1973-W52-7} {
-    clock format 126057600 -format {%a %A %g %G %u %V %w} -gmt true; # 1973-W52-7
-} {Sun Sunday 73 1973 7 52 0}
-test clock-3.259 {ISO week-based calendar 1974-W01-1} {
-    clock format 126144000 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W01-1
-} {Mon Monday 74 1974 1 01 1}
-test clock-3.260 {ISO week-based calendar 1974-W01-2} {
-    clock format 126230400 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W01-2
-} {Tue Tuesday 74 1974 2 01 2}
-test clock-3.261 {ISO week-based calendar 1974-W01-7} {
-    clock format 126662400 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W01-7
-} {Sun Sunday 74 1974 7 01 0}
-test clock-3.262 {ISO week-based calendar 1974-W02-1} {
-    clock format 126748800 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W02-1
-} {Mon Monday 74 1974 1 02 1}
-test clock-3.263 {ISO week-based calendar 1974-W52-1} {
-    clock format 156988800 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W52-1
-} {Mon Monday 74 1974 1 52 1}
-test clock-3.264 {ISO week-based calendar 1974-W52-7} {
-    clock format 157507200 -format {%a %A %g %G %u %V %w} -gmt true; # 1974-W52-7
-} {Sun Sunday 74 1974 7 52 0}
-test clock-3.265 {ISO week-based calendar 1975-W01-1} {
-    clock format 157593600 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W01-1
-} {Mon Monday 75 1975 1 01 1}
-test clock-3.266 {ISO week-based calendar 1975-W01-3} {
-    clock format 157766400 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W01-3
-} {Wed Wednesday 75 1975 3 01 3}
-test clock-3.267 {ISO week-based calendar 1975-W01-7} {
-    clock format 158112000 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W01-7
-} {Sun Sunday 75 1975 7 01 0}
-test clock-3.268 {ISO week-based calendar 1975-W02-1} {
-    clock format 158198400 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W02-1
-} {Mon Monday 75 1975 1 02 1}
-test clock-3.269 {ISO week-based calendar 1975-W52-1} {
-    clock format 188438400 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W52-1
-} {Mon Monday 75 1975 1 52 1}
-test clock-3.270 {ISO week-based calendar 1975-W52-7} {
-    clock format 188956800 -format {%a %A %g %G %u %V %w} -gmt true; # 1975-W52-7
-} {Sun Sunday 75 1975 7 52 0}
-test clock-3.271 {ISO week-based calendar 1976-W01-1} {
-    clock format 189043200 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W01-1
-} {Mon Monday 76 1976 1 01 1}
-test clock-3.272 {ISO week-based calendar 1976-W01-4} {
-    clock format 189302400 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W01-4
-} {Thu Thursday 76 1976 4 01 4}
-test clock-3.273 {ISO week-based calendar 1976-W01-7} {
-    clock format 189561600 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W01-7
-} {Sun Sunday 76 1976 7 01 0}
-test clock-3.274 {ISO week-based calendar 1976-W02-1} {
-    clock format 189648000 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W02-1
-} {Mon Monday 76 1976 1 02 1}
-test clock-3.275 {ISO week-based calendar 1976-W53-1} {
-    clock format 220492800 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W53-1
-} {Mon Monday 76 1976 1 53 1}
-test clock-3.276 {ISO week-based calendar 1976-W53-6} {
-    clock format 220924800 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W53-6
-} {Sat Saturday 76 1976 6 53 6}
-test clock-3.277 {ISO week-based calendar 1976-W53-7} {
-    clock format 221011200 -format {%a %A %g %G %u %V %w} -gmt true; # 1976-W53-7
-} {Sun Sunday 76 1976 7 53 0}
-test clock-3.278 {ISO week-based calendar 1977-W01-1} {
-    clock format 221097600 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W01-1
-} {Mon Monday 77 1977 1 01 1}
-test clock-3.279 {ISO week-based calendar 1977-W01-7} {
-    clock format 221616000 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W01-7
-} {Sun Sunday 77 1977 7 01 0}
-test clock-3.280 {ISO week-based calendar 1977-W02-1} {
-    clock format 221702400 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W02-1
-} {Mon Monday 77 1977 1 02 1}
-test clock-3.281 {ISO week-based calendar 1977-W52-1} {
-    clock format 251942400 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W52-1
-} {Mon Monday 77 1977 1 52 1}
-test clock-3.282 {ISO week-based calendar 1977-W52-6} {
-    clock format 252374400 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W52-6
-} {Sat Saturday 77 1977 6 52 6}
-test clock-3.283 {ISO week-based calendar 1977-W52-7} {
-    clock format 252460800 -format {%a %A %g %G %u %V %w} -gmt true; # 1977-W52-7
-} {Sun Sunday 77 1977 7 52 0}
-test clock-3.284 {ISO week-based calendar 1978-W01-1} {
-    clock format 252547200 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W01-1
-} {Mon Monday 78 1978 1 01 1}
-test clock-3.285 {ISO week-based calendar 1978-W01-7} {
-    clock format 253065600 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W01-7
-} {Sun Sunday 78 1978 7 01 0}
-test clock-3.286 {ISO week-based calendar 1978-W02-1} {
-    clock format 253152000 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W02-1
-} {Mon Monday 78 1978 1 02 1}
-test clock-3.287 {ISO week-based calendar 1978-W52-1} {
-    clock format 283392000 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W52-1
-} {Mon Monday 78 1978 1 52 1}
-test clock-3.288 {ISO week-based calendar 1978-W52-7} {
-    clock format 283910400 -format {%a %A %g %G %u %V %w} -gmt true; # 1978-W52-7
-} {Sun Sunday 78 1978 7 52 0}
-test clock-3.289 {ISO week-based calendar 1979-W01-1} {
-    clock format 283996800 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W01-1
-} {Mon Monday 79 1979 1 01 1}
-test clock-3.290 {ISO week-based calendar 1979-W01-7} {
-    clock format 284515200 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W01-7
-} {Sun Sunday 79 1979 7 01 0}
-test clock-3.291 {ISO week-based calendar 1979-W02-1} {
-    clock format 284601600 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W02-1
-} {Mon Monday 79 1979 1 02 1}
-test clock-3.292 {ISO week-based calendar 1979-W52-1} {
-    clock format 314841600 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W52-1
-} {Mon Monday 79 1979 1 52 1}
-test clock-3.293 {ISO week-based calendar 1979-W52-7} {
-    clock format 315360000 -format {%a %A %g %G %u %V %w} -gmt true; # 1979-W52-7
-} {Sun Sunday 79 1979 7 52 0}
-test clock-3.294 {ISO week-based calendar 1980-W01-1} {
-    clock format 315446400 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W01-1
-} {Mon Monday 80 1980 1 01 1}
-test clock-3.295 {ISO week-based calendar 1980-W01-2} {
-    clock format 315532800 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W01-2
-} {Tue Tuesday 80 1980 2 01 2}
-test clock-3.296 {ISO week-based calendar 1980-W01-7} {
-    clock format 315964800 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W01-7
-} {Sun Sunday 80 1980 7 01 0}
-test clock-3.297 {ISO week-based calendar 1980-W02-1} {
-    clock format 316051200 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W02-1
-} {Mon Monday 80 1980 1 02 1}
-test clock-3.298 {ISO week-based calendar 1980-W52-1} {
-    clock format 346291200 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W52-1
-} {Mon Monday 80 1980 1 52 1}
-test clock-3.299 {ISO week-based calendar 1980-W52-7} {
-    clock format 346809600 -format {%a %A %g %G %u %V %w} -gmt true; # 1980-W52-7
-} {Sun Sunday 80 1980 7 52 0}
-test clock-3.300 {ISO week-based calendar 1981-W01-1} {
-    clock format 346896000 -format {%a %A %g %G %u %V %w} -gmt true; # 1981-W01-1
-} {Mon Monday 81 1981 1 01 1}
-test clock-3.301 {ISO week-based calendar 1981-W01-4} {
-    clock format 347155200 -format {%a %A %g %G %u %V %w} -gmt true; # 1981-W01-4
-} {Thu Thursday 81 1981 4 01 4}
-test clock-3.302 {ISO week-based calendar 1981-W01-7} {
-    clock format 347414400 -format {%a %A %g %G %u %V %w} -gmt true; # 1981-W01-7
-} {Sun Sunday 81 1981 7 01 0}
-test clock-3.303 {ISO week-based calendar 1981-W02-1} {
-    clock format 347500800 -format {%a %A %g %G %u %V %w} -gmt true; # 1981-W02-1
-} {Mon Monday 81 1981 1 02 1}
-test clock-3.304 {ISO week-based calendar 1983-W52-1} {
-    clock format 441244800 -format {%a %A %g %G %u %V %w} -gmt true; # 1983-W52-1
-} {Mon Monday 83 1983 1 52 1}
-test clock-3.305 {ISO week-based calendar 1983-W52-6} {
-    clock format 441676800 -format {%a %A %g %G %u %V %w} -gmt true; # 1983-W52-6
-} {Sat Saturday 83 1983 6 52 6}
-test clock-3.306 {ISO week-based calendar 1983-W52-7} {
-    clock format 441763200 -format {%a %A %g %G %u %V %w} -gmt true; # 1983-W52-7
-} {Sun Sunday 83 1983 7 52 0}
-test clock-3.307 {ISO week-based calendar 1984-W01-1} {
-    clock format 441849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W01-1
-} {Mon Monday 84 1984 1 01 1}
-test clock-3.308 {ISO week-based calendar 1984-W01-7} {
-    clock format 442368000 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W01-7
-} {Sun Sunday 84 1984 7 01 0}
-test clock-3.309 {ISO week-based calendar 1984-W02-1} {
-    clock format 442454400 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W02-1
-} {Mon Monday 84 1984 1 02 1}
-test clock-3.310 {ISO week-based calendar 1984-W52-1} {
-    clock format 472694400 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W52-1
-} {Mon Monday 84 1984 1 52 1}
-test clock-3.311 {ISO week-based calendar 1984-W52-7} {
-    clock format 473212800 -format {%a %A %g %G %u %V %w} -gmt true; # 1984-W52-7
-} {Sun Sunday 84 1984 7 52 0}
-test clock-3.312 {ISO week-based calendar 1985-W01-1} {
-    clock format 473299200 -format {%a %A %g %G %u %V %w} -gmt true; # 1985-W01-1
-} {Mon Monday 85 1985 1 01 1}
-test clock-3.313 {ISO week-based calendar 1985-W01-2} {
-    clock format 473385600 -format {%a %A %g %G %u %V %w} -gmt true; # 1985-W01-2
-} {Tue Tuesday 85 1985 2 01 2}
-test clock-3.314 {ISO week-based calendar 1985-W01-7} {
-    clock format 473817600 -format {%a %A %g %G %u %V %w} -gmt true; # 1985-W01-7
-} {Sun Sunday 85 1985 7 01 0}
-test clock-3.315 {ISO week-based calendar 1985-W02-1} {
-    clock format 473904000 -format {%a %A %g %G %u %V %w} -gmt true; # 1985-W02-1
-} {Mon Monday 85 1985 1 02 1}
-test clock-3.316 {ISO week-based calendar 1987-W53-1} {
-    clock format 567648000 -format {%a %A %g %G %u %V %w} -gmt true; # 1987-W53-1
-} {Mon Monday 87 1987 1 53 1}
-test clock-3.317 {ISO week-based calendar 1987-W53-5} {
-    clock format 567993600 -format {%a %A %g %G %u %V %w} -gmt true; # 1987-W53-5
-} {Fri Friday 87 1987 5 53 5}
-test clock-3.318 {ISO week-based calendar 1987-W53-7} {
-    clock format 568166400 -format {%a %A %g %G %u %V %w} -gmt true; # 1987-W53-7
-} {Sun Sunday 87 1987 7 53 0}
-test clock-3.319 {ISO week-based calendar 1988-W01-1} {
-    clock format 568252800 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W01-1
-} {Mon Monday 88 1988 1 01 1}
-test clock-3.320 {ISO week-based calendar 1988-W01-7} {
-    clock format 568771200 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W01-7
-} {Sun Sunday 88 1988 7 01 0}
-test clock-3.321 {ISO week-based calendar 1988-W02-1} {
-    clock format 568857600 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W02-1
-} {Mon Monday 88 1988 1 02 1}
-test clock-3.322 {ISO week-based calendar 1988-W52-1} {
-    clock format 599097600 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W52-1
-} {Mon Monday 88 1988 1 52 1}
-test clock-3.323 {ISO week-based calendar 1988-W52-6} {
-    clock format 599529600 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W52-6
-} {Sat Saturday 88 1988 6 52 6}
-test clock-3.324 {ISO week-based calendar 1988-W52-7} {
-    clock format 599616000 -format {%a %A %g %G %u %V %w} -gmt true; # 1988-W52-7
-} {Sun Sunday 88 1988 7 52 0}
-test clock-3.325 {ISO week-based calendar 1989-W01-1} {
-    clock format 599702400 -format {%a %A %g %G %u %V %w} -gmt true; # 1989-W01-1
-} {Mon Monday 89 1989 1 01 1}
-test clock-3.326 {ISO week-based calendar 1989-W01-7} {
-    clock format 600220800 -format {%a %A %g %G %u %V %w} -gmt true; # 1989-W01-7
-} {Sun Sunday 89 1989 7 01 0}
-test clock-3.327 {ISO week-based calendar 1989-W02-1} {
-    clock format 600307200 -format {%a %A %g %G %u %V %w} -gmt true; # 1989-W02-1
-} {Mon Monday 89 1989 1 02 1}
-test clock-3.328 {ISO week-based calendar 1991-W52-1} {
-    clock format 693446400 -format {%a %A %g %G %u %V %w} -gmt true; # 1991-W52-1
-} {Mon Monday 91 1991 1 52 1}
-test clock-3.329 {ISO week-based calendar 1991-W52-7} {
-    clock format 693964800 -format {%a %A %g %G %u %V %w} -gmt true; # 1991-W52-7
-} {Sun Sunday 91 1991 7 52 0}
-test clock-3.330 {ISO week-based calendar 1992-W01-1} {
-    clock format 694051200 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W01-1
-} {Mon Monday 92 1992 1 01 1}
-test clock-3.331 {ISO week-based calendar 1992-W01-3} {
-    clock format 694224000 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W01-3
-} {Wed Wednesday 92 1992 3 01 3}
-test clock-3.332 {ISO week-based calendar 1992-W01-7} {
-    clock format 694569600 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W01-7
-} {Sun Sunday 92 1992 7 01 0}
-test clock-3.333 {ISO week-based calendar 1992-W02-1} {
-    clock format 694656000 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W02-1
-} {Mon Monday 92 1992 1 02 1}
-test clock-3.334 {ISO week-based calendar 1992-W53-1} {
-    clock format 725500800 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W53-1
-} {Mon Monday 92 1992 1 53 1}
-test clock-3.335 {ISO week-based calendar 1992-W53-5} {
-    clock format 725846400 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W53-5
-} {Fri Friday 92 1992 5 53 5}
-test clock-3.336 {ISO week-based calendar 1992-W53-7} {
-    clock format 726019200 -format {%a %A %g %G %u %V %w} -gmt true; # 1992-W53-7
-} {Sun Sunday 92 1992 7 53 0}
-test clock-3.337 {ISO week-based calendar 1993-W01-1} {
-    clock format 726105600 -format {%a %A %g %G %u %V %w} -gmt true; # 1993-W01-1
-} {Mon Monday 93 1993 1 01 1}
-test clock-3.338 {ISO week-based calendar 1993-W01-7} {
-    clock format 726624000 -format {%a %A %g %G %u %V %w} -gmt true; # 1993-W01-7
-} {Sun Sunday 93 1993 7 01 0}
-test clock-3.339 {ISO week-based calendar 1993-W02-1} {
-    clock format 726710400 -format {%a %A %g %G %u %V %w} -gmt true; # 1993-W02-1
-} {Mon Monday 93 1993 1 02 1}
-test clock-3.340 {ISO week-based calendar 1995-W52-1} {
-    clock format 819849600 -format {%a %A %g %G %u %V %w} -gmt true; # 1995-W52-1
-} {Mon Monday 95 1995 1 52 1}
-test clock-3.341 {ISO week-based calendar 1995-W52-7} {
-    clock format 820368000 -format {%a %A %g %G %u %V %w} -gmt true; # 1995-W52-7
-} {Sun Sunday 95 1995 7 52 0}
-test clock-3.342 {ISO week-based calendar 1996-W01-1} {
-    clock format 820454400 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W01-1
-} {Mon Monday 96 1996 1 01 1}
-test clock-3.343 {ISO week-based calendar 1996-W01-7} {
-    clock format 820972800 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W01-7
-} {Sun Sunday 96 1996 7 01 0}
-test clock-3.344 {ISO week-based calendar 1996-W02-1} {
-    clock format 821059200 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W02-1
-} {Mon Monday 96 1996 1 02 1}
-test clock-3.345 {ISO week-based calendar 1996-W52-1} {
-    clock format 851299200 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W52-1
-} {Mon Monday 96 1996 1 52 1}
-test clock-3.346 {ISO week-based calendar 1996-W52-7} {
-    clock format 851817600 -format {%a %A %g %G %u %V %w} -gmt true; # 1996-W52-7
-} {Sun Sunday 96 1996 7 52 0}
-test clock-3.347 {ISO week-based calendar 1997-W01-1} {
-    clock format 851904000 -format {%a %A %g %G %u %V %w} -gmt true; # 1997-W01-1
-} {Mon Monday 97 1997 1 01 1}
-test clock-3.348 {ISO week-based calendar 1997-W01-3} {
-    clock format 852076800 -format {%a %A %g %G %u %V %w} -gmt true; # 1997-W01-3
-} {Wed Wednesday 97 1997 3 01 3}
-test clock-3.349 {ISO week-based calendar 1997-W01-7} {
-    clock format 852422400 -format {%a %A %g %G %u %V %w} -gmt true; # 1997-W01-7
-} {Sun Sunday 97 1997 7 01 0}
-test clock-3.350 {ISO week-based calendar 1997-W02-1} {
-    clock format 852508800 -format {%a %A %g %G %u %V %w} -gmt true; # 1997-W02-1
-} {Mon Monday 97 1997 1 02 1}
-test clock-3.351 {ISO week-based calendar 1999-W52-1} {
-    clock format 946252800 -format {%a %A %g %G %u %V %w} -gmt true; # 1999-W52-1
-} {Mon Monday 99 1999 1 52 1}
-test clock-3.352 {ISO week-based calendar 1999-W52-6} {
-    clock format 946684800 -format {%a %A %g %G %u %V %w} -gmt true; # 1999-W52-6
-} {Sat Saturday 99 1999 6 52 6}
-test clock-3.353 {ISO week-based calendar 1999-W52-7} {
-    clock format 946771200 -format {%a %A %g %G %u %V %w} -gmt true; # 1999-W52-7
-} {Sun Sunday 99 1999 7 52 0}
-test clock-3.354 {ISO week-based calendar 2000-W01-1} {
-    clock format 946857600 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W01-1
-} {Mon Monday 00 2000 1 01 1}
-test clock-3.355 {ISO week-based calendar 2000-W01-7} {
-    clock format 947376000 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W01-7
-} {Sun Sunday 00 2000 7 01 0}
-test clock-3.356 {ISO week-based calendar 2000-W02-1} {
-    clock format 947462400 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W02-1
-} {Mon Monday 00 2000 1 02 1}
-test clock-3.357 {ISO week-based calendar 2000-W52-1} {
-    clock format 977702400 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W52-1
-} {Mon Monday 00 2000 1 52 1}
-test clock-3.358 {ISO week-based calendar 2000-W52-7} {
-    clock format 978220800 -format {%a %A %g %G %u %V %w} -gmt true; # 2000-W52-7
-} {Sun Sunday 00 2000 7 52 0}
-test clock-3.359 {ISO week-based calendar 2001-W01-1} {
-    clock format 978307200 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W01-1
-} {Mon Monday 01 2001 1 01 1}
-test clock-3.360 {ISO week-based calendar 2001-W01-7} {
-    clock format 978825600 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W01-7
-} {Sun Sunday 01 2001 7 01 0}
-test clock-3.361 {ISO week-based calendar 2001-W02-1} {
-    clock format 978912000 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W02-1
-} {Mon Monday 01 2001 1 02 1}
-test clock-3.362 {ISO week-based calendar 2001-W52-1} {
-    clock format 1009152000 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W52-1
-} {Mon Monday 01 2001 1 52 1}
-test clock-3.363 {ISO week-based calendar 2001-W52-7} {
-    clock format 1009670400 -format {%a %A %g %G %u %V %w} -gmt true; # 2001-W52-7
-} {Sun Sunday 01 2001 7 52 0}
-test clock-3.364 {ISO week-based calendar 2002-W01-1} {
-    clock format 1009756800 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W01-1
-} {Mon Monday 02 2002 1 01 1}
-test clock-3.365 {ISO week-based calendar 2002-W01-2} {
-    clock format 1009843200 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W01-2
-} {Tue Tuesday 02 2002 2 01 2}
-test clock-3.366 {ISO week-based calendar 2002-W01-7} {
-    clock format 1010275200 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W01-7
-} {Sun Sunday 02 2002 7 01 0}
-test clock-3.367 {ISO week-based calendar 2002-W02-1} {
-    clock format 1010361600 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W02-1
-} {Mon Monday 02 2002 1 02 1}
-test clock-3.368 {ISO week-based calendar 2002-W52-1} {
-    clock format 1040601600 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W52-1
-} {Mon Monday 02 2002 1 52 1}
-test clock-3.369 {ISO week-based calendar 2002-W52-7} {
-    clock format 1041120000 -format {%a %A %g %G %u %V %w} -gmt true; # 2002-W52-7
-} {Sun Sunday 02 2002 7 52 0}
-test clock-3.370 {ISO week-based calendar 2003-W01-1} {
-    clock format 1041206400 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W01-1
-} {Mon Monday 03 2003 1 01 1}
-test clock-3.371 {ISO week-based calendar 2003-W01-3} {
-    clock format 1041379200 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W01-3
-} {Wed Wednesday 03 2003 3 01 3}
-test clock-3.372 {ISO week-based calendar 2003-W01-7} {
-    clock format 1041724800 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W01-7
-} {Sun Sunday 03 2003 7 01 0}
-test clock-3.373 {ISO week-based calendar 2003-W02-1} {
-    clock format 1041811200 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W02-1
-} {Mon Monday 03 2003 1 02 1}
-test clock-3.374 {ISO week-based calendar 2003-W52-1} {
-    clock format 1072051200 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W52-1
-} {Mon Monday 03 2003 1 52 1}
-test clock-3.375 {ISO week-based calendar 2003-W52-7} {
-    clock format 1072569600 -format {%a %A %g %G %u %V %w} -gmt true; # 2003-W52-7
-} {Sun Sunday 03 2003 7 52 0}
-test clock-3.376 {ISO week-based calendar 2004-W01-1} {
-    clock format 1072656000 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W01-1
-} {Mon Monday 04 2004 1 01 1}
-test clock-3.377 {ISO week-based calendar 2004-W01-4} {
-    clock format 1072915200 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W01-4
-} {Thu Thursday 04 2004 4 01 4}
-test clock-3.378 {ISO week-based calendar 2004-W01-7} {
-    clock format 1073174400 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W01-7
-} {Sun Sunday 04 2004 7 01 0}
-test clock-3.379 {ISO week-based calendar 2004-W02-1} {
-    clock format 1073260800 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W02-1
-} {Mon Monday 04 2004 1 02 1}
-test clock-3.380 {ISO week-based calendar 2004-W53-1} {
-    clock format 1104105600 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W53-1
-} {Mon Monday 04 2004 1 53 1}
-test clock-3.381 {ISO week-based calendar 2004-W53-6} {
-    clock format 1104537600 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W53-6
-} {Sat Saturday 04 2004 6 53 6}
-test clock-3.382 {ISO week-based calendar 2004-W53-7} {
-    clock format 1104624000 -format {%a %A %g %G %u %V %w} -gmt true; # 2004-W53-7
-} {Sun Sunday 04 2004 7 53 0}
-test clock-3.383 {ISO week-based calendar 2005-W01-1} {
-    clock format 1104710400 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W01-1
-} {Mon Monday 05 2005 1 01 1}
-test clock-3.384 {ISO week-based calendar 2005-W01-7} {
-    clock format 1105228800 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W01-7
-} {Sun Sunday 05 2005 7 01 0}
-test clock-3.385 {ISO week-based calendar 2005-W02-1} {
-    clock format 1105315200 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W02-1
-} {Mon Monday 05 2005 1 02 1}
-test clock-3.386 {ISO week-based calendar 2005-W52-1} {
-    clock format 1135555200 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W52-1
-} {Mon Monday 05 2005 1 52 1}
-test clock-3.387 {ISO week-based calendar 2005-W52-6} {
-    clock format 1135987200 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W52-6
-} {Sat Saturday 05 2005 6 52 6}
-test clock-3.388 {ISO week-based calendar 2005-W52-7} {
-    clock format 1136073600 -format {%a %A %g %G %u %V %w} -gmt true; # 2005-W52-7
-} {Sun Sunday 05 2005 7 52 0}
-test clock-3.389 {ISO week-based calendar 2006-W01-1} {
-    clock format 1136160000 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W01-1
-} {Mon Monday 06 2006 1 01 1}
-test clock-3.390 {ISO week-based calendar 2006-W01-7} {
-    clock format 1136678400 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W01-7
-} {Sun Sunday 06 2006 7 01 0}
-test clock-3.391 {ISO week-based calendar 2006-W02-1} {
-    clock format 1136764800 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W02-1
-} {Mon Monday 06 2006 1 02 1}
-test clock-3.392 {ISO week-based calendar 2006-W52-1} {
-    clock format 1167004800 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W52-1
-} {Mon Monday 06 2006 1 52 1}
-test clock-3.393 {ISO week-based calendar 2006-W52-7} {
-    clock format 1167523200 -format {%a %A %g %G %u %V %w} -gmt true; # 2006-W52-7
-} {Sun Sunday 06 2006 7 52 0}
-test clock-3.394 {ISO week-based calendar 2007-W01-1} {
-    clock format 1167609600 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W01-1
-} {Mon Monday 07 2007 1 01 1}
-test clock-3.395 {ISO week-based calendar 2007-W01-7} {
-    clock format 1168128000 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W01-7
-} {Sun Sunday 07 2007 7 01 0}
-test clock-3.396 {ISO week-based calendar 2007-W02-1} {
-    clock format 1168214400 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W02-1
-} {Mon Monday 07 2007 1 02 1}
-test clock-3.397 {ISO week-based calendar 2007-W52-1} {
-    clock format 1198454400 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W52-1
-} {Mon Monday 07 2007 1 52 1}
-test clock-3.398 {ISO week-based calendar 2007-W52-7} {
-    clock format 1198972800 -format {%a %A %g %G %u %V %w} -gmt true; # 2007-W52-7
-} {Sun Sunday 07 2007 7 52 0}
-test clock-3.399 {ISO week-based calendar 2008-W01-1} {
-    clock format 1199059200 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W01-1
-} {Mon Monday 08 2008 1 01 1}
-test clock-3.400 {ISO week-based calendar 2008-W01-2} {
-    clock format 1199145600 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W01-2
-} {Tue Tuesday 08 2008 2 01 2}
-test clock-3.401 {ISO week-based calendar 2008-W01-7} {
-    clock format 1199577600 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W01-7
-} {Sun Sunday 08 2008 7 01 0}
-test clock-3.402 {ISO week-based calendar 2008-W02-1} {
-    clock format 1199664000 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W02-1
-} {Mon Monday 08 2008 1 02 1}
-test clock-3.403 {ISO week-based calendar 2008-W52-1} {
-    clock format 1229904000 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W52-1
-} {Mon Monday 08 2008 1 52 1}
-test clock-3.404 {ISO week-based calendar 2008-W52-7} {
-    clock format 1230422400 -format {%a %A %g %G %u %V %w} -gmt true; # 2008-W52-7
-} {Sun Sunday 08 2008 7 52 0}
-test clock-3.405 {ISO week-based calendar 2009-W01-1} {
-    clock format 1230508800 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W01-1
-} {Mon Monday 09 2009 1 01 1}
-test clock-3.406 {ISO week-based calendar 2009-W01-4} {
-    clock format 1230768000 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W01-4
-} {Thu Thursday 09 2009 4 01 4}
-test clock-3.407 {ISO week-based calendar 2009-W01-7} {
-    clock format 1231027200 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W01-7
-} {Sun Sunday 09 2009 7 01 0}
-test clock-3.408 {ISO week-based calendar 2009-W02-1} {
-    clock format 1231113600 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W02-1
-} {Mon Monday 09 2009 1 02 1}
-test clock-3.409 {ISO week-based calendar 2009-W53-1} {
-    clock format 1261958400 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W53-1
-} {Mon Monday 09 2009 1 53 1}
-test clock-3.410 {ISO week-based calendar 2009-W53-5} {
-    clock format 1262304000 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W53-5
-} {Fri Friday 09 2009 5 53 5}
-test clock-3.411 {ISO week-based calendar 2009-W53-7} {
-    clock format 1262476800 -format {%a %A %g %G %u %V %w} -gmt true; # 2009-W53-7
-} {Sun Sunday 09 2009 7 53 0}
-test clock-3.412 {ISO week-based calendar 2010-W01-1} {
-    clock format 1262563200 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W01-1
-} {Mon Monday 10 2010 1 01 1}
-test clock-3.413 {ISO week-based calendar 2010-W01-7} {
-    clock format 1263081600 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W01-7
-} {Sun Sunday 10 2010 7 01 0}
-test clock-3.414 {ISO week-based calendar 2010-W02-1} {
-    clock format 1263168000 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W02-1
-} {Mon Monday 10 2010 1 02 1}
-test clock-3.415 {ISO week-based calendar 2010-W52-1} {
-    clock format 1293408000 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W52-1
-} {Mon Monday 10 2010 1 52 1}
-test clock-3.416 {ISO week-based calendar 2010-W52-6} {
-    clock format 1293840000 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W52-6
-} {Sat Saturday 10 2010 6 52 6}
-test clock-3.417 {ISO week-based calendar 2010-W52-7} {
-    clock format 1293926400 -format {%a %A %g %G %u %V %w} -gmt true; # 2010-W52-7
-} {Sun Sunday 10 2010 7 52 0}
-test clock-3.418 {ISO week-based calendar 2011-W01-1} {
-    clock format 1294012800 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W01-1
-} {Mon Monday 11 2011 1 01 1}
-test clock-3.419 {ISO week-based calendar 2011-W01-7} {
-    clock format 1294531200 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W01-7
-} {Sun Sunday 11 2011 7 01 0}
-test clock-3.420 {ISO week-based calendar 2011-W02-1} {
-    clock format 1294617600 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W02-1
-} {Mon Monday 11 2011 1 02 1}
-test clock-3.421 {ISO week-based calendar 2011-W52-1} {
-    clock format 1324857600 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W52-1
-} {Mon Monday 11 2011 1 52 1}
-test clock-3.422 {ISO week-based calendar 2011-W52-6} {
-    clock format 1325289600 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W52-6
-} {Sat Saturday 11 2011 6 52 6}
-test clock-3.423 {ISO week-based calendar 2011-W52-7} {
-    clock format 1325376000 -format {%a %A %g %G %u %V %w} -gmt true; # 2011-W52-7
-} {Sun Sunday 11 2011 7 52 0}
-test clock-3.424 {ISO week-based calendar 2012-W01-1} {
-    clock format 1325462400 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W01-1
-} {Mon Monday 12 2012 1 01 1}
-test clock-3.425 {ISO week-based calendar 2012-W01-7} {
-    clock format 1325980800 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W01-7
-} {Sun Sunday 12 2012 7 01 0}
-test clock-3.426 {ISO week-based calendar 2012-W02-1} {
-    clock format 1326067200 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W02-1
-} {Mon Monday 12 2012 1 02 1}
-test clock-3.427 {ISO week-based calendar 2012-W52-1} {
-    clock format 1356307200 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W52-1
-} {Mon Monday 12 2012 1 52 1}
-test clock-3.428 {ISO week-based calendar 2012-W52-7} {
-    clock format 1356825600 -format {%a %A %g %G %u %V %w} -gmt true; # 2012-W52-7
-} {Sun Sunday 12 2012 7 52 0}
-test clock-3.429 {ISO week-based calendar 2013-W01-1} {
-    clock format 1356912000 -format {%a %A %g %G %u %V %w} -gmt true; # 2013-W01-1
-} {Mon Monday 13 2013 1 01 1}
-test clock-3.430 {ISO week-based calendar 2013-W01-2} {
-    clock format 1356998400 -format {%a %A %g %G %u %V %w} -gmt true; # 2013-W01-2
-} {Tue Tuesday 13 2013 2 01 2}
-test clock-3.431 {ISO week-based calendar 2013-W01-7} {
-    clock format 1357430400 -format {%a %A %g %G %u %V %w} -gmt true; # 2013-W01-7
-} {Sun Sunday 13 2013 7 01 0}
-test clock-3.432 {ISO week-based calendar 2013-W02-1} {
-    clock format 1357516800 -format {%a %A %g %G %u %V %w} -gmt true; # 2013-W02-1
-} {Mon Monday 13 2013 1 02 1}
-test clock-3.433 {ISO week-based calendar 2015-W53-1} {
-    clock format 1451260800 -format {%a %A %g %G %u %V %w} -gmt true; # 2015-W53-1
-} {Mon Monday 15 2015 1 53 1}
-test clock-3.434 {ISO week-based calendar 2015-W53-5} {
-    clock format 1451606400 -format {%a %A %g %G %u %V %w} -gmt true; # 2015-W53-5
-} {Fri Friday 15 2015 5 53 5}
-test clock-3.435 {ISO week-based calendar 2015-W53-7} {
-    clock format 1451779200 -format {%a %A %g %G %u %V %w} -gmt true; # 2015-W53-7
-} {Sun Sunday 15 2015 7 53 0}
-test clock-3.436 {ISO week-based calendar 2016-W01-1} {
-    clock format 1451865600 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W01-1
-} {Mon Monday 16 2016 1 01 1}
-test clock-3.437 {ISO week-based calendar 2016-W01-7} {
-    clock format 1452384000 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W01-7
-} {Sun Sunday 16 2016 7 01 0}
-test clock-3.438 {ISO week-based calendar 2016-W02-1} {
-    clock format 1452470400 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W02-1
-} {Mon Monday 16 2016 1 02 1}
-test clock-3.439 {ISO week-based calendar 2016-W52-1} {
-    clock format 1482710400 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W52-1
-} {Mon Monday 16 2016 1 52 1}
-test clock-3.440 {ISO week-based calendar 2016-W52-6} {
-    clock format 1483142400 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W52-6
-} {Sat Saturday 16 2016 6 52 6}
-test clock-3.441 {ISO week-based calendar 2016-W52-7} {
-    clock format 1483228800 -format {%a %A %g %G %u %V %w} -gmt true; # 2016-W52-7
-} {Sun Sunday 16 2016 7 52 0}
-test clock-3.442 {ISO week-based calendar 2017-W01-1} {
-    clock format 1483315200 -format {%a %A %g %G %u %V %w} -gmt true; # 2017-W01-1
-} {Mon Monday 17 2017 1 01 1}
-test clock-3.443 {ISO week-based calendar 2017-W01-7} {
-    clock format 1483833600 -format {%a %A %g %G %u %V %w} -gmt true; # 2017-W01-7
-} {Sun Sunday 17 2017 7 01 0}
-test clock-3.444 {ISO week-based calendar 2017-W02-1} {
-    clock format 1483920000 -format {%a %A %g %G %u %V %w} -gmt true; # 2017-W02-1
-} {Mon Monday 17 2017 1 02 1}
-test clock-3.445 {ISO week-based calendar 2019-W52-1} {
-    clock format 1577059200 -format {%a %A %g %G %u %V %w} -gmt true; # 2019-W52-1
-} {Mon Monday 19 2019 1 52 1}
-test clock-3.446 {ISO week-based calendar 2019-W52-7} {
-    clock format 1577577600 -format {%a %A %g %G %u %V %w} -gmt true; # 2019-W52-7
-} {Sun Sunday 19 2019 7 52 0}
-test clock-3.447 {ISO week-based calendar 2020-W01-1} {
-    clock format 1577664000 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W01-1
-} {Mon Monday 20 2020 1 01 1}
-test clock-3.448 {ISO week-based calendar 2020-W01-3} {
-    clock format 1577836800 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W01-3
-} {Wed Wednesday 20 2020 3 01 3}
-test clock-3.449 {ISO week-based calendar 2020-W01-7} {
-    clock format 1578182400 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W01-7
-} {Sun Sunday 20 2020 7 01 0}
-test clock-3.450 {ISO week-based calendar 2020-W02-1} {
-    clock format 1578268800 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W02-1
-} {Mon Monday 20 2020 1 02 1}
-test clock-3.451 {ISO week-based calendar 2020-W53-1} {
-    clock format 1609113600 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W53-1
-} {Mon Monday 20 2020 1 53 1}
-test clock-3.452 {ISO week-based calendar 2020-W53-5} {
-    clock format 1609459200 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W53-5
-} {Fri Friday 20 2020 5 53 5}
-test clock-3.453 {ISO week-based calendar 2020-W53-7} {
-    clock format 1609632000 -format {%a %A %g %G %u %V %w} -gmt true; # 2020-W53-7
-} {Sun Sunday 20 2020 7 53 0}
-test clock-3.454 {ISO week-based calendar 2021-W01-1} {
-    clock format 1609718400 -format {%a %A %g %G %u %V %w} -gmt true; # 2021-W01-1
-} {Mon Monday 21 2021 1 01 1}
-test clock-3.455 {ISO week-based calendar 2021-W01-7} {
-    clock format 1610236800 -format {%a %A %g %G %u %V %w} -gmt true; # 2021-W01-7
-} {Sun Sunday 21 2021 7 01 0}
-test clock-3.456 {ISO week-based calendar 2021-W02-1} {
-    clock format 1610323200 -format {%a %A %g %G %u %V %w} -gmt true; # 2021-W02-1
-} {Mon Monday 21 2021 1 02 1}
-test clock-3.457 {ISO week-based calendar 2023-W52-1} {
-    clock format 1703462400 -format {%a %A %g %G %u %V %w} -gmt true; # 2023-W52-1
-} {Mon Monday 23 2023 1 52 1}
-test clock-3.458 {ISO week-based calendar 2023-W52-7} {
-    clock format 1703980800 -format {%a %A %g %G %u %V %w} -gmt true; # 2023-W52-7
-} {Sun Sunday 23 2023 7 52 0}
-test clock-3.459 {ISO week-based calendar 2024-W01-1} {
-    clock format 1704067200 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W01-1
-} {Mon Monday 24 2024 1 01 1}
-test clock-3.460 {ISO week-based calendar 2024-W01-7} {
-    clock format 1704585600 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W01-7
-} {Sun Sunday 24 2024 7 01 0}
-test clock-3.461 {ISO week-based calendar 2024-W02-1} {
-    clock format 1704672000 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W02-1
-} {Mon Monday 24 2024 1 02 1}
-test clock-3.462 {ISO week-based calendar 2024-W52-1} {
-    clock format 1734912000 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W52-1
-} {Mon Monday 24 2024 1 52 1}
-test clock-3.463 {ISO week-based calendar 2024-W52-7} {
-    clock format 1735430400 -format {%a %A %g %G %u %V %w} -gmt true; # 2024-W52-7
-} {Sun Sunday 24 2024 7 52 0}
-test clock-3.464 {ISO week-based calendar 2025-W01-1} {
-    clock format 1735516800 -format {%a %A %g %G %u %V %w} -gmt true; # 2025-W01-1
-} {Mon Monday 25 2025 1 01 1}
-test clock-3.465 {ISO week-based calendar 2025-W01-3} {
-    clock format 1735689600 -format {%a %A %g %G %u %V %w} -gmt true; # 2025-W01-3
-} {Wed Wednesday 25 2025 3 01 3}
-test clock-3.466 {ISO week-based calendar 2025-W01-7} {
-    clock format 1736035200 -format {%a %A %g %G %u %V %w} -gmt true; # 2025-W01-7
-} {Sun Sunday 25 2025 7 01 0}
-test clock-3.467 {ISO week-based calendar 2025-W02-1} {
-    clock format 1736121600 -format {%a %A %g %G %u %V %w} -gmt true; # 2025-W02-1
-} {Mon Monday 25 2025 1 02 1}
-test clock-3.468 {ISO week-based calendar 2036-W52-1} {
-    clock format 2113516800 -format {%a %A %g %G %u %V %w} -gmt true; # 2036-W52-1
-} {Mon Monday 36 2036 1 52 1}
-test clock-3.469 {ISO week-based calendar 2036-W52-7} {
-    clock format 2114035200 -format {%a %A %g %G %u %V %w} -gmt true; # 2036-W52-7
-} {Sun Sunday 36 2036 7 52 0}
-test clock-3.470 {ISO week-based calendar 2037-W01-1} {
-    clock format 2114121600 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W01-1
-} {Mon Monday 37 2037 1 01 1}
-test clock-3.471 {ISO week-based calendar 2037-W01-4} {
-    clock format 2114380800 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W01-4
-} {Thu Thursday 37 2037 4 01 4}
-test clock-3.472 {ISO week-based calendar 2037-W01-7} {
-    clock format 2114640000 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W01-7
-} {Sun Sunday 37 2037 7 01 0}
-test clock-3.473 {ISO week-based calendar 2037-W02-1} {
-    clock format 2114726400 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W02-1
-} {Mon Monday 37 2037 1 02 1}
-test clock-3.474 {ISO week-based calendar 2037-W53-1} {
-    clock format 2145571200 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W53-1
-} {Mon Monday 37 2037 1 53 1}
-test clock-3.475 {ISO week-based calendar 2037-W53-5} {
-    clock format 2145916800 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W53-5
-} {Fri Friday 37 2037 5 53 5}
-test clock-3.476 {ISO week-based calendar 2037-W53-7} {
-    clock format 2146089600 -format {%a %A %g %G %u %V %w} -gmt true; # 2037-W53-7
-} {Sun Sunday 37 2037 7 53 0}
-test clock-3.477 {ISO week-based calendar 2038-W01-1} {
-    clock format 2146176000 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W01-1
-} {Mon Monday 38 2038 1 01 1}
-test clock-3.478 {ISO week-based calendar 2038-W01-7} {
-    clock format 2146694400 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W01-7
-} {Sun Sunday 38 2038 7 01 0}
-test clock-3.479 {ISO week-based calendar 2038-W02-1} {
-    clock format 2146780800 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W02-1
-} {Mon Monday 38 2038 1 02 1}
-test clock-3.480 {ISO week-based calendar 2038-W52-1} {
-    clock format 2177020800 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W52-1
-} {Mon Monday 38 2038 1 52 1}
-test clock-3.481 {ISO week-based calendar 2038-W52-6} {
-    clock format 2177452800 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W52-6
-} {Sat Saturday 38 2038 6 52 6}
-test clock-3.482 {ISO week-based calendar 2038-W52-7} {
-    clock format 2177539200 -format {%a %A %g %G %u %V %w} -gmt true; # 2038-W52-7
-} {Sun Sunday 38 2038 7 52 0}
-test clock-3.483 {ISO week-based calendar 2039-W01-1} {
-    clock format 2177625600 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W01-1
-} {Mon Monday 39 2039 1 01 1}
-test clock-3.484 {ISO week-based calendar 2039-W01-7} {
-    clock format 2178144000 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W01-7
-} {Sun Sunday 39 2039 7 01 0}
-test clock-3.485 {ISO week-based calendar 2039-W02-1} {
-    clock format 2178230400 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W02-1
-} {Mon Monday 39 2039 1 02 1}
-test clock-3.486 {ISO week-based calendar 2039-W52-1} {
-    clock format 2208470400 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W52-1
-} {Mon Monday 39 2039 1 52 1}
-test clock-3.487 {ISO week-based calendar 2039-W52-6} {
-    clock format 2208902400 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W52-6
-} {Sat Saturday 39 2039 6 52 6}
-test clock-3.488 {ISO week-based calendar 2039-W52-7} {
-    clock format 2208988800 -format {%a %A %g %G %u %V %w} -gmt true; # 2039-W52-7
-} {Sun Sunday 39 2039 7 52 0}
-test clock-3.489 {ISO week-based calendar 2040-W01-1} {
-    clock format 2209075200 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W01-1
-} {Mon Monday 40 2040 1 01 1}
-test clock-3.490 {ISO week-based calendar 2040-W01-7} {
-    clock format 2209593600 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W01-7
-} {Sun Sunday 40 2040 7 01 0}
-test clock-3.491 {ISO week-based calendar 2040-W02-1} {
-    clock format 2209680000 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W02-1
-} {Mon Monday 40 2040 1 02 1}
-test clock-3.492 {ISO week-based calendar 2040-W52-1} {
-    clock format 2239920000 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W52-1
-} {Mon Monday 40 2040 1 52 1}
-test clock-3.493 {ISO week-based calendar 2040-W52-7} {
-    clock format 2240438400 -format {%a %A %g %G %u %V %w} -gmt true; # 2040-W52-7
-} {Sun Sunday 40 2040 7 52 0}
-test clock-3.494 {ISO week-based calendar 2041-W01-1} {
-    clock format 2240524800 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W01-1
-} {Mon Monday 41 2041 1 01 1}
-test clock-3.495 {ISO week-based calendar 2041-W01-2} {
-    clock format 2240611200 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W01-2
-} {Tue Tuesday 41 2041 2 01 2}
-test clock-3.496 {ISO week-based calendar 2041-W01-7} {
-    clock format 2241043200 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W01-7
-} {Sun Sunday 41 2041 7 01 0}
-test clock-3.497 {ISO week-based calendar 2041-W02-1} {
-    clock format 2241129600 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W02-1
-} {Mon Monday 41 2041 1 02 1}
-test clock-3.498 {ISO week-based calendar 2041-W52-1} {
-    clock format 2271369600 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W52-1
-} {Mon Monday 41 2041 1 52 1}
-test clock-3.499 {ISO week-based calendar 2041-W52-7} {
-    clock format 2271888000 -format {%a %A %g %G %u %V %w} -gmt true; # 2041-W52-7
-} {Sun Sunday 41 2041 7 52 0}
-test clock-3.500 {ISO week-based calendar 2042-W01-1} {
-    clock format 2271974400 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W01-1
-} {Mon Monday 42 2042 1 01 1}
-test clock-3.501 {ISO week-based calendar 2042-W01-3} {
-    clock format 2272147200 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W01-3
-} {Wed Wednesday 42 2042 3 01 3}
-test clock-3.502 {ISO week-based calendar 2042-W01-7} {
-    clock format 2272492800 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W01-7
-} {Sun Sunday 42 2042 7 01 0}
-test clock-3.503 {ISO week-based calendar 2042-W02-1} {
-    clock format 2272579200 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W02-1
-} {Mon Monday 42 2042 1 02 1}
-test clock-3.504 {ISO week-based calendar 2042-W52-1} {
-    clock format 2302819200 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W52-1
-} {Mon Monday 42 2042 1 52 1}
-test clock-3.505 {ISO week-based calendar 2042-W52-7} {
-    clock format 2303337600 -format {%a %A %g %G %u %V %w} -gmt true; # 2042-W52-7
-} {Sun Sunday 42 2042 7 52 0}
-test clock-3.506 {ISO week-based calendar 2043-W01-1} {
-    clock format 2303424000 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W01-1
-} {Mon Monday 43 2043 1 01 1}
-test clock-3.507 {ISO week-based calendar 2043-W01-4} {
-    clock format 2303683200 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W01-4
-} {Thu Thursday 43 2043 4 01 4}
-test clock-3.508 {ISO week-based calendar 2043-W01-7} {
-    clock format 2303942400 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W01-7
-} {Sun Sunday 43 2043 7 01 0}
-test clock-3.509 {ISO week-based calendar 2043-W02-1} {
-    clock format 2304028800 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W02-1
-} {Mon Monday 43 2043 1 02 1}
-test clock-3.510 {ISO week-based calendar 2043-W53-1} {
-    clock format 2334873600 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W53-1
-} {Mon Monday 43 2043 1 53 1}
-test clock-3.511 {ISO week-based calendar 2043-W53-5} {
-    clock format 2335219200 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W53-5
-} {Fri Friday 43 2043 5 53 5}
-test clock-3.512 {ISO week-based calendar 2043-W53-7} {
-    clock format 2335392000 -format {%a %A %g %G %u %V %w} -gmt true; # 2043-W53-7
-} {Sun Sunday 43 2043 7 53 0}
-test clock-3.513 {ISO week-based calendar 2044-W01-1} {
-    clock format 2335478400 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W01-1
-} {Mon Monday 44 2044 1 01 1}
-test clock-3.514 {ISO week-based calendar 2044-W01-7} {
-    clock format 2335996800 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W01-7
-} {Sun Sunday 44 2044 7 01 0}
-test clock-3.515 {ISO week-based calendar 2044-W02-1} {
-    clock format 2336083200 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W02-1
-} {Mon Monday 44 2044 1 02 1}
-test clock-3.516 {ISO week-based calendar 2044-W52-1} {
-    clock format 2366323200 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W52-1
-} {Mon Monday 44 2044 1 52 1}
-test clock-3.517 {ISO week-based calendar 2044-W52-6} {
-    clock format 2366755200 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W52-6
-} {Sat Saturday 44 2044 6 52 6}
-test clock-3.518 {ISO week-based calendar 2044-W52-7} {
-    clock format 2366841600 -format {%a %A %g %G %u %V %w} -gmt true; # 2044-W52-7
-} {Sun Sunday 44 2044 7 52 0}
-test clock-3.519 {ISO week-based calendar 2045-W01-1} {
-    clock format 2366928000 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W01-1
-} {Mon Monday 45 2045 1 01 1}
-test clock-3.520 {ISO week-based calendar 2045-W01-7} {
-    clock format 2367446400 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W01-7
-} {Sun Sunday 45 2045 7 01 0}
-test clock-3.521 {ISO week-based calendar 2045-W02-1} {
-    clock format 2367532800 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W02-1
-} {Mon Monday 45 2045 1 02 1}
-test clock-3.522 {ISO week-based calendar 2045-W52-1} {
-    clock format 2397772800 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W52-1
-} {Mon Monday 45 2045 1 52 1}
-test clock-3.523 {ISO week-based calendar 2045-W52-7} {
-    clock format 2398291200 -format {%a %A %g %G %u %V %w} -gmt true; # 2045-W52-7
-} {Sun Sunday 45 2045 7 52 0}
-test clock-3.524 {ISO week-based calendar 2046-W01-1} {
-    clock format 2398377600 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W01-1
-} {Mon Monday 46 2046 1 01 1}
-test clock-3.525 {ISO week-based calendar 2046-W01-7} {
-    clock format 2398896000 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W01-7
-} {Sun Sunday 46 2046 7 01 0}
-test clock-3.526 {ISO week-based calendar 2046-W02-1} {
-    clock format 2398982400 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W02-1
-} {Mon Monday 46 2046 1 02 1}
-test clock-3.527 {ISO week-based calendar 2046-W52-1} {
-    clock format 2429222400 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W52-1
-} {Mon Monday 46 2046 1 52 1}
-test clock-3.528 {ISO week-based calendar 2046-W52-7} {
-    clock format 2429740800 -format {%a %A %g %G %u %V %w} -gmt true; # 2046-W52-7
-} {Sun Sunday 46 2046 7 52 0}
-test clock-3.529 {ISO week-based calendar 2047-W01-1} {
-    clock format 2429827200 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W01-1
-} {Mon Monday 47 2047 1 01 1}
-test clock-3.530 {ISO week-based calendar 2047-W01-2} {
-    clock format 2429913600 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W01-2
-} {Tue Tuesday 47 2047 2 01 2}
-test clock-3.531 {ISO week-based calendar 2047-W01-7} {
-    clock format 2430345600 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W01-7
-} {Sun Sunday 47 2047 7 01 0}
-test clock-3.532 {ISO week-based calendar 2047-W02-1} {
-    clock format 2430432000 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W02-1
-} {Mon Monday 47 2047 1 02 1}
-test clock-3.533 {ISO week-based calendar 2047-W52-1} {
-    clock format 2460672000 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W52-1
-} {Mon Monday 47 2047 1 52 1}
-test clock-3.534 {ISO week-based calendar 2047-W52-7} {
-    clock format 2461190400 -format {%a %A %g %G %u %V %w} -gmt true; # 2047-W52-7
-} {Sun Sunday 47 2047 7 52 0}
-test clock-3.535 {ISO week-based calendar 2048-W01-1} {
-    clock format 2461276800 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W01-1
-} {Mon Monday 48 2048 1 01 1}
-test clock-3.536 {ISO week-based calendar 2048-W01-3} {
-    clock format 2461449600 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W01-3
-} {Wed Wednesday 48 2048 3 01 3}
-test clock-3.537 {ISO week-based calendar 2048-W01-7} {
-    clock format 2461795200 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W01-7
-} {Sun Sunday 48 2048 7 01 0}
-test clock-3.538 {ISO week-based calendar 2048-W02-1} {
-    clock format 2461881600 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W02-1
-} {Mon Monday 48 2048 1 02 1}
-test clock-3.539 {ISO week-based calendar 2048-W53-1} {
-    clock format 2492726400 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W53-1
-} {Mon Monday 48 2048 1 53 1}
-test clock-3.540 {ISO week-based calendar 2048-W53-5} {
-    clock format 2493072000 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W53-5
-} {Fri Friday 48 2048 5 53 5}
-test clock-3.541 {ISO week-based calendar 2048-W53-7} {
-    clock format 2493244800 -format {%a %A %g %G %u %V %w} -gmt true; # 2048-W53-7
-} {Sun Sunday 48 2048 7 53 0}
-test clock-3.542 {ISO week-based calendar 2049-W01-1} {
-    clock format 2493331200 -format {%a %A %g %G %u %V %w} -gmt true; # 2049-W01-1
-} {Mon Monday 49 2049 1 01 1}
-test clock-3.543 {ISO week-based calendar 2049-W01-7} {
-    clock format 2493849600 -format {%a %A %g %G %u %V %w} -gmt true; # 2049-W01-7
-} {Sun Sunday 49 2049 7 01 0}
-test clock-3.544 {ISO week-based calendar 2049-W02-1} {
-    clock format 2493936000 -format {%a %A %g %G %u %V %w} -gmt true; # 2049-W02-1
-} {Mon Monday 49 2049 1 02 1}
-test clock-3.545 {ISO week-based calendar 2051-W52-1} {
-    clock format 2587075200 -format {%a %A %g %G %u %V %w} -gmt true; # 2051-W52-1
-} {Mon Monday 51 2051 1 52 1}
-test clock-3.546 {ISO week-based calendar 2051-W52-7} {
-    clock format 2587593600 -format {%a %A %g %G %u %V %w} -gmt true; # 2051-W52-7
-} {Sun Sunday 51 2051 7 52 0}
-test clock-3.547 {ISO week-based calendar 2052-W01-1} {
-    clock format 2587680000 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W01-1
-} {Mon Monday 52 2052 1 01 1}
-test clock-3.548 {ISO week-based calendar 2052-W01-7} {
-    clock format 2588198400 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W01-7
-} {Sun Sunday 52 2052 7 01 0}
-test clock-3.549 {ISO week-based calendar 2052-W02-1} {
-    clock format 2588284800 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W02-1
-} {Mon Monday 52 2052 1 02 1}
-test clock-3.550 {ISO week-based calendar 2052-W52-1} {
-    clock format 2618524800 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W52-1
-} {Mon Monday 52 2052 1 52 1}
-test clock-3.551 {ISO week-based calendar 2052-W52-7} {
-    clock format 2619043200 -format {%a %A %g %G %u %V %w} -gmt true; # 2052-W52-7
-} {Sun Sunday 52 2052 7 52 0}
-test clock-3.552 {ISO week-based calendar 2053-W01-1} {
-    clock format 2619129600 -format {%a %A %g %G %u %V %w} -gmt true; # 2053-W01-1
-} {Mon Monday 53 2053 1 01 1}
-test clock-3.553 {ISO week-based calendar 2053-W01-3} {
-    clock format 2619302400 -format {%a %A %g %G %u %V %w} -gmt true; # 2053-W01-3
-} {Wed Wednesday 53 2053 3 01 3}
-test clock-3.554 {ISO week-based calendar 2053-W01-7} {
-    clock format 2619648000 -format {%a %A %g %G %u %V %w} -gmt true; # 2053-W01-7
-} {Sun Sunday 53 2053 7 01 0}
-test clock-3.555 {ISO week-based calendar 2053-W02-1} {
-    clock format 2619734400 -format {%a %A %g %G %u %V %w} -gmt true; # 2053-W02-1
-} {Mon Monday 53 2053 1 02 1}
-test clock-3.556 {ISO week-based calendar 2055-W52-1} {
-    clock format 2713478400 -format {%a %A %g %G %u %V %w} -gmt true; # 2055-W52-1
-} {Mon Monday 55 2055 1 52 1}
-test clock-3.557 {ISO week-based calendar 2055-W52-6} {
-    clock format 2713910400 -format {%a %A %g %G %u %V %w} -gmt true; # 2055-W52-6
-} {Sat Saturday 55 2055 6 52 6}
-test clock-3.558 {ISO week-based calendar 2055-W52-7} {
-    clock format 2713996800 -format {%a %A %g %G %u %V %w} -gmt true; # 2055-W52-7
-} {Sun Sunday 55 2055 7 52 0}
-test clock-3.559 {ISO week-based calendar 2056-W01-1} {
-    clock format 2714083200 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W01-1
-} {Mon Monday 56 2056 1 01 1}
-test clock-3.560 {ISO week-based calendar 2056-W01-7} {
-    clock format 2714601600 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W01-7
-} {Sun Sunday 56 2056 7 01 0}
-test clock-3.561 {ISO week-based calendar 2056-W02-1} {
-    clock format 2714688000 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W02-1
-} {Mon Monday 56 2056 1 02 1}
-test clock-3.562 {ISO week-based calendar 2056-W52-1} {
-    clock format 2744928000 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W52-1
-} {Mon Monday 56 2056 1 52 1}
-test clock-3.563 {ISO week-based calendar 2056-W52-7} {
-    clock format 2745446400 -format {%a %A %g %G %u %V %w} -gmt true; # 2056-W52-7
-} {Sun Sunday 56 2056 7 52 0}
-test clock-3.564 {ISO week-based calendar 2057-W01-1} {
-    clock format 2745532800 -format {%a %A %g %G %u %V %w} -gmt true; # 2057-W01-1
-} {Mon Monday 57 2057 1 01 1}
-test clock-3.565 {ISO week-based calendar 2057-W01-7} {
-    clock format 2746051200 -format {%a %A %g %G %u %V %w} -gmt true; # 2057-W01-7
-} {Sun Sunday 57 2057 7 01 0}
-test clock-3.566 {ISO week-based calendar 2057-W02-1} {
-    clock format 2746137600 -format {%a %A %g %G %u %V %w} -gmt true; # 2057-W02-1
-} {Mon Monday 57 2057 1 02 1}
-test clock-3.567 {ISO week-based calendar 2059-W52-1} {
-    clock format 2839276800 -format {%a %A %g %G %u %V %w} -gmt true; # 2059-W52-1
-} {Mon Monday 59 2059 1 52 1}
-test clock-3.568 {ISO week-based calendar 2059-W52-7} {
-    clock format 2839795200 -format {%a %A %g %G %u %V %w} -gmt true; # 2059-W52-7
-} {Sun Sunday 59 2059 7 52 0}
-test clock-3.569 {ISO week-based calendar 2060-W01-1} {
-    clock format 2839881600 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W01-1
-} {Mon Monday 60 2060 1 01 1}
-test clock-3.570 {ISO week-based calendar 2060-W01-4} {
-    clock format 2840140800 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W01-4
-} {Thu Thursday 60 2060 4 01 4}
-test clock-3.571 {ISO week-based calendar 2060-W01-7} {
-    clock format 2840400000 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W01-7
-} {Sun Sunday 60 2060 7 01 0}
-test clock-3.572 {ISO week-based calendar 2060-W02-1} {
-    clock format 2840486400 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W02-1
-} {Mon Monday 60 2060 1 02 1}
-test clock-3.573 {ISO week-based calendar 2060-W53-1} {
-    clock format 2871331200 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W53-1
-} {Mon Monday 60 2060 1 53 1}
-test clock-3.574 {ISO week-based calendar 2060-W53-6} {
-    clock format 2871763200 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W53-6
-} {Sat Saturday 60 2060 6 53 6}
-test clock-3.575 {ISO week-based calendar 2060-W53-7} {
-    clock format 2871849600 -format {%a %A %g %G %u %V %w} -gmt true; # 2060-W53-7
-} {Sun Sunday 60 2060 7 53 0}
-test clock-3.576 {ISO week-based calendar 2061-W01-1} {
-    clock format 2871936000 -format {%a %A %g %G %u %V %w} -gmt true; # 2061-W01-1
-} {Mon Monday 61 2061 1 01 1}
-test clock-3.577 {ISO week-based calendar 2061-W01-7} {
-    clock format 2872454400 -format {%a %A %g %G %u %V %w} -gmt true; # 2061-W01-7
-} {Sun Sunday 61 2061 7 01 0}
-test clock-3.578 {ISO week-based calendar 2061-W02-1} {
-    clock format 2872540800 -format {%a %A %g %G %u %V %w} -gmt true; # 2061-W02-1
-} {Mon Monday 61 2061 1 02 1}
-test clock-3.579 {ISO week-based calendar 2063-W52-1} {
-    clock format 2965680000 -format {%a %A %g %G %u %V %w} -gmt true; # 2063-W52-1
-} {Mon Monday 63 2063 1 52 1}
-test clock-3.580 {ISO week-based calendar 2063-W52-7} {
-    clock format 2966198400 -format {%a %A %g %G %u %V %w} -gmt true; # 2063-W52-7
-} {Sun Sunday 63 2063 7 52 0}
-test clock-3.581 {ISO week-based calendar 2064-W01-1} {
-    clock format 2966284800 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W01-1
-} {Mon Monday 64 2064 1 01 1}
-test clock-3.582 {ISO week-based calendar 2064-W01-2} {
-    clock format 2966371200 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W01-2
-} {Tue Tuesday 64 2064 2 01 2}
-test clock-3.583 {ISO week-based calendar 2064-W01-7} {
-    clock format 2966803200 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W01-7
-} {Sun Sunday 64 2064 7 01 0}
-test clock-3.584 {ISO week-based calendar 2064-W02-1} {
-    clock format 2966889600 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W02-1
-} {Mon Monday 64 2064 1 02 1}
-test clock-3.585 {ISO week-based calendar 2064-W52-1} {
-    clock format 2997129600 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W52-1
-} {Mon Monday 64 2064 1 52 1}
-test clock-3.586 {ISO week-based calendar 2064-W52-7} {
-    clock format 2997648000 -format {%a %A %g %G %u %V %w} -gmt true; # 2064-W52-7
-} {Sun Sunday 64 2064 7 52 0}
-test clock-3.587 {ISO week-based calendar 2065-W01-1} {
-    clock format 2997734400 -format {%a %A %g %G %u %V %w} -gmt true; # 2065-W01-1
-} {Mon Monday 65 2065 1 01 1}
-test clock-3.588 {ISO week-based calendar 2065-W01-4} {
-    clock format 2997993600 -format {%a %A %g %G %u %V %w} -gmt true; # 2065-W01-4
-} {Thu Thursday 65 2065 4 01 4}
-test clock-3.589 {ISO week-based calendar 2065-W01-7} {
-    clock format 2998252800 -format {%a %A %g %G %u %V %w} -gmt true; # 2065-W01-7
-} {Sun Sunday 65 2065 7 01 0}
-test clock-3.590 {ISO week-based calendar 2065-W02-1} {
-    clock format 2998339200 -format {%a %A %g %G %u %V %w} -gmt true; # 2065-W02-1
-} {Mon Monday 65 2065 1 02 1}
+    clock format -3093206400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1871-W52-1
+} {Mon Monday 71 1871 1 52 52 1 52}
+test clock-3.2 {ISO week-based calendar 1871-W52-6} {
+    clock format -3092774400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1871-W52-6
+} {Sat Saturday 71 1871 6 52 52 6 52}
+test clock-3.3 {ISO week-based calendar 1871-W52-7} {
+    clock format -3092688000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1871-W52-7
+} {Sun Sunday 71 1871 7 53 52 0 52}
+test clock-3.4 {ISO week-based calendar 1872-W01-1} {
+    clock format -3092601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W01-1
+} {Mon Monday 72 1872 1 00 01 1 01}
+test clock-3.5 {ISO week-based calendar 1872-W01-6} {
+    clock format -3092169600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W01-6
+} {Sat Saturday 72 1872 6 00 01 6 01}
+test clock-3.6 {ISO week-based calendar 1872-W01-7} {
+    clock format -3092083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W01-7
+} {Sun Sunday 72 1872 7 01 01 0 01}
+test clock-3.7 {ISO week-based calendar 1872-W02-1} {
+    clock format -3091996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W02-1
+} {Mon Monday 72 1872 1 01 02 1 02}
+test clock-3.8 {ISO week-based calendar 1872-W52-1} {
+    clock format -3061756800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W52-1
+} {Mon Monday 72 1872 1 51 52 1 52}
+test clock-3.9 {ISO week-based calendar 1872-W52-6} {
+    clock format -3061324800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W52-6
+} {Sat Saturday 72 1872 6 51 52 6 52}
+test clock-3.10 {ISO week-based calendar 1872-W52-7} {
+    clock format -3061238400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1872-W52-7
+} {Sun Sunday 72 1872 7 52 52 0 52}
+test clock-3.11 {ISO week-based calendar 1873-W01-1} {
+    clock format -3061152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-1
+} {Mon Monday 73 1873 1 52 01 1 53}
+test clock-3.12 {ISO week-based calendar 1873-W01-3} {
+    clock format -3060979200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-3
+} {Wed Wednesday 73 1873 3 00 01 3 00}
+test clock-3.13 {ISO week-based calendar 1873-W01-6} {
+    clock format -3060720000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-6
+} {Sat Saturday 73 1873 6 00 01 6 00}
+test clock-3.14 {ISO week-based calendar 1873-W01-7} {
+    clock format -3060633600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W01-7
+} {Sun Sunday 73 1873 7 01 01 0 00}
+test clock-3.15 {ISO week-based calendar 1873-W02-1} {
+    clock format -3060547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1873-W02-1
+} {Mon Monday 73 1873 1 01 02 1 01}
+test clock-3.16 {ISO week-based calendar 1875-W52-1} {
+    clock format -2966803200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1875-W52-1
+} {Mon Monday 75 1875 1 52 52 1 52}
+test clock-3.17 {ISO week-based calendar 1875-W52-6} {
+    clock format -2966371200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1875-W52-6
+} {Sat Saturday 75 1875 6 00 52 6 00}
+test clock-3.18 {ISO week-based calendar 1875-W52-7} {
+    clock format -2966284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1875-W52-7
+} {Sun Sunday 75 1875 7 01 52 0 00}
+test clock-3.19 {ISO week-based calendar 1876-W01-1} {
+    clock format -2966198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W01-1
+} {Mon Monday 76 1876 1 01 01 1 01}
+test clock-3.20 {ISO week-based calendar 1876-W01-6} {
+    clock format -2965766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W01-6
+} {Sat Saturday 76 1876 6 01 01 6 01}
+test clock-3.21 {ISO week-based calendar 1876-W01-7} {
+    clock format -2965680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W01-7
+} {Sun Sunday 76 1876 7 02 01 0 01}
+test clock-3.22 {ISO week-based calendar 1876-W02-1} {
+    clock format -2965593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W02-1
+} {Mon Monday 76 1876 1 02 02 1 02}
+test clock-3.23 {ISO week-based calendar 1876-W52-1} {
+    clock format -2935353600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W52-1
+} {Mon Monday 76 1876 1 52 52 1 52}
+test clock-3.24 {ISO week-based calendar 1876-W52-6} {
+    clock format -2934921600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W52-6
+} {Sat Saturday 76 1876 6 52 52 6 52}
+test clock-3.25 {ISO week-based calendar 1876-W52-7} {
+    clock format -2934835200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1876-W52-7
+} {Sun Sunday 76 1876 7 53 52 0 52}
+test clock-3.26 {ISO week-based calendar 1877-W01-1} {
+    clock format -2934748800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W01-1
+} {Mon Monday 77 1877 1 00 01 1 01}
+test clock-3.27 {ISO week-based calendar 1877-W01-6} {
+    clock format -2934316800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W01-6
+} {Sat Saturday 77 1877 6 00 01 6 01}
+test clock-3.28 {ISO week-based calendar 1877-W01-7} {
+    clock format -2934230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W01-7
+} {Sun Sunday 77 1877 7 01 01 0 01}
+test clock-3.29 {ISO week-based calendar 1877-W02-1} {
+    clock format -2934144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1877-W02-1
+} {Mon Monday 77 1877 1 01 02 1 02}
+test clock-3.30 {ISO week-based calendar 1879-W52-1} {
+    clock format -2841004800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1879-W52-1
+} {Mon Monday 79 1879 1 51 52 1 51}
+test clock-3.31 {ISO week-based calendar 1879-W52-6} {
+    clock format -2840572800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1879-W52-6
+} {Sat Saturday 79 1879 6 51 52 6 51}
+test clock-3.32 {ISO week-based calendar 1879-W52-7} {
+    clock format -2840486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1879-W52-7
+} {Sun Sunday 79 1879 7 52 52 0 51}
+test clock-3.33 {ISO week-based calendar 1880-W01-1} {
+    clock format -2840400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-1
+} {Mon Monday 80 1880 1 52 01 1 52}
+test clock-3.34 {ISO week-based calendar 1880-W01-4} {
+    clock format -2840140800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-4
+} {Thu Thursday 80 1880 4 00 01 4 00}
+test clock-3.35 {ISO week-based calendar 1880-W01-6} {
+    clock format -2839968000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-6
+} {Sat Saturday 80 1880 6 00 01 6 00}
+test clock-3.36 {ISO week-based calendar 1880-W01-7} {
+    clock format -2839881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W01-7
+} {Sun Sunday 80 1880 7 01 01 0 00}
+test clock-3.37 {ISO week-based calendar 1880-W02-1} {
+    clock format -2839795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W02-1
+} {Mon Monday 80 1880 1 01 02 1 01}
+test clock-3.38 {ISO week-based calendar 1880-W53-1} {
+    clock format -2808950400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W53-1
+} {Mon Monday 80 1880 1 52 53 1 52}
+test clock-3.39 {ISO week-based calendar 1880-W53-6} {
+    clock format -2808518400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W53-6
+} {Sat Saturday 80 1880 6 00 53 6 00}
+test clock-3.40 {ISO week-based calendar 1880-W53-7} {
+    clock format -2808432000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1880-W53-7
+} {Sun Sunday 80 1880 7 01 53 0 00}
+test clock-3.41 {ISO week-based calendar 1881-W01-1} {
+    clock format -2808345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W01-1
+} {Mon Monday 81 1881 1 01 01 1 01}
+test clock-3.42 {ISO week-based calendar 1881-W01-6} {
+    clock format -2807913600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W01-6
+} {Sat Saturday 81 1881 6 01 01 6 01}
+test clock-3.43 {ISO week-based calendar 1881-W01-7} {
+    clock format -2807827200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W01-7
+} {Sun Sunday 81 1881 7 02 01 0 01}
+test clock-3.44 {ISO week-based calendar 1881-W02-1} {
+    clock format -2807740800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1881-W02-1
+} {Mon Monday 81 1881 1 02 02 1 02}
+test clock-3.45 {ISO week-based calendar 1883-W52-1} {
+    clock format -2714601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1883-W52-1
+} {Mon Monday 83 1883 1 51 52 1 52}
+test clock-3.46 {ISO week-based calendar 1883-W52-6} {
+    clock format -2714169600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1883-W52-6
+} {Sat Saturday 83 1883 6 51 52 6 52}
+test clock-3.47 {ISO week-based calendar 1883-W52-7} {
+    clock format -2714083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1883-W52-7
+} {Sun Sunday 83 1883 7 52 52 0 52}
+test clock-3.48 {ISO week-based calendar 1884-W01-1} {
+    clock format -2713996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-1
+} {Mon Monday 84 1884 1 52 01 1 53}
+test clock-3.49 {ISO week-based calendar 1884-W01-2} {
+    clock format -2713910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-2
+} {Tue Tuesday 84 1884 2 00 01 2 00}
+test clock-3.50 {ISO week-based calendar 1884-W01-6} {
+    clock format -2713564800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-6
+} {Sat Saturday 84 1884 6 00 01 6 00}
+test clock-3.51 {ISO week-based calendar 1884-W01-7} {
+    clock format -2713478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W01-7
+} {Sun Sunday 84 1884 7 01 01 0 00}
+test clock-3.52 {ISO week-based calendar 1884-W02-1} {
+    clock format -2713392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W02-1
+} {Mon Monday 84 1884 1 01 02 1 01}
+test clock-3.53 {ISO week-based calendar 1884-W52-1} {
+    clock format -2683152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W52-1
+} {Mon Monday 84 1884 1 51 52 1 51}
+test clock-3.54 {ISO week-based calendar 1884-W52-6} {
+    clock format -2682720000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W52-6
+} {Sat Saturday 84 1884 6 51 52 6 51}
+test clock-3.55 {ISO week-based calendar 1884-W52-7} {
+    clock format -2682633600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1884-W52-7
+} {Sun Sunday 84 1884 7 52 52 0 51}
+test clock-3.56 {ISO week-based calendar 1885-W01-1} {
+    clock format -2682547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-1
+} {Mon Monday 85 1885 1 52 01 1 52}
+test clock-3.57 {ISO week-based calendar 1885-W01-4} {
+    clock format -2682288000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-4
+} {Thu Thursday 85 1885 4 00 01 4 00}
+test clock-3.58 {ISO week-based calendar 1885-W01-6} {
+    clock format -2682115200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-6
+} {Sat Saturday 85 1885 6 00 01 6 00}
+test clock-3.59 {ISO week-based calendar 1885-W01-7} {
+    clock format -2682028800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W01-7
+} {Sun Sunday 85 1885 7 01 01 0 00}
+test clock-3.60 {ISO week-based calendar 1885-W02-1} {
+    clock format -2681942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1885-W02-1
+} {Mon Monday 85 1885 1 01 02 1 01}
+test clock-3.61 {ISO week-based calendar 1887-W52-1} {
+    clock format -2588198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1887-W52-1
+} {Mon Monday 87 1887 1 52 52 1 52}
+test clock-3.62 {ISO week-based calendar 1887-W52-6} {
+    clock format -2587766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1887-W52-6
+} {Sat Saturday 87 1887 6 52 52 6 52}
+test clock-3.63 {ISO week-based calendar 1887-W52-7} {
+    clock format -2587680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1887-W52-7
+} {Sun Sunday 87 1887 7 01 52 0 00}
+test clock-3.64 {ISO week-based calendar 1888-W01-1} {
+    clock format -2587593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W01-1
+} {Mon Monday 88 1888 1 01 01 1 01}
+test clock-3.65 {ISO week-based calendar 1888-W01-6} {
+    clock format -2587161600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W01-6
+} {Sat Saturday 88 1888 6 01 01 6 01}
+test clock-3.66 {ISO week-based calendar 1888-W01-7} {
+    clock format -2587075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W01-7
+} {Sun Sunday 88 1888 7 02 01 0 01}
+test clock-3.67 {ISO week-based calendar 1888-W02-1} {
+    clock format -2586988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W02-1
+} {Mon Monday 88 1888 1 02 02 1 02}
+test clock-3.68 {ISO week-based calendar 1888-W52-1} {
+    clock format -2556748800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W52-1
+} {Mon Monday 88 1888 1 52 52 1 52}
+test clock-3.69 {ISO week-based calendar 1888-W52-6} {
+    clock format -2556316800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W52-6
+} {Sat Saturday 88 1888 6 52 52 6 52}
+test clock-3.70 {ISO week-based calendar 1888-W52-7} {
+    clock format -2556230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1888-W52-7
+} {Sun Sunday 88 1888 7 53 52 0 52}
+test clock-3.71 {ISO week-based calendar 1889-W01-1} {
+    clock format -2556144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-1
+} {Mon Monday 89 1889 1 53 01 1 53}
+test clock-3.72 {ISO week-based calendar 1889-W01-2} {
+    clock format -2556057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-2
+} {Tue Tuesday 89 1889 2 00 01 2 00}
+test clock-3.73 {ISO week-based calendar 1889-W01-6} {
+    clock format -2555712000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-6
+} {Sat Saturday 89 1889 6 00 01 6 00}
+test clock-3.74 {ISO week-based calendar 1889-W01-7} {
+    clock format -2555625600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W01-7
+} {Sun Sunday 89 1889 7 01 01 0 00}
+test clock-3.75 {ISO week-based calendar 1889-W02-1} {
+    clock format -2555539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W02-1
+} {Mon Monday 89 1889 1 01 02 1 01}
+test clock-3.76 {ISO week-based calendar 1889-W52-1} {
+    clock format -2525299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W52-1
+} {Mon Monday 89 1889 1 51 52 1 51}
+test clock-3.77 {ISO week-based calendar 1889-W52-6} {
+    clock format -2524867200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W52-6
+} {Sat Saturday 89 1889 6 51 52 6 51}
+test clock-3.78 {ISO week-based calendar 1889-W52-7} {
+    clock format -2524780800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1889-W52-7
+} {Sun Sunday 89 1889 7 52 52 0 51}
+test clock-3.79 {ISO week-based calendar 1890-W01-1} {
+    clock format -2524694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-1
+} {Mon Monday 90 1890 1 52 01 1 52}
+test clock-3.80 {ISO week-based calendar 1890-W01-3} {
+    clock format -2524521600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-3
+} {Wed Wednesday 90 1890 3 00 01 3 00}
+test clock-3.81 {ISO week-based calendar 1890-W01-6} {
+    clock format -2524262400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-6
+} {Sat Saturday 90 1890 6 00 01 6 00}
+test clock-3.82 {ISO week-based calendar 1890-W01-7} {
+    clock format -2524176000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W01-7
+} {Sun Sunday 90 1890 7 01 01 0 00}
+test clock-3.83 {ISO week-based calendar 1890-W02-1} {
+    clock format -2524089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W02-1
+} {Mon Monday 90 1890 1 01 02 1 01}
+test clock-3.84 {ISO week-based calendar 1890-W52-1} {
+    clock format -2493849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W52-1
+} {Mon Monday 90 1890 1 51 52 1 51}
+test clock-3.85 {ISO week-based calendar 1890-W52-6} {
+    clock format -2493417600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W52-6
+} {Sat Saturday 90 1890 6 51 52 6 51}
+test clock-3.86 {ISO week-based calendar 1890-W52-7} {
+    clock format -2493331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1890-W52-7
+} {Sun Sunday 90 1890 7 52 52 0 51}
+test clock-3.87 {ISO week-based calendar 1891-W01-1} {
+    clock format -2493244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-1
+} {Mon Monday 91 1891 1 52 01 1 52}
+test clock-3.88 {ISO week-based calendar 1891-W01-4} {
+    clock format -2492985600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-4
+} {Thu Thursday 91 1891 4 00 01 4 00}
+test clock-3.89 {ISO week-based calendar 1891-W01-6} {
+    clock format -2492812800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-6
+} {Sat Saturday 91 1891 6 00 01 6 00}
+test clock-3.90 {ISO week-based calendar 1891-W01-7} {
+    clock format -2492726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W01-7
+} {Sun Sunday 91 1891 7 01 01 0 00}
+test clock-3.91 {ISO week-based calendar 1891-W02-1} {
+    clock format -2492640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W02-1
+} {Mon Monday 91 1891 1 01 02 1 01}
+test clock-3.92 {ISO week-based calendar 1891-W53-1} {
+    clock format -2461795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-1
+} {Mon Monday 91 1891 1 52 53 1 52}
+test clock-3.93 {ISO week-based calendar 1891-W53-5} {
+    clock format -2461449600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-5
+} {Fri Friday 91 1891 5 00 53 5 00}
+test clock-3.94 {ISO week-based calendar 1891-W53-6} {
+    clock format -2461363200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-6
+} {Sat Saturday 91 1891 6 00 53 6 00}
+test clock-3.95 {ISO week-based calendar 1891-W53-7} {
+    clock format -2461276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1891-W53-7
+} {Sun Sunday 91 1891 7 01 53 0 00}
+test clock-3.96 {ISO week-based calendar 1892-W01-1} {
+    clock format -2461190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W01-1
+} {Mon Monday 92 1892 1 01 01 1 01}
+test clock-3.97 {ISO week-based calendar 1892-W01-6} {
+    clock format -2460758400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W01-6
+} {Sat Saturday 92 1892 6 01 01 6 01}
+test clock-3.98 {ISO week-based calendar 1892-W01-7} {
+    clock format -2460672000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W01-7
+} {Sun Sunday 92 1892 7 02 01 0 01}
+test clock-3.99 {ISO week-based calendar 1892-W02-1} {
+    clock format -2460585600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W02-1
+} {Mon Monday 92 1892 1 02 02 1 02}
+test clock-3.100 {ISO week-based calendar 1892-W52-1} {
+    clock format -2430345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W52-1
+} {Mon Monday 92 1892 1 52 52 1 52}
+test clock-3.101 {ISO week-based calendar 1892-W52-6} {
+    clock format -2429913600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W52-6
+} {Sat Saturday 92 1892 6 52 52 6 52}
+test clock-3.102 {ISO week-based calendar 1892-W52-7} {
+    clock format -2429827200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1892-W52-7
+} {Sun Sunday 92 1892 7 01 52 0 00}
+test clock-3.103 {ISO week-based calendar 1893-W01-1} {
+    clock format -2429740800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W01-1
+} {Mon Monday 93 1893 1 01 01 1 01}
+test clock-3.104 {ISO week-based calendar 1893-W01-6} {
+    clock format -2429308800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W01-6
+} {Sat Saturday 93 1893 6 01 01 6 01}
+test clock-3.105 {ISO week-based calendar 1893-W01-7} {
+    clock format -2429222400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W01-7
+} {Sun Sunday 93 1893 7 02 01 0 01}
+test clock-3.106 {ISO week-based calendar 1893-W02-1} {
+    clock format -2429136000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W02-1
+} {Mon Monday 93 1893 1 02 02 1 02}
+test clock-3.107 {ISO week-based calendar 1893-W52-1} {
+    clock format -2398896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W52-1
+} {Mon Monday 93 1893 1 52 52 1 52}
+test clock-3.108 {ISO week-based calendar 1893-W52-6} {
+    clock format -2398464000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W52-6
+} {Sat Saturday 93 1893 6 52 52 6 52}
+test clock-3.109 {ISO week-based calendar 1893-W52-7} {
+    clock format -2398377600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1893-W52-7
+} {Sun Sunday 93 1893 7 53 52 0 52}
+test clock-3.110 {ISO week-based calendar 1894-W01-1} {
+    clock format -2398291200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W01-1
+} {Mon Monday 94 1894 1 00 01 1 01}
+test clock-3.111 {ISO week-based calendar 1894-W01-6} {
+    clock format -2397859200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W01-6
+} {Sat Saturday 94 1894 6 00 01 6 01}
+test clock-3.112 {ISO week-based calendar 1894-W01-7} {
+    clock format -2397772800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W01-7
+} {Sun Sunday 94 1894 7 01 01 0 01}
+test clock-3.113 {ISO week-based calendar 1894-W02-1} {
+    clock format -2397686400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W02-1
+} {Mon Monday 94 1894 1 01 02 1 02}
+test clock-3.114 {ISO week-based calendar 1894-W52-1} {
+    clock format -2367446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W52-1
+} {Mon Monday 94 1894 1 51 52 1 52}
+test clock-3.115 {ISO week-based calendar 1894-W52-6} {
+    clock format -2367014400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W52-6
+} {Sat Saturday 94 1894 6 51 52 6 52}
+test clock-3.116 {ISO week-based calendar 1894-W52-7} {
+    clock format -2366928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1894-W52-7
+} {Sun Sunday 94 1894 7 52 52 0 52}
+test clock-3.117 {ISO week-based calendar 1895-W01-1} {
+    clock format -2366841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-1
+} {Mon Monday 95 1895 1 52 01 1 53}
+test clock-3.118 {ISO week-based calendar 1895-W01-2} {
+    clock format -2366755200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-2
+} {Tue Tuesday 95 1895 2 00 01 2 00}
+test clock-3.119 {ISO week-based calendar 1895-W01-6} {
+    clock format -2366409600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-6
+} {Sat Saturday 95 1895 6 00 01 6 00}
+test clock-3.120 {ISO week-based calendar 1895-W01-7} {
+    clock format -2366323200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W01-7
+} {Sun Sunday 95 1895 7 01 01 0 00}
+test clock-3.121 {ISO week-based calendar 1895-W02-1} {
+    clock format -2366236800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W02-1
+} {Mon Monday 95 1895 1 01 02 1 01}
+test clock-3.122 {ISO week-based calendar 1895-W52-1} {
+    clock format -2335996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W52-1
+} {Mon Monday 95 1895 1 51 52 1 51}
+test clock-3.123 {ISO week-based calendar 1895-W52-6} {
+    clock format -2335564800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W52-6
+} {Sat Saturday 95 1895 6 51 52 6 51}
+test clock-3.124 {ISO week-based calendar 1895-W52-7} {
+    clock format -2335478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1895-W52-7
+} {Sun Sunday 95 1895 7 52 52 0 51}
+test clock-3.125 {ISO week-based calendar 1896-W01-1} {
+    clock format -2335392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-1
+} {Mon Monday 96 1896 1 52 01 1 52}
+test clock-3.126 {ISO week-based calendar 1896-W01-3} {
+    clock format -2335219200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-3
+} {Wed Wednesday 96 1896 3 00 01 3 00}
+test clock-3.127 {ISO week-based calendar 1896-W01-6} {
+    clock format -2334960000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-6
+} {Sat Saturday 96 1896 6 00 01 6 00}
+test clock-3.128 {ISO week-based calendar 1896-W01-7} {
+    clock format -2334873600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W01-7
+} {Sun Sunday 96 1896 7 01 01 0 00}
+test clock-3.129 {ISO week-based calendar 1896-W02-1} {
+    clock format -2334787200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W02-1
+} {Mon Monday 96 1896 1 01 02 1 01}
+test clock-3.130 {ISO week-based calendar 1896-W53-1} {
+    clock format -2303942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-1
+} {Mon Monday 96 1896 1 52 53 1 52}
+test clock-3.131 {ISO week-based calendar 1896-W53-5} {
+    clock format -2303596800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-5
+} {Fri Friday 96 1896 5 00 53 5 00}
+test clock-3.132 {ISO week-based calendar 1896-W53-6} {
+    clock format -2303510400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-6
+} {Sat Saturday 96 1896 6 00 53 6 00}
+test clock-3.133 {ISO week-based calendar 1896-W53-7} {
+    clock format -2303424000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1896-W53-7
+} {Sun Sunday 96 1896 7 01 53 0 00}
+test clock-3.134 {ISO week-based calendar 1897-W01-1} {
+    clock format -2303337600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W01-1
+} {Mon Monday 97 1897 1 01 01 1 01}
+test clock-3.135 {ISO week-based calendar 1897-W01-6} {
+    clock format -2302905600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W01-6
+} {Sat Saturday 97 1897 6 01 01 6 01}
+test clock-3.136 {ISO week-based calendar 1897-W01-7} {
+    clock format -2302819200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W01-7
+} {Sun Sunday 97 1897 7 02 01 0 01}
+test clock-3.137 {ISO week-based calendar 1897-W02-1} {
+    clock format -2302732800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W02-1
+} {Mon Monday 97 1897 1 02 02 1 02}
+test clock-3.138 {ISO week-based calendar 1897-W52-1} {
+    clock format -2272492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W52-1
+} {Mon Monday 97 1897 1 52 52 1 52}
+test clock-3.139 {ISO week-based calendar 1897-W52-6} {
+    clock format -2272060800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W52-6
+} {Sat Saturday 97 1897 6 00 52 6 00}
+test clock-3.140 {ISO week-based calendar 1897-W52-7} {
+    clock format -2271974400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1897-W52-7
+} {Sun Sunday 97 1897 7 01 52 0 00}
+test clock-3.141 {ISO week-based calendar 1898-W01-1} {
+    clock format -2271888000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W01-1
+} {Mon Monday 98 1898 1 01 01 1 01}
+test clock-3.142 {ISO week-based calendar 1898-W01-6} {
+    clock format -2271456000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W01-6
+} {Sat Saturday 98 1898 6 01 01 6 01}
+test clock-3.143 {ISO week-based calendar 1898-W01-7} {
+    clock format -2271369600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W01-7
+} {Sun Sunday 98 1898 7 02 01 0 01}
+test clock-3.144 {ISO week-based calendar 1898-W02-1} {
+    clock format -2271283200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W02-1
+} {Mon Monday 98 1898 1 02 02 1 02}
+test clock-3.145 {ISO week-based calendar 1898-W52-1} {
+    clock format -2241043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W52-1
+} {Mon Monday 98 1898 1 52 52 1 52}
+test clock-3.146 {ISO week-based calendar 1898-W52-6} {
+    clock format -2240611200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W52-6
+} {Sat Saturday 98 1898 6 52 52 6 52}
+test clock-3.147 {ISO week-based calendar 1898-W52-7} {
+    clock format -2240524800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1898-W52-7
+} {Sun Sunday 98 1898 7 01 52 0 00}
+test clock-3.148 {ISO week-based calendar 1899-W01-1} {
+    clock format -2240438400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W01-1
+} {Mon Monday 99 1899 1 01 01 1 01}
+test clock-3.149 {ISO week-based calendar 1899-W01-6} {
+    clock format -2240006400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W01-6
+} {Sat Saturday 99 1899 6 01 01 6 01}
+test clock-3.150 {ISO week-based calendar 1899-W01-7} {
+    clock format -2239920000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W01-7
+} {Sun Sunday 99 1899 7 02 01 0 01}
+test clock-3.151 {ISO week-based calendar 1899-W02-1} {
+    clock format -2239833600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W02-1
+} {Mon Monday 99 1899 1 02 02 1 02}
+test clock-3.152 {ISO week-based calendar 1899-W52-1} {
+    clock format -2209593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W52-1
+} {Mon Monday 99 1899 1 52 52 1 52}
+test clock-3.153 {ISO week-based calendar 1899-W52-6} {
+    clock format -2209161600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W52-6
+} {Sat Saturday 99 1899 6 52 52 6 52}
+test clock-3.154 {ISO week-based calendar 1899-W52-7} {
+    clock format -2209075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1899-W52-7
+} {Sun Sunday 99 1899 7 53 52 0 52}
+test clock-3.155 {ISO week-based calendar 1900-W01-1} {
+    clock format -2208988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W01-1
+} {Mon Monday 00 1900 1 00 01 1 01}
+test clock-3.156 {ISO week-based calendar 1900-W01-6} {
+    clock format -2208556800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W01-6
+} {Sat Saturday 00 1900 6 00 01 6 01}
+test clock-3.157 {ISO week-based calendar 1900-W01-7} {
+    clock format -2208470400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W01-7
+} {Sun Sunday 00 1900 7 01 01 0 01}
+test clock-3.158 {ISO week-based calendar 1900-W02-1} {
+    clock format -2208384000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1900-W02-1
+} {Mon Monday 00 1900 1 01 02 1 02}
+test clock-3.159 {ISO week-based calendar 1943-W52-1} {
+    clock format -820972800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1943-W52-1
+} {Mon Monday 43 1943 1 52 52 1 52}
+test clock-3.160 {ISO week-based calendar 1943-W52-6} {
+    clock format -820540800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1943-W52-6
+} {Sat Saturday 43 1943 6 00 52 6 00}
+test clock-3.161 {ISO week-based calendar 1943-W52-7} {
+    clock format -820454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1943-W52-7
+} {Sun Sunday 43 1943 7 01 52 0 00}
+test clock-3.162 {ISO week-based calendar 1944-W01-1} {
+    clock format -820368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W01-1
+} {Mon Monday 44 1944 1 01 01 1 01}
+test clock-3.163 {ISO week-based calendar 1944-W01-6} {
+    clock format -819936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W01-6
+} {Sat Saturday 44 1944 6 01 01 6 01}
+test clock-3.164 {ISO week-based calendar 1944-W01-7} {
+    clock format -819849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W01-7
+} {Sun Sunday 44 1944 7 02 01 0 01}
+test clock-3.165 {ISO week-based calendar 1944-W02-1} {
+    clock format -819763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W02-1
+} {Mon Monday 44 1944 1 02 02 1 02}
+test clock-3.166 {ISO week-based calendar 1944-W52-1} {
+    clock format -789523200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W52-1
+} {Mon Monday 44 1944 1 52 52 1 52}
+test clock-3.167 {ISO week-based calendar 1944-W52-6} {
+    clock format -789091200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W52-6
+} {Sat Saturday 44 1944 6 52 52 6 52}
+test clock-3.168 {ISO week-based calendar 1944-W52-7} {
+    clock format -789004800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1944-W52-7
+} {Sun Sunday 44 1944 7 53 52 0 52}
+test clock-3.169 {ISO week-based calendar 1945-W01-1} {
+    clock format -788918400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W01-1
+} {Mon Monday 45 1945 1 00 01 1 01}
+test clock-3.170 {ISO week-based calendar 1945-W01-6} {
+    clock format -788486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W01-6
+} {Sat Saturday 45 1945 6 00 01 6 01}
+test clock-3.171 {ISO week-based calendar 1945-W01-7} {
+    clock format -788400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W01-7
+} {Sun Sunday 45 1945 7 01 01 0 01}
+test clock-3.172 {ISO week-based calendar 1945-W02-1} {
+    clock format -788313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1945-W02-1
+} {Mon Monday 45 1945 1 01 02 1 02}
+test clock-3.173 {ISO week-based calendar 1947-W52-1} {
+    clock format -695174400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1947-W52-1
+} {Mon Monday 47 1947 1 51 52 1 51}
+test clock-3.174 {ISO week-based calendar 1947-W52-6} {
+    clock format -694742400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1947-W52-6
+} {Sat Saturday 47 1947 6 51 52 6 51}
+test clock-3.175 {ISO week-based calendar 1947-W52-7} {
+    clock format -694656000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1947-W52-7
+} {Sun Sunday 47 1947 7 52 52 0 51}
+test clock-3.176 {ISO week-based calendar 1948-W01-1} {
+    clock format -694569600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-1
+} {Mon Monday 48 1948 1 52 01 1 52}
+test clock-3.177 {ISO week-based calendar 1948-W01-4} {
+    clock format -694310400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-4
+} {Thu Thursday 48 1948 4 00 01 4 00}
+test clock-3.178 {ISO week-based calendar 1948-W01-6} {
+    clock format -694137600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-6
+} {Sat Saturday 48 1948 6 00 01 6 00}
+test clock-3.179 {ISO week-based calendar 1948-W01-7} {
+    clock format -694051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W01-7
+} {Sun Sunday 48 1948 7 01 01 0 00}
+test clock-3.180 {ISO week-based calendar 1948-W02-1} {
+    clock format -693964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W02-1
+} {Mon Monday 48 1948 1 01 02 1 01}
+test clock-3.181 {ISO week-based calendar 1948-W53-1} {
+    clock format -663120000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W53-1
+} {Mon Monday 48 1948 1 52 53 1 52}
+test clock-3.182 {ISO week-based calendar 1948-W53-6} {
+    clock format -662688000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W53-6
+} {Sat Saturday 48 1948 6 00 53 6 00}
+test clock-3.183 {ISO week-based calendar 1948-W53-7} {
+    clock format -662601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1948-W53-7
+} {Sun Sunday 48 1948 7 01 53 0 00}
+test clock-3.184 {ISO week-based calendar 1949-W01-1} {
+    clock format -662515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W01-1
+} {Mon Monday 49 1949 1 01 01 1 01}
+test clock-3.185 {ISO week-based calendar 1949-W01-6} {
+    clock format -662083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W01-6
+} {Sat Saturday 49 1949 6 01 01 6 01}
+test clock-3.186 {ISO week-based calendar 1949-W01-7} {
+    clock format -661996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W01-7
+} {Sun Sunday 49 1949 7 02 01 0 01}
+test clock-3.187 {ISO week-based calendar 1949-W02-1} {
+    clock format -661910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1949-W02-1
+} {Mon Monday 49 1949 1 02 02 1 02}
+test clock-3.188 {ISO week-based calendar 1951-W52-1} {
+    clock format -568771200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1951-W52-1
+} {Mon Monday 51 1951 1 51 52 1 52}
+test clock-3.189 {ISO week-based calendar 1951-W52-6} {
+    clock format -568339200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1951-W52-6
+} {Sat Saturday 51 1951 6 51 52 6 52}
+test clock-3.190 {ISO week-based calendar 1951-W52-7} {
+    clock format -568252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1951-W52-7
+} {Sun Sunday 51 1951 7 52 52 0 52}
+test clock-3.191 {ISO week-based calendar 1952-W01-1} {
+    clock format -568166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-1
+} {Mon Monday 52 1952 1 52 01 1 53}
+test clock-3.192 {ISO week-based calendar 1952-W01-2} {
+    clock format -568080000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-2
+} {Tue Tuesday 52 1952 2 00 01 2 00}
+test clock-3.193 {ISO week-based calendar 1952-W01-6} {
+    clock format -567734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-6
+} {Sat Saturday 52 1952 6 00 01 6 00}
+test clock-3.194 {ISO week-based calendar 1952-W01-7} {
+    clock format -567648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W01-7
+} {Sun Sunday 52 1952 7 01 01 0 00}
+test clock-3.195 {ISO week-based calendar 1952-W02-1} {
+    clock format -567561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W02-1
+} {Mon Monday 52 1952 1 01 02 1 01}
+test clock-3.196 {ISO week-based calendar 1952-W52-1} {
+    clock format -537321600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W52-1
+} {Mon Monday 52 1952 1 51 52 1 51}
+test clock-3.197 {ISO week-based calendar 1952-W52-6} {
+    clock format -536889600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W52-6
+} {Sat Saturday 52 1952 6 51 52 6 51}
+test clock-3.198 {ISO week-based calendar 1952-W52-7} {
+    clock format -536803200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1952-W52-7
+} {Sun Sunday 52 1952 7 52 52 0 51}
+test clock-3.199 {ISO week-based calendar 1953-W01-1} {
+    clock format -536716800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-1
+} {Mon Monday 53 1953 1 52 01 1 52}
+test clock-3.200 {ISO week-based calendar 1953-W01-4} {
+    clock format -536457600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-4
+} {Thu Thursday 53 1953 4 00 01 4 00}
+test clock-3.201 {ISO week-based calendar 1953-W01-6} {
+    clock format -536284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-6
+} {Sat Saturday 53 1953 6 00 01 6 00}
+test clock-3.202 {ISO week-based calendar 1953-W01-7} {
+    clock format -536198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W01-7
+} {Sun Sunday 53 1953 7 01 01 0 00}
+test clock-3.203 {ISO week-based calendar 1953-W02-1} {
+    clock format -536112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1953-W02-1
+} {Mon Monday 53 1953 1 01 02 1 01}
+test clock-3.204 {ISO week-based calendar 1955-W52-1} {
+    clock format -442368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1955-W52-1
+} {Mon Monday 55 1955 1 52 52 1 52}
+test clock-3.205 {ISO week-based calendar 1955-W52-6} {
+    clock format -441936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1955-W52-6
+} {Sat Saturday 55 1955 6 52 52 6 52}
+test clock-3.206 {ISO week-based calendar 1955-W52-7} {
+    clock format -441849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1955-W52-7
+} {Sun Sunday 55 1955 7 01 52 0 00}
+test clock-3.207 {ISO week-based calendar 1956-W01-1} {
+    clock format -441763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W01-1
+} {Mon Monday 56 1956 1 01 01 1 01}
+test clock-3.208 {ISO week-based calendar 1956-W01-6} {
+    clock format -441331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W01-6
+} {Sat Saturday 56 1956 6 01 01 6 01}
+test clock-3.209 {ISO week-based calendar 1956-W01-7} {
+    clock format -441244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W01-7
+} {Sun Sunday 56 1956 7 02 01 0 01}
+test clock-3.210 {ISO week-based calendar 1956-W02-1} {
+    clock format -441158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W02-1
+} {Mon Monday 56 1956 1 02 02 1 02}
+test clock-3.211 {ISO week-based calendar 1956-W52-1} {
+    clock format -410918400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W52-1
+} {Mon Monday 56 1956 1 52 52 1 52}
+test clock-3.212 {ISO week-based calendar 1956-W52-6} {
+    clock format -410486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W52-6
+} {Sat Saturday 56 1956 6 52 52 6 52}
+test clock-3.213 {ISO week-based calendar 1956-W52-7} {
+    clock format -410400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1956-W52-7
+} {Sun Sunday 56 1956 7 53 52 0 52}
+test clock-3.214 {ISO week-based calendar 1957-W01-1} {
+    clock format -410313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-1
+} {Mon Monday 57 1957 1 53 01 1 53}
+test clock-3.215 {ISO week-based calendar 1957-W01-2} {
+    clock format -410227200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-2
+} {Tue Tuesday 57 1957 2 00 01 2 00}
+test clock-3.216 {ISO week-based calendar 1957-W01-6} {
+    clock format -409881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-6
+} {Sat Saturday 57 1957 6 00 01 6 00}
+test clock-3.217 {ISO week-based calendar 1957-W01-7} {
+    clock format -409795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W01-7
+} {Sun Sunday 57 1957 7 01 01 0 00}
+test clock-3.218 {ISO week-based calendar 1957-W02-1} {
+    clock format -409708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1957-W02-1
+} {Mon Monday 57 1957 1 01 02 1 01}
+test clock-3.219 {ISO week-based calendar 1958-W52-1} {
+    clock format -348019200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1958-W52-1
+} {Mon Monday 58 1958 1 51 52 1 51}
+test clock-3.220 {ISO week-based calendar 1958-W52-6} {
+    clock format -347587200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1958-W52-6
+} {Sat Saturday 58 1958 6 51 52 6 51}
+test clock-3.221 {ISO week-based calendar 1958-W52-7} {
+    clock format -347500800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1958-W52-7
+} {Sun Sunday 58 1958 7 52 52 0 51}
+test clock-3.222 {ISO week-based calendar 1959-W01-1} {
+    clock format -347414400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-1
+} {Mon Monday 59 1959 1 52 01 1 52}
+test clock-3.223 {ISO week-based calendar 1959-W01-4} {
+    clock format -347155200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-4
+} {Thu Thursday 59 1959 4 00 01 4 00}
+test clock-3.224 {ISO week-based calendar 1959-W01-6} {
+    clock format -346982400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-6
+} {Sat Saturday 59 1959 6 00 01 6 00}
+test clock-3.225 {ISO week-based calendar 1959-W01-7} {
+    clock format -346896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W01-7
+} {Sun Sunday 59 1959 7 01 01 0 00}
+test clock-3.226 {ISO week-based calendar 1959-W02-1} {
+    clock format -346809600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W02-1
+} {Mon Monday 59 1959 1 01 02 1 01}
+test clock-3.227 {ISO week-based calendar 1959-W53-1} {
+    clock format -315964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-1
+} {Mon Monday 59 1959 1 52 53 1 52}
+test clock-3.228 {ISO week-based calendar 1959-W53-5} {
+    clock format -315619200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-5
+} {Fri Friday 59 1959 5 00 53 5 00}
+test clock-3.229 {ISO week-based calendar 1959-W53-6} {
+    clock format -315532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-6
+} {Sat Saturday 59 1959 6 00 53 6 00}
+test clock-3.230 {ISO week-based calendar 1959-W53-7} {
+    clock format -315446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1959-W53-7
+} {Sun Sunday 59 1959 7 01 53 0 00}
+test clock-3.231 {ISO week-based calendar 1960-W01-1} {
+    clock format -315360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W01-1
+} {Mon Monday 60 1960 1 01 01 1 01}
+test clock-3.232 {ISO week-based calendar 1960-W01-6} {
+    clock format -314928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W01-6
+} {Sat Saturday 60 1960 6 01 01 6 01}
+test clock-3.233 {ISO week-based calendar 1960-W01-7} {
+    clock format -314841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W01-7
+} {Sun Sunday 60 1960 7 02 01 0 01}
+test clock-3.234 {ISO week-based calendar 1960-W02-1} {
+    clock format -314755200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W02-1
+} {Mon Monday 60 1960 1 02 02 1 02}
+test clock-3.235 {ISO week-based calendar 1960-W52-1} {
+    clock format -284515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W52-1
+} {Mon Monday 60 1960 1 52 52 1 52}
+test clock-3.236 {ISO week-based calendar 1960-W52-6} {
+    clock format -284083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W52-6
+} {Sat Saturday 60 1960 6 52 52 6 52}
+test clock-3.237 {ISO week-based calendar 1960-W52-7} {
+    clock format -283996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1960-W52-7
+} {Sun Sunday 60 1960 7 01 52 0 00}
+test clock-3.238 {ISO week-based calendar 1961-W01-1} {
+    clock format -283910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W01-1
+} {Mon Monday 61 1961 1 01 01 1 01}
+test clock-3.239 {ISO week-based calendar 1961-W01-6} {
+    clock format -283478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W01-6
+} {Sat Saturday 61 1961 6 01 01 6 01}
+test clock-3.240 {ISO week-based calendar 1961-W01-7} {
+    clock format -283392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W01-7
+} {Sun Sunday 61 1961 7 02 01 0 01}
+test clock-3.241 {ISO week-based calendar 1961-W02-1} {
+    clock format -283305600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W02-1
+} {Mon Monday 61 1961 1 02 02 1 02}
+test clock-3.242 {ISO week-based calendar 1961-W52-1} {
+    clock format -253065600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W52-1
+} {Mon Monday 61 1961 1 52 52 1 52}
+test clock-3.243 {ISO week-based calendar 1961-W52-6} {
+    clock format -252633600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W52-6
+} {Sat Saturday 61 1961 6 52 52 6 52}
+test clock-3.244 {ISO week-based calendar 1961-W52-7} {
+    clock format -252547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1961-W52-7
+} {Sun Sunday 61 1961 7 53 52 0 52}
+test clock-3.245 {ISO week-based calendar 1962-W01-1} {
+    clock format -252460800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W01-1
+} {Mon Monday 62 1962 1 00 01 1 01}
+test clock-3.246 {ISO week-based calendar 1962-W01-6} {
+    clock format -252028800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W01-6
+} {Sat Saturday 62 1962 6 00 01 6 01}
+test clock-3.247 {ISO week-based calendar 1962-W01-7} {
+    clock format -251942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W01-7
+} {Sun Sunday 62 1962 7 01 01 0 01}
+test clock-3.248 {ISO week-based calendar 1962-W02-1} {
+    clock format -251856000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W02-1
+} {Mon Monday 62 1962 1 01 02 1 02}
+test clock-3.249 {ISO week-based calendar 1962-W52-1} {
+    clock format -221616000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W52-1
+} {Mon Monday 62 1962 1 51 52 1 52}
+test clock-3.250 {ISO week-based calendar 1962-W52-6} {
+    clock format -221184000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W52-6
+} {Sat Saturday 62 1962 6 51 52 6 52}
+test clock-3.251 {ISO week-based calendar 1962-W52-7} {
+    clock format -221097600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1962-W52-7
+} {Sun Sunday 62 1962 7 52 52 0 52}
+test clock-3.252 {ISO week-based calendar 1963-W01-1} {
+    clock format -221011200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-1
+} {Mon Monday 63 1963 1 52 01 1 53}
+test clock-3.253 {ISO week-based calendar 1963-W01-2} {
+    clock format -220924800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-2
+} {Tue Tuesday 63 1963 2 00 01 2 00}
+test clock-3.254 {ISO week-based calendar 1963-W01-6} {
+    clock format -220579200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-6
+} {Sat Saturday 63 1963 6 00 01 6 00}
+test clock-3.255 {ISO week-based calendar 1963-W01-7} {
+    clock format -220492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W01-7
+} {Sun Sunday 63 1963 7 01 01 0 00}
+test clock-3.256 {ISO week-based calendar 1963-W02-1} {
+    clock format -220406400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W02-1
+} {Mon Monday 63 1963 1 01 02 1 01}
+test clock-3.257 {ISO week-based calendar 1963-W52-1} {
+    clock format -190166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W52-1
+} {Mon Monday 63 1963 1 51 52 1 51}
+test clock-3.258 {ISO week-based calendar 1963-W52-6} {
+    clock format -189734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W52-6
+} {Sat Saturday 63 1963 6 51 52 6 51}
+test clock-3.259 {ISO week-based calendar 1963-W52-7} {
+    clock format -189648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1963-W52-7
+} {Sun Sunday 63 1963 7 52 52 0 51}
+test clock-3.260 {ISO week-based calendar 1964-W01-1} {
+    clock format -189561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-1
+} {Mon Monday 64 1964 1 52 01 1 52}
+test clock-3.261 {ISO week-based calendar 1964-W01-3} {
+    clock format -189388800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-3
+} {Wed Wednesday 64 1964 3 00 01 3 00}
+test clock-3.262 {ISO week-based calendar 1964-W01-6} {
+    clock format -189129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-6
+} {Sat Saturday 64 1964 6 00 01 6 00}
+test clock-3.263 {ISO week-based calendar 1964-W01-7} {
+    clock format -189043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W01-7
+} {Sun Sunday 64 1964 7 01 01 0 00}
+test clock-3.264 {ISO week-based calendar 1964-W02-1} {
+    clock format -188956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W02-1
+} {Mon Monday 64 1964 1 01 02 1 01}
+test clock-3.265 {ISO week-based calendar 1964-W53-1} {
+    clock format -158112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-1
+} {Mon Monday 64 1964 1 52 53 1 52}
+test clock-3.266 {ISO week-based calendar 1964-W53-5} {
+    clock format -157766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-5
+} {Fri Friday 64 1964 5 00 53 5 00}
+test clock-3.267 {ISO week-based calendar 1964-W53-6} {
+    clock format -157680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-6
+} {Sat Saturday 64 1964 6 00 53 6 00}
+test clock-3.268 {ISO week-based calendar 1964-W53-7} {
+    clock format -157593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1964-W53-7
+} {Sun Sunday 64 1964 7 01 53 0 00}
+test clock-3.269 {ISO week-based calendar 1965-W01-1} {
+    clock format -157507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W01-1
+} {Mon Monday 65 1965 1 01 01 1 01}
+test clock-3.270 {ISO week-based calendar 1965-W01-6} {
+    clock format -157075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W01-6
+} {Sat Saturday 65 1965 6 01 01 6 01}
+test clock-3.271 {ISO week-based calendar 1965-W01-7} {
+    clock format -156988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W01-7
+} {Sun Sunday 65 1965 7 02 01 0 01}
+test clock-3.272 {ISO week-based calendar 1965-W02-1} {
+    clock format -156902400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W02-1
+} {Mon Monday 65 1965 1 02 02 1 02}
+test clock-3.273 {ISO week-based calendar 1965-W52-1} {
+    clock format -126662400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W52-1
+} {Mon Monday 65 1965 1 52 52 1 52}
+test clock-3.274 {ISO week-based calendar 1965-W52-6} {
+    clock format -126230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W52-6
+} {Sat Saturday 65 1965 6 00 52 6 00}
+test clock-3.275 {ISO week-based calendar 1965-W52-7} {
+    clock format -126144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1965-W52-7
+} {Sun Sunday 65 1965 7 01 52 0 00}
+test clock-3.276 {ISO week-based calendar 1966-W01-1} {
+    clock format -126057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W01-1
+} {Mon Monday 66 1966 1 01 01 1 01}
+test clock-3.277 {ISO week-based calendar 1966-W01-6} {
+    clock format -125625600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W01-6
+} {Sat Saturday 66 1966 6 01 01 6 01}
+test clock-3.278 {ISO week-based calendar 1966-W01-7} {
+    clock format -125539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W01-7
+} {Sun Sunday 66 1966 7 02 01 0 01}
+test clock-3.279 {ISO week-based calendar 1966-W02-1} {
+    clock format -125452800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W02-1
+} {Mon Monday 66 1966 1 02 02 1 02}
+test clock-3.280 {ISO week-based calendar 1966-W52-1} {
+    clock format -95212800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W52-1
+} {Mon Monday 66 1966 1 52 52 1 52}
+test clock-3.281 {ISO week-based calendar 1966-W52-6} {
+    clock format -94780800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W52-6
+} {Sat Saturday 66 1966 6 52 52 6 52}
+test clock-3.282 {ISO week-based calendar 1966-W52-7} {
+    clock format -94694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1966-W52-7
+} {Sun Sunday 66 1966 7 01 52 0 00}
+test clock-3.283 {ISO week-based calendar 1967-W01-1} {
+    clock format -94608000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W01-1
+} {Mon Monday 67 1967 1 01 01 1 01}
+test clock-3.284 {ISO week-based calendar 1967-W01-6} {
+    clock format -94176000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W01-6
+} {Sat Saturday 67 1967 6 01 01 6 01}
+test clock-3.285 {ISO week-based calendar 1967-W01-7} {
+    clock format -94089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W01-7
+} {Sun Sunday 67 1967 7 02 01 0 01}
+test clock-3.286 {ISO week-based calendar 1967-W02-1} {
+    clock format -94003200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W02-1
+} {Mon Monday 67 1967 1 02 02 1 02}
+test clock-3.287 {ISO week-based calendar 1967-W52-1} {
+    clock format -63763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W52-1
+} {Mon Monday 67 1967 1 52 52 1 52}
+test clock-3.288 {ISO week-based calendar 1967-W52-6} {
+    clock format -63331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W52-6
+} {Sat Saturday 67 1967 6 52 52 6 52}
+test clock-3.289 {ISO week-based calendar 1967-W52-7} {
+    clock format -63244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1967-W52-7
+} {Sun Sunday 67 1967 7 53 52 0 52}
+test clock-3.290 {ISO week-based calendar 1968-W01-1} {
+    clock format -63158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W01-1
+} {Mon Monday 68 1968 1 00 01 1 01}
+test clock-3.291 {ISO week-based calendar 1968-W01-6} {
+    clock format -62726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W01-6
+} {Sat Saturday 68 1968 6 00 01 6 01}
+test clock-3.292 {ISO week-based calendar 1968-W01-7} {
+    clock format -62640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W01-7
+} {Sun Sunday 68 1968 7 01 01 0 01}
+test clock-3.293 {ISO week-based calendar 1968-W02-1} {
+    clock format -62553600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W02-1
+} {Mon Monday 68 1968 1 01 02 1 02}
+test clock-3.294 {ISO week-based calendar 1968-W52-1} {
+    clock format -32313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W52-1
+} {Mon Monday 68 1968 1 51 52 1 52}
+test clock-3.295 {ISO week-based calendar 1968-W52-6} {
+    clock format -31881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W52-6
+} {Sat Saturday 68 1968 6 51 52 6 52}
+test clock-3.296 {ISO week-based calendar 1968-W52-7} {
+    clock format -31795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1968-W52-7
+} {Sun Sunday 68 1968 7 52 52 0 52}
+test clock-3.297 {ISO week-based calendar 1969-W01-1} {
+    clock format -31708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-1
+} {Mon Monday 69 1969 1 52 01 1 53}
+test clock-3.298 {ISO week-based calendar 1969-W01-3} {
+    clock format -31536000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-3
+} {Wed Wednesday 69 1969 3 00 01 3 00}
+test clock-3.299 {ISO week-based calendar 1969-W01-6} {
+    clock format -31276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-6
+} {Sat Saturday 69 1969 6 00 01 6 00}
+test clock-3.300 {ISO week-based calendar 1969-W01-7} {
+    clock format -31190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W01-7
+} {Sun Sunday 69 1969 7 01 01 0 00}
+test clock-3.301 {ISO week-based calendar 1969-W02-1} {
+    clock format -31104000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W02-1
+} {Mon Monday 69 1969 1 01 02 1 01}
+test clock-3.302 {ISO week-based calendar 1969-W52-1} {
+    clock format -864000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W52-1
+} {Mon Monday 69 1969 1 51 52 1 51}
+test clock-3.303 {ISO week-based calendar 1969-W52-6} {
+    clock format -432000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W52-6
+} {Sat Saturday 69 1969 6 51 52 6 51}
+test clock-3.304 {ISO week-based calendar 1969-W52-7} {
+    clock format -345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1969-W52-7
+} {Sun Sunday 69 1969 7 52 52 0 51}
+test clock-3.305 {ISO week-based calendar 1970-W01-1} {
+    clock format -259200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-1
+} {Mon Monday 70 1970 1 52 01 1 52}
+test clock-3.306 {ISO week-based calendar 1970-W01-4} {
+    clock format 0 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-4
+} {Thu Thursday 70 1970 4 00 01 4 00}
+test clock-3.307 {ISO week-based calendar 1970-W01-6} {
+    clock format 172800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-6
+} {Sat Saturday 70 1970 6 00 01 6 00}
+test clock-3.308 {ISO week-based calendar 1970-W01-7} {
+    clock format 259200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W01-7
+} {Sun Sunday 70 1970 7 01 01 0 00}
+test clock-3.309 {ISO week-based calendar 1970-W02-1} {
+    clock format 345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W02-1
+} {Mon Monday 70 1970 1 01 02 1 01}
+test clock-3.310 {ISO week-based calendar 1970-W53-1} {
+    clock format 31190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-1
+} {Mon Monday 70 1970 1 52 53 1 52}
+test clock-3.311 {ISO week-based calendar 1970-W53-5} {
+    clock format 31536000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-5
+} {Fri Friday 70 1970 5 00 53 5 00}
+test clock-3.312 {ISO week-based calendar 1970-W53-6} {
+    clock format 31622400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-6
+} {Sat Saturday 70 1970 6 00 53 6 00}
+test clock-3.313 {ISO week-based calendar 1970-W53-7} {
+    clock format 31708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1970-W53-7
+} {Sun Sunday 70 1970 7 01 53 0 00}
+test clock-3.314 {ISO week-based calendar 1971-W01-1} {
+    clock format 31795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W01-1
+} {Mon Monday 71 1971 1 01 01 1 01}
+test clock-3.315 {ISO week-based calendar 1971-W01-6} {
+    clock format 32227200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W01-6
+} {Sat Saturday 71 1971 6 01 01 6 01}
+test clock-3.316 {ISO week-based calendar 1971-W01-7} {
+    clock format 32313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W01-7
+} {Sun Sunday 71 1971 7 02 01 0 01}
+test clock-3.317 {ISO week-based calendar 1971-W02-1} {
+    clock format 32400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W02-1
+} {Mon Monday 71 1971 1 02 02 1 02}
+test clock-3.318 {ISO week-based calendar 1971-W52-1} {
+    clock format 62640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W52-1
+} {Mon Monday 71 1971 1 52 52 1 52}
+test clock-3.319 {ISO week-based calendar 1971-W52-6} {
+    clock format 63072000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W52-6
+} {Sat Saturday 71 1971 6 00 52 6 00}
+test clock-3.320 {ISO week-based calendar 1971-W52-7} {
+    clock format 63158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1971-W52-7
+} {Sun Sunday 71 1971 7 01 52 0 00}
+test clock-3.321 {ISO week-based calendar 1972-W01-1} {
+    clock format 63244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W01-1
+} {Mon Monday 72 1972 1 01 01 1 01}
+test clock-3.322 {ISO week-based calendar 1972-W01-6} {
+    clock format 63676800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W01-6
+} {Sat Saturday 72 1972 6 01 01 6 01}
+test clock-3.323 {ISO week-based calendar 1972-W01-7} {
+    clock format 63763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W01-7
+} {Sun Sunday 72 1972 7 02 01 0 01}
+test clock-3.324 {ISO week-based calendar 1972-W02-1} {
+    clock format 63849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W02-1
+} {Mon Monday 72 1972 1 02 02 1 02}
+test clock-3.325 {ISO week-based calendar 1972-W52-1} {
+    clock format 94089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W52-1
+} {Mon Monday 72 1972 1 52 52 1 52}
+test clock-3.326 {ISO week-based calendar 1972-W52-6} {
+    clock format 94521600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W52-6
+} {Sat Saturday 72 1972 6 52 52 6 52}
+test clock-3.327 {ISO week-based calendar 1972-W52-7} {
+    clock format 94608000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1972-W52-7
+} {Sun Sunday 72 1972 7 53 52 0 52}
+test clock-3.328 {ISO week-based calendar 1973-W01-1} {
+    clock format 94694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W01-1
+} {Mon Monday 73 1973 1 00 01 1 01}
+test clock-3.329 {ISO week-based calendar 1973-W01-6} {
+    clock format 95126400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W01-6
+} {Sat Saturday 73 1973 6 00 01 6 01}
+test clock-3.330 {ISO week-based calendar 1973-W01-7} {
+    clock format 95212800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W01-7
+} {Sun Sunday 73 1973 7 01 01 0 01}
+test clock-3.331 {ISO week-based calendar 1973-W02-1} {
+    clock format 95299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W02-1
+} {Mon Monday 73 1973 1 01 02 1 02}
+test clock-3.332 {ISO week-based calendar 1973-W52-1} {
+    clock format 125539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W52-1
+} {Mon Monday 73 1973 1 51 52 1 52}
+test clock-3.333 {ISO week-based calendar 1973-W52-6} {
+    clock format 125971200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W52-6
+} {Sat Saturday 73 1973 6 51 52 6 52}
+test clock-3.334 {ISO week-based calendar 1973-W52-7} {
+    clock format 126057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1973-W52-7
+} {Sun Sunday 73 1973 7 52 52 0 52}
+test clock-3.335 {ISO week-based calendar 1974-W01-1} {
+    clock format 126144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-1
+} {Mon Monday 74 1974 1 52 01 1 53}
+test clock-3.336 {ISO week-based calendar 1974-W01-2} {
+    clock format 126230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-2
+} {Tue Tuesday 74 1974 2 00 01 2 00}
+test clock-3.337 {ISO week-based calendar 1974-W01-6} {
+    clock format 126576000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-6
+} {Sat Saturday 74 1974 6 00 01 6 00}
+test clock-3.338 {ISO week-based calendar 1974-W01-7} {
+    clock format 126662400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W01-7
+} {Sun Sunday 74 1974 7 01 01 0 00}
+test clock-3.339 {ISO week-based calendar 1974-W02-1} {
+    clock format 126748800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W02-1
+} {Mon Monday 74 1974 1 01 02 1 01}
+test clock-3.340 {ISO week-based calendar 1974-W52-1} {
+    clock format 156988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W52-1
+} {Mon Monday 74 1974 1 51 52 1 51}
+test clock-3.341 {ISO week-based calendar 1974-W52-6} {
+    clock format 157420800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W52-6
+} {Sat Saturday 74 1974 6 51 52 6 51}
+test clock-3.342 {ISO week-based calendar 1974-W52-7} {
+    clock format 157507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1974-W52-7
+} {Sun Sunday 74 1974 7 52 52 0 51}
+test clock-3.343 {ISO week-based calendar 1975-W01-1} {
+    clock format 157593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-1
+} {Mon Monday 75 1975 1 52 01 1 52}
+test clock-3.344 {ISO week-based calendar 1975-W01-3} {
+    clock format 157766400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-3
+} {Wed Wednesday 75 1975 3 00 01 3 00}
+test clock-3.345 {ISO week-based calendar 1975-W01-6} {
+    clock format 158025600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-6
+} {Sat Saturday 75 1975 6 00 01 6 00}
+test clock-3.346 {ISO week-based calendar 1975-W01-7} {
+    clock format 158112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W01-7
+} {Sun Sunday 75 1975 7 01 01 0 00}
+test clock-3.347 {ISO week-based calendar 1975-W02-1} {
+    clock format 158198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W02-1
+} {Mon Monday 75 1975 1 01 02 1 01}
+test clock-3.348 {ISO week-based calendar 1975-W52-1} {
+    clock format 188438400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W52-1
+} {Mon Monday 75 1975 1 51 52 1 51}
+test clock-3.349 {ISO week-based calendar 1975-W52-6} {
+    clock format 188870400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W52-6
+} {Sat Saturday 75 1975 6 51 52 6 51}
+test clock-3.350 {ISO week-based calendar 1975-W52-7} {
+    clock format 188956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1975-W52-7
+} {Sun Sunday 75 1975 7 52 52 0 51}
+test clock-3.351 {ISO week-based calendar 1976-W01-1} {
+    clock format 189043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-1
+} {Mon Monday 76 1976 1 52 01 1 52}
+test clock-3.352 {ISO week-based calendar 1976-W01-4} {
+    clock format 189302400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-4
+} {Thu Thursday 76 1976 4 00 01 4 00}
+test clock-3.353 {ISO week-based calendar 1976-W01-6} {
+    clock format 189475200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-6
+} {Sat Saturday 76 1976 6 00 01 6 00}
+test clock-3.354 {ISO week-based calendar 1976-W01-7} {
+    clock format 189561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W01-7
+} {Sun Sunday 76 1976 7 01 01 0 00}
+test clock-3.355 {ISO week-based calendar 1976-W02-1} {
+    clock format 189648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W02-1
+} {Mon Monday 76 1976 1 01 02 1 01}
+test clock-3.356 {ISO week-based calendar 1976-W53-1} {
+    clock format 220492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W53-1
+} {Mon Monday 76 1976 1 52 53 1 52}
+test clock-3.357 {ISO week-based calendar 1976-W53-6} {
+    clock format 220924800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W53-6
+} {Sat Saturday 76 1976 6 00 53 6 00}
+test clock-3.358 {ISO week-based calendar 1976-W53-7} {
+    clock format 221011200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1976-W53-7
+} {Sun Sunday 76 1976 7 01 53 0 00}
+test clock-3.359 {ISO week-based calendar 1977-W01-1} {
+    clock format 221097600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W01-1
+} {Mon Monday 77 1977 1 01 01 1 01}
+test clock-3.360 {ISO week-based calendar 1977-W01-6} {
+    clock format 221529600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W01-6
+} {Sat Saturday 77 1977 6 01 01 6 01}
+test clock-3.361 {ISO week-based calendar 1977-W01-7} {
+    clock format 221616000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W01-7
+} {Sun Sunday 77 1977 7 02 01 0 01}
+test clock-3.362 {ISO week-based calendar 1977-W02-1} {
+    clock format 221702400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W02-1
+} {Mon Monday 77 1977 1 02 02 1 02}
+test clock-3.363 {ISO week-based calendar 1977-W52-1} {
+    clock format 251942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W52-1
+} {Mon Monday 77 1977 1 52 52 1 52}
+test clock-3.364 {ISO week-based calendar 1977-W52-6} {
+    clock format 252374400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W52-6
+} {Sat Saturday 77 1977 6 52 52 6 52}
+test clock-3.365 {ISO week-based calendar 1977-W52-7} {
+    clock format 252460800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1977-W52-7
+} {Sun Sunday 77 1977 7 01 52 0 00}
+test clock-3.366 {ISO week-based calendar 1978-W01-1} {
+    clock format 252547200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W01-1
+} {Mon Monday 78 1978 1 01 01 1 01}
+test clock-3.367 {ISO week-based calendar 1978-W01-6} {
+    clock format 252979200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W01-6
+} {Sat Saturday 78 1978 6 01 01 6 01}
+test clock-3.368 {ISO week-based calendar 1978-W01-7} {
+    clock format 253065600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W01-7
+} {Sun Sunday 78 1978 7 02 01 0 01}
+test clock-3.369 {ISO week-based calendar 1978-W02-1} {
+    clock format 253152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W02-1
+} {Mon Monday 78 1978 1 02 02 1 02}
+test clock-3.370 {ISO week-based calendar 1978-W52-1} {
+    clock format 283392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W52-1
+} {Mon Monday 78 1978 1 52 52 1 52}
+test clock-3.371 {ISO week-based calendar 1978-W52-6} {
+    clock format 283824000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W52-6
+} {Sat Saturday 78 1978 6 52 52 6 52}
+test clock-3.372 {ISO week-based calendar 1978-W52-7} {
+    clock format 283910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1978-W52-7
+} {Sun Sunday 78 1978 7 53 52 0 52}
+test clock-3.373 {ISO week-based calendar 1979-W01-1} {
+    clock format 283996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W01-1
+} {Mon Monday 79 1979 1 00 01 1 01}
+test clock-3.374 {ISO week-based calendar 1979-W01-6} {
+    clock format 284428800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W01-6
+} {Sat Saturday 79 1979 6 00 01 6 01}
+test clock-3.375 {ISO week-based calendar 1979-W01-7} {
+    clock format 284515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W01-7
+} {Sun Sunday 79 1979 7 01 01 0 01}
+test clock-3.376 {ISO week-based calendar 1979-W02-1} {
+    clock format 284601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W02-1
+} {Mon Monday 79 1979 1 01 02 1 02}
+test clock-3.377 {ISO week-based calendar 1979-W52-1} {
+    clock format 314841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W52-1
+} {Mon Monday 79 1979 1 51 52 1 52}
+test clock-3.378 {ISO week-based calendar 1979-W52-6} {
+    clock format 315273600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W52-6
+} {Sat Saturday 79 1979 6 51 52 6 52}
+test clock-3.379 {ISO week-based calendar 1979-W52-7} {
+    clock format 315360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1979-W52-7
+} {Sun Sunday 79 1979 7 52 52 0 52}
+test clock-3.380 {ISO week-based calendar 1980-W01-1} {
+    clock format 315446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-1
+} {Mon Monday 80 1980 1 52 01 1 53}
+test clock-3.381 {ISO week-based calendar 1980-W01-2} {
+    clock format 315532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-2
+} {Tue Tuesday 80 1980 2 00 01 2 00}
+test clock-3.382 {ISO week-based calendar 1980-W01-6} {
+    clock format 315878400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-6
+} {Sat Saturday 80 1980 6 00 01 6 00}
+test clock-3.383 {ISO week-based calendar 1980-W01-7} {
+    clock format 315964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W01-7
+} {Sun Sunday 80 1980 7 01 01 0 00}
+test clock-3.384 {ISO week-based calendar 1980-W02-1} {
+    clock format 316051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W02-1
+} {Mon Monday 80 1980 1 01 02 1 01}
+test clock-3.385 {ISO week-based calendar 1980-W52-1} {
+    clock format 346291200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W52-1
+} {Mon Monday 80 1980 1 51 52 1 51}
+test clock-3.386 {ISO week-based calendar 1980-W52-6} {
+    clock format 346723200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W52-6
+} {Sat Saturday 80 1980 6 51 52 6 51}
+test clock-3.387 {ISO week-based calendar 1980-W52-7} {
+    clock format 346809600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1980-W52-7
+} {Sun Sunday 80 1980 7 52 52 0 51}
+test clock-3.388 {ISO week-based calendar 1981-W01-1} {
+    clock format 346896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-1
+} {Mon Monday 81 1981 1 52 01 1 52}
+test clock-3.389 {ISO week-based calendar 1981-W01-4} {
+    clock format 347155200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-4
+} {Thu Thursday 81 1981 4 00 01 4 00}
+test clock-3.390 {ISO week-based calendar 1981-W01-6} {
+    clock format 347328000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-6
+} {Sat Saturday 81 1981 6 00 01 6 00}
+test clock-3.391 {ISO week-based calendar 1981-W01-7} {
+    clock format 347414400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W01-7
+} {Sun Sunday 81 1981 7 01 01 0 00}
+test clock-3.392 {ISO week-based calendar 1981-W02-1} {
+    clock format 347500800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1981-W02-1
+} {Mon Monday 81 1981 1 01 02 1 01}
+test clock-3.393 {ISO week-based calendar 1983-W52-1} {
+    clock format 441244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1983-W52-1
+} {Mon Monday 83 1983 1 52 52 1 52}
+test clock-3.394 {ISO week-based calendar 1983-W52-6} {
+    clock format 441676800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1983-W52-6
+} {Sat Saturday 83 1983 6 52 52 6 52}
+test clock-3.395 {ISO week-based calendar 1983-W52-7} {
+    clock format 441763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1983-W52-7
+} {Sun Sunday 83 1983 7 01 52 0 00}
+test clock-3.396 {ISO week-based calendar 1984-W01-1} {
+    clock format 441849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W01-1
+} {Mon Monday 84 1984 1 01 01 1 01}
+test clock-3.397 {ISO week-based calendar 1984-W01-6} {
+    clock format 442281600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W01-6
+} {Sat Saturday 84 1984 6 01 01 6 01}
+test clock-3.398 {ISO week-based calendar 1984-W01-7} {
+    clock format 442368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W01-7
+} {Sun Sunday 84 1984 7 02 01 0 01}
+test clock-3.399 {ISO week-based calendar 1984-W02-1} {
+    clock format 442454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W02-1
+} {Mon Monday 84 1984 1 02 02 1 02}
+test clock-3.400 {ISO week-based calendar 1984-W52-1} {
+    clock format 472694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W52-1
+} {Mon Monday 84 1984 1 52 52 1 52}
+test clock-3.401 {ISO week-based calendar 1984-W52-6} {
+    clock format 473126400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W52-6
+} {Sat Saturday 84 1984 6 52 52 6 52}
+test clock-3.402 {ISO week-based calendar 1984-W52-7} {
+    clock format 473212800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1984-W52-7
+} {Sun Sunday 84 1984 7 53 52 0 52}
+test clock-3.403 {ISO week-based calendar 1985-W01-1} {
+    clock format 473299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-1
+} {Mon Monday 85 1985 1 53 01 1 53}
+test clock-3.404 {ISO week-based calendar 1985-W01-2} {
+    clock format 473385600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-2
+} {Tue Tuesday 85 1985 2 00 01 2 00}
+test clock-3.405 {ISO week-based calendar 1985-W01-6} {
+    clock format 473731200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-6
+} {Sat Saturday 85 1985 6 00 01 6 00}
+test clock-3.406 {ISO week-based calendar 1985-W01-7} {
+    clock format 473817600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W01-7
+} {Sun Sunday 85 1985 7 01 01 0 00}
+test clock-3.407 {ISO week-based calendar 1985-W02-1} {
+    clock format 473904000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1985-W02-1
+} {Mon Monday 85 1985 1 01 02 1 01}
+test clock-3.408 {ISO week-based calendar 1987-W53-1} {
+    clock format 567648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-1
+} {Mon Monday 87 1987 1 52 53 1 52}
+test clock-3.409 {ISO week-based calendar 1987-W53-5} {
+    clock format 567993600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-5
+} {Fri Friday 87 1987 5 00 53 5 00}
+test clock-3.410 {ISO week-based calendar 1987-W53-6} {
+    clock format 568080000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-6
+} {Sat Saturday 87 1987 6 00 53 6 00}
+test clock-3.411 {ISO week-based calendar 1987-W53-7} {
+    clock format 568166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1987-W53-7
+} {Sun Sunday 87 1987 7 01 53 0 00}
+test clock-3.412 {ISO week-based calendar 1988-W01-1} {
+    clock format 568252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W01-1
+} {Mon Monday 88 1988 1 01 01 1 01}
+test clock-3.413 {ISO week-based calendar 1988-W01-6} {
+    clock format 568684800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W01-6
+} {Sat Saturday 88 1988 6 01 01 6 01}
+test clock-3.414 {ISO week-based calendar 1988-W01-7} {
+    clock format 568771200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W01-7
+} {Sun Sunday 88 1988 7 02 01 0 01}
+test clock-3.415 {ISO week-based calendar 1988-W02-1} {
+    clock format 568857600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W02-1
+} {Mon Monday 88 1988 1 02 02 1 02}
+test clock-3.416 {ISO week-based calendar 1988-W52-1} {
+    clock format 599097600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W52-1
+} {Mon Monday 88 1988 1 52 52 1 52}
+test clock-3.417 {ISO week-based calendar 1988-W52-6} {
+    clock format 599529600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W52-6
+} {Sat Saturday 88 1988 6 52 52 6 52}
+test clock-3.418 {ISO week-based calendar 1988-W52-7} {
+    clock format 599616000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1988-W52-7
+} {Sun Sunday 88 1988 7 01 52 0 00}
+test clock-3.419 {ISO week-based calendar 1989-W01-1} {
+    clock format 599702400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W01-1
+} {Mon Monday 89 1989 1 01 01 1 01}
+test clock-3.420 {ISO week-based calendar 1989-W01-6} {
+    clock format 600134400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W01-6
+} {Sat Saturday 89 1989 6 01 01 6 01}
+test clock-3.421 {ISO week-based calendar 1989-W01-7} {
+    clock format 600220800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W01-7
+} {Sun Sunday 89 1989 7 02 01 0 01}
+test clock-3.422 {ISO week-based calendar 1989-W02-1} {
+    clock format 600307200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1989-W02-1
+} {Mon Monday 89 1989 1 02 02 1 02}
+test clock-3.423 {ISO week-based calendar 1991-W52-1} {
+    clock format 693446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1991-W52-1
+} {Mon Monday 91 1991 1 51 52 1 51}
+test clock-3.424 {ISO week-based calendar 1991-W52-6} {
+    clock format 693878400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1991-W52-6
+} {Sat Saturday 91 1991 6 51 52 6 51}
+test clock-3.425 {ISO week-based calendar 1991-W52-7} {
+    clock format 693964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1991-W52-7
+} {Sun Sunday 91 1991 7 52 52 0 51}
+test clock-3.426 {ISO week-based calendar 1992-W01-1} {
+    clock format 694051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-1
+} {Mon Monday 92 1992 1 52 01 1 52}
+test clock-3.427 {ISO week-based calendar 1992-W01-3} {
+    clock format 694224000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-3
+} {Wed Wednesday 92 1992 3 00 01 3 00}
+test clock-3.428 {ISO week-based calendar 1992-W01-6} {
+    clock format 694483200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-6
+} {Sat Saturday 92 1992 6 00 01 6 00}
+test clock-3.429 {ISO week-based calendar 1992-W01-7} {
+    clock format 694569600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W01-7
+} {Sun Sunday 92 1992 7 01 01 0 00}
+test clock-3.430 {ISO week-based calendar 1992-W02-1} {
+    clock format 694656000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W02-1
+} {Mon Monday 92 1992 1 01 02 1 01}
+test clock-3.431 {ISO week-based calendar 1992-W53-1} {
+    clock format 725500800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-1
+} {Mon Monday 92 1992 1 52 53 1 52}
+test clock-3.432 {ISO week-based calendar 1992-W53-5} {
+    clock format 725846400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-5
+} {Fri Friday 92 1992 5 00 53 5 00}
+test clock-3.433 {ISO week-based calendar 1992-W53-6} {
+    clock format 725932800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-6
+} {Sat Saturday 92 1992 6 00 53 6 00}
+test clock-3.434 {ISO week-based calendar 1992-W53-7} {
+    clock format 726019200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1992-W53-7
+} {Sun Sunday 92 1992 7 01 53 0 00}
+test clock-3.435 {ISO week-based calendar 1993-W01-1} {
+    clock format 726105600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W01-1
+} {Mon Monday 93 1993 1 01 01 1 01}
+test clock-3.436 {ISO week-based calendar 1993-W01-6} {
+    clock format 726537600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W01-6
+} {Sat Saturday 93 1993 6 01 01 6 01}
+test clock-3.437 {ISO week-based calendar 1993-W01-7} {
+    clock format 726624000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W01-7
+} {Sun Sunday 93 1993 7 02 01 0 01}
+test clock-3.438 {ISO week-based calendar 1993-W02-1} {
+    clock format 726710400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1993-W02-1
+} {Mon Monday 93 1993 1 02 02 1 02}
+test clock-3.439 {ISO week-based calendar 1995-W52-1} {
+    clock format 819849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1995-W52-1
+} {Mon Monday 95 1995 1 52 52 1 52}
+test clock-3.440 {ISO week-based calendar 1995-W52-6} {
+    clock format 820281600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1995-W52-6
+} {Sat Saturday 95 1995 6 52 52 6 52}
+test clock-3.441 {ISO week-based calendar 1995-W52-7} {
+    clock format 820368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1995-W52-7
+} {Sun Sunday 95 1995 7 53 52 0 52}
+test clock-3.442 {ISO week-based calendar 1996-W01-1} {
+    clock format 820454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W01-1
+} {Mon Monday 96 1996 1 00 01 1 01}
+test clock-3.443 {ISO week-based calendar 1996-W01-6} {
+    clock format 820886400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W01-6
+} {Sat Saturday 96 1996 6 00 01 6 01}
+test clock-3.444 {ISO week-based calendar 1996-W01-7} {
+    clock format 820972800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W01-7
+} {Sun Sunday 96 1996 7 01 01 0 01}
+test clock-3.445 {ISO week-based calendar 1996-W02-1} {
+    clock format 821059200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W02-1
+} {Mon Monday 96 1996 1 01 02 1 02}
+test clock-3.446 {ISO week-based calendar 1996-W52-1} {
+    clock format 851299200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W52-1
+} {Mon Monday 96 1996 1 51 52 1 52}
+test clock-3.447 {ISO week-based calendar 1996-W52-6} {
+    clock format 851731200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W52-6
+} {Sat Saturday 96 1996 6 51 52 6 52}
+test clock-3.448 {ISO week-based calendar 1996-W52-7} {
+    clock format 851817600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1996-W52-7
+} {Sun Sunday 96 1996 7 52 52 0 52}
+test clock-3.449 {ISO week-based calendar 1997-W01-1} {
+    clock format 851904000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-1
+} {Mon Monday 97 1997 1 52 01 1 53}
+test clock-3.450 {ISO week-based calendar 1997-W01-3} {
+    clock format 852076800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-3
+} {Wed Wednesday 97 1997 3 00 01 3 00}
+test clock-3.451 {ISO week-based calendar 1997-W01-6} {
+    clock format 852336000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-6
+} {Sat Saturday 97 1997 6 00 01 6 00}
+test clock-3.452 {ISO week-based calendar 1997-W01-7} {
+    clock format 852422400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W01-7
+} {Sun Sunday 97 1997 7 01 01 0 00}
+test clock-3.453 {ISO week-based calendar 1997-W02-1} {
+    clock format 852508800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1997-W02-1
+} {Mon Monday 97 1997 1 01 02 1 01}
+test clock-3.454 {ISO week-based calendar 1999-W52-1} {
+    clock format 946252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1999-W52-1
+} {Mon Monday 99 1999 1 52 52 1 52}
+test clock-3.455 {ISO week-based calendar 1999-W52-6} {
+    clock format 946684800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1999-W52-6
+} {Sat Saturday 99 1999 6 00 52 6 00}
+test clock-3.456 {ISO week-based calendar 1999-W52-7} {
+    clock format 946771200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 1999-W52-7
+} {Sun Sunday 99 1999 7 01 52 0 00}
+test clock-3.457 {ISO week-based calendar 2000-W01-1} {
+    clock format 946857600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W01-1
+} {Mon Monday 00 2000 1 01 01 1 01}
+test clock-3.458 {ISO week-based calendar 2000-W01-6} {
+    clock format 947289600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W01-6
+} {Sat Saturday 00 2000 6 01 01 6 01}
+test clock-3.459 {ISO week-based calendar 2000-W01-7} {
+    clock format 947376000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W01-7
+} {Sun Sunday 00 2000 7 02 01 0 01}
+test clock-3.460 {ISO week-based calendar 2000-W02-1} {
+    clock format 947462400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W02-1
+} {Mon Monday 00 2000 1 02 02 1 02}
+test clock-3.461 {ISO week-based calendar 2000-W52-1} {
+    clock format 977702400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W52-1
+} {Mon Monday 00 2000 1 52 52 1 52}
+test clock-3.462 {ISO week-based calendar 2000-W52-6} {
+    clock format 978134400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W52-6
+} {Sat Saturday 00 2000 6 52 52 6 52}
+test clock-3.463 {ISO week-based calendar 2000-W52-7} {
+    clock format 978220800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2000-W52-7
+} {Sun Sunday 00 2000 7 53 52 0 52}
+test clock-3.464 {ISO week-based calendar 2001-W01-1} {
+    clock format 978307200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W01-1
+} {Mon Monday 01 2001 1 00 01 1 01}
+test clock-3.465 {ISO week-based calendar 2001-W01-6} {
+    clock format 978739200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W01-6
+} {Sat Saturday 01 2001 6 00 01 6 01}
+test clock-3.466 {ISO week-based calendar 2001-W01-7} {
+    clock format 978825600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W01-7
+} {Sun Sunday 01 2001 7 01 01 0 01}
+test clock-3.467 {ISO week-based calendar 2001-W02-1} {
+    clock format 978912000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W02-1
+} {Mon Monday 01 2001 1 01 02 1 02}
+test clock-3.468 {ISO week-based calendar 2001-W52-1} {
+    clock format 1009152000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W52-1
+} {Mon Monday 01 2001 1 51 52 1 52}
+test clock-3.469 {ISO week-based calendar 2001-W52-6} {
+    clock format 1009584000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W52-6
+} {Sat Saturday 01 2001 6 51 52 6 52}
+test clock-3.470 {ISO week-based calendar 2001-W52-7} {
+    clock format 1009670400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2001-W52-7
+} {Sun Sunday 01 2001 7 52 52 0 52}
+test clock-3.471 {ISO week-based calendar 2002-W01-1} {
+    clock format 1009756800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-1
+} {Mon Monday 02 2002 1 52 01 1 53}
+test clock-3.472 {ISO week-based calendar 2002-W01-2} {
+    clock format 1009843200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-2
+} {Tue Tuesday 02 2002 2 00 01 2 00}
+test clock-3.473 {ISO week-based calendar 2002-W01-6} {
+    clock format 1010188800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-6
+} {Sat Saturday 02 2002 6 00 01 6 00}
+test clock-3.474 {ISO week-based calendar 2002-W01-7} {
+    clock format 1010275200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W01-7
+} {Sun Sunday 02 2002 7 01 01 0 00}
+test clock-3.475 {ISO week-based calendar 2002-W02-1} {
+    clock format 1010361600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W02-1
+} {Mon Monday 02 2002 1 01 02 1 01}
+test clock-3.476 {ISO week-based calendar 2002-W52-1} {
+    clock format 1040601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W52-1
+} {Mon Monday 02 2002 1 51 52 1 51}
+test clock-3.477 {ISO week-based calendar 2002-W52-6} {
+    clock format 1041033600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W52-6
+} {Sat Saturday 02 2002 6 51 52 6 51}
+test clock-3.478 {ISO week-based calendar 2002-W52-7} {
+    clock format 1041120000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2002-W52-7
+} {Sun Sunday 02 2002 7 52 52 0 51}
+test clock-3.479 {ISO week-based calendar 2003-W01-1} {
+    clock format 1041206400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-1
+} {Mon Monday 03 2003 1 52 01 1 52}
+test clock-3.480 {ISO week-based calendar 2003-W01-3} {
+    clock format 1041379200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-3
+} {Wed Wednesday 03 2003 3 00 01 3 00}
+test clock-3.481 {ISO week-based calendar 2003-W01-6} {
+    clock format 1041638400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-6
+} {Sat Saturday 03 2003 6 00 01 6 00}
+test clock-3.482 {ISO week-based calendar 2003-W01-7} {
+    clock format 1041724800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W01-7
+} {Sun Sunday 03 2003 7 01 01 0 00}
+test clock-3.483 {ISO week-based calendar 2003-W02-1} {
+    clock format 1041811200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W02-1
+} {Mon Monday 03 2003 1 01 02 1 01}
+test clock-3.484 {ISO week-based calendar 2003-W52-1} {
+    clock format 1072051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W52-1
+} {Mon Monday 03 2003 1 51 52 1 51}
+test clock-3.485 {ISO week-based calendar 2003-W52-6} {
+    clock format 1072483200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W52-6
+} {Sat Saturday 03 2003 6 51 52 6 51}
+test clock-3.486 {ISO week-based calendar 2003-W52-7} {
+    clock format 1072569600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2003-W52-7
+} {Sun Sunday 03 2003 7 52 52 0 51}
+test clock-3.487 {ISO week-based calendar 2004-W01-1} {
+    clock format 1072656000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-1
+} {Mon Monday 04 2004 1 52 01 1 52}
+test clock-3.488 {ISO week-based calendar 2004-W01-4} {
+    clock format 1072915200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-4
+} {Thu Thursday 04 2004 4 00 01 4 00}
+test clock-3.489 {ISO week-based calendar 2004-W01-6} {
+    clock format 1073088000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-6
+} {Sat Saturday 04 2004 6 00 01 6 00}
+test clock-3.490 {ISO week-based calendar 2004-W01-7} {
+    clock format 1073174400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W01-7
+} {Sun Sunday 04 2004 7 01 01 0 00}
+test clock-3.491 {ISO week-based calendar 2004-W02-1} {
+    clock format 1073260800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W02-1
+} {Mon Monday 04 2004 1 01 02 1 01}
+test clock-3.492 {ISO week-based calendar 2004-W53-1} {
+    clock format 1104105600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W53-1
+} {Mon Monday 04 2004 1 52 53 1 52}
+test clock-3.493 {ISO week-based calendar 2004-W53-6} {
+    clock format 1104537600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W53-6
+} {Sat Saturday 04 2004 6 00 53 6 00}
+test clock-3.494 {ISO week-based calendar 2004-W53-7} {
+    clock format 1104624000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2004-W53-7
+} {Sun Sunday 04 2004 7 01 53 0 00}
+test clock-3.495 {ISO week-based calendar 2005-W01-1} {
+    clock format 1104710400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W01-1
+} {Mon Monday 05 2005 1 01 01 1 01}
+test clock-3.496 {ISO week-based calendar 2005-W01-6} {
+    clock format 1105142400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W01-6
+} {Sat Saturday 05 2005 6 01 01 6 01}
+test clock-3.497 {ISO week-based calendar 2005-W01-7} {
+    clock format 1105228800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W01-7
+} {Sun Sunday 05 2005 7 02 01 0 01}
+test clock-3.498 {ISO week-based calendar 2005-W02-1} {
+    clock format 1105315200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W02-1
+} {Mon Monday 05 2005 1 02 02 1 02}
+test clock-3.499 {ISO week-based calendar 2005-W52-1} {
+    clock format 1135555200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W52-1
+} {Mon Monday 05 2005 1 52 52 1 52}
+test clock-3.500 {ISO week-based calendar 2005-W52-6} {
+    clock format 1135987200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W52-6
+} {Sat Saturday 05 2005 6 52 52 6 52}
+test clock-3.501 {ISO week-based calendar 2005-W52-7} {
+    clock format 1136073600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2005-W52-7
+} {Sun Sunday 05 2005 7 01 52 0 00}
+test clock-3.502 {ISO week-based calendar 2006-W01-1} {
+    clock format 1136160000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W01-1
+} {Mon Monday 06 2006 1 01 01 1 01}
+test clock-3.503 {ISO week-based calendar 2006-W01-6} {
+    clock format 1136592000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W01-6
+} {Sat Saturday 06 2006 6 01 01 6 01}
+test clock-3.504 {ISO week-based calendar 2006-W01-7} {
+    clock format 1136678400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W01-7
+} {Sun Sunday 06 2006 7 02 01 0 01}
+test clock-3.505 {ISO week-based calendar 2006-W02-1} {
+    clock format 1136764800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W02-1
+} {Mon Monday 06 2006 1 02 02 1 02}
+test clock-3.506 {ISO week-based calendar 2006-W52-1} {
+    clock format 1167004800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W52-1
+} {Mon Monday 06 2006 1 52 52 1 52}
+test clock-3.507 {ISO week-based calendar 2006-W52-6} {
+    clock format 1167436800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W52-6
+} {Sat Saturday 06 2006 6 52 52 6 52}
+test clock-3.508 {ISO week-based calendar 2006-W52-7} {
+    clock format 1167523200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2006-W52-7
+} {Sun Sunday 06 2006 7 53 52 0 52}
+test clock-3.509 {ISO week-based calendar 2007-W01-1} {
+    clock format 1167609600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W01-1
+} {Mon Monday 07 2007 1 00 01 1 01}
+test clock-3.510 {ISO week-based calendar 2007-W01-6} {
+    clock format 1168041600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W01-6
+} {Sat Saturday 07 2007 6 00 01 6 01}
+test clock-3.511 {ISO week-based calendar 2007-W01-7} {
+    clock format 1168128000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W01-7
+} {Sun Sunday 07 2007 7 01 01 0 01}
+test clock-3.512 {ISO week-based calendar 2007-W02-1} {
+    clock format 1168214400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W02-1
+} {Mon Monday 07 2007 1 01 02 1 02}
+test clock-3.513 {ISO week-based calendar 2007-W52-1} {
+    clock format 1198454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W52-1
+} {Mon Monday 07 2007 1 51 52 1 52}
+test clock-3.514 {ISO week-based calendar 2007-W52-6} {
+    clock format 1198886400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W52-6
+} {Sat Saturday 07 2007 6 51 52 6 52}
+test clock-3.515 {ISO week-based calendar 2007-W52-7} {
+    clock format 1198972800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2007-W52-7
+} {Sun Sunday 07 2007 7 52 52 0 52}
+test clock-3.516 {ISO week-based calendar 2008-W01-1} {
+    clock format 1199059200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-1
+} {Mon Monday 08 2008 1 52 01 1 53}
+test clock-3.517 {ISO week-based calendar 2008-W01-2} {
+    clock format 1199145600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-2
+} {Tue Tuesday 08 2008 2 00 01 2 00}
+test clock-3.518 {ISO week-based calendar 2008-W01-6} {
+    clock format 1199491200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-6
+} {Sat Saturday 08 2008 6 00 01 6 00}
+test clock-3.519 {ISO week-based calendar 2008-W01-7} {
+    clock format 1199577600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W01-7
+} {Sun Sunday 08 2008 7 01 01 0 00}
+test clock-3.520 {ISO week-based calendar 2008-W02-1} {
+    clock format 1199664000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W02-1
+} {Mon Monday 08 2008 1 01 02 1 01}
+test clock-3.521 {ISO week-based calendar 2008-W52-1} {
+    clock format 1229904000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W52-1
+} {Mon Monday 08 2008 1 51 52 1 51}
+test clock-3.522 {ISO week-based calendar 2008-W52-6} {
+    clock format 1230336000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W52-6
+} {Sat Saturday 08 2008 6 51 52 6 51}
+test clock-3.523 {ISO week-based calendar 2008-W52-7} {
+    clock format 1230422400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2008-W52-7
+} {Sun Sunday 08 2008 7 52 52 0 51}
+test clock-3.524 {ISO week-based calendar 2009-W01-1} {
+    clock format 1230508800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-1
+} {Mon Monday 09 2009 1 52 01 1 52}
+test clock-3.525 {ISO week-based calendar 2009-W01-4} {
+    clock format 1230768000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-4
+} {Thu Thursday 09 2009 4 00 01 4 00}
+test clock-3.526 {ISO week-based calendar 2009-W01-6} {
+    clock format 1230940800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-6
+} {Sat Saturday 09 2009 6 00 01 6 00}
+test clock-3.527 {ISO week-based calendar 2009-W01-7} {
+    clock format 1231027200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W01-7
+} {Sun Sunday 09 2009 7 01 01 0 00}
+test clock-3.528 {ISO week-based calendar 2009-W02-1} {
+    clock format 1231113600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W02-1
+} {Mon Monday 09 2009 1 01 02 1 01}
+test clock-3.529 {ISO week-based calendar 2009-W53-1} {
+    clock format 1261958400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-1
+} {Mon Monday 09 2009 1 52 53 1 52}
+test clock-3.530 {ISO week-based calendar 2009-W53-5} {
+    clock format 1262304000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-5
+} {Fri Friday 09 2009 5 00 53 5 00}
+test clock-3.531 {ISO week-based calendar 2009-W53-6} {
+    clock format 1262390400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-6
+} {Sat Saturday 09 2009 6 00 53 6 00}
+test clock-3.532 {ISO week-based calendar 2009-W53-7} {
+    clock format 1262476800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2009-W53-7
+} {Sun Sunday 09 2009 7 01 53 0 00}
+test clock-3.533 {ISO week-based calendar 2010-W01-1} {
+    clock format 1262563200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W01-1
+} {Mon Monday 10 2010 1 01 01 1 01}
+test clock-3.534 {ISO week-based calendar 2010-W01-6} {
+    clock format 1262995200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W01-6
+} {Sat Saturday 10 2010 6 01 01 6 01}
+test clock-3.535 {ISO week-based calendar 2010-W01-7} {
+    clock format 1263081600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W01-7
+} {Sun Sunday 10 2010 7 02 01 0 01}
+test clock-3.536 {ISO week-based calendar 2010-W02-1} {
+    clock format 1263168000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W02-1
+} {Mon Monday 10 2010 1 02 02 1 02}
+test clock-3.537 {ISO week-based calendar 2010-W52-1} {
+    clock format 1293408000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W52-1
+} {Mon Monday 10 2010 1 52 52 1 52}
+test clock-3.538 {ISO week-based calendar 2010-W52-6} {
+    clock format 1293840000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W52-6
+} {Sat Saturday 10 2010 6 00 52 6 00}
+test clock-3.539 {ISO week-based calendar 2010-W52-7} {
+    clock format 1293926400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2010-W52-7
+} {Sun Sunday 10 2010 7 01 52 0 00}
+test clock-3.540 {ISO week-based calendar 2011-W01-1} {
+    clock format 1294012800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W01-1
+} {Mon Monday 11 2011 1 01 01 1 01}
+test clock-3.541 {ISO week-based calendar 2011-W01-6} {
+    clock format 1294444800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W01-6
+} {Sat Saturday 11 2011 6 01 01 6 01}
+test clock-3.542 {ISO week-based calendar 2011-W01-7} {
+    clock format 1294531200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W01-7
+} {Sun Sunday 11 2011 7 02 01 0 01}
+test clock-3.543 {ISO week-based calendar 2011-W02-1} {
+    clock format 1294617600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W02-1
+} {Mon Monday 11 2011 1 02 02 1 02}
+test clock-3.544 {ISO week-based calendar 2011-W52-1} {
+    clock format 1324857600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W52-1
+} {Mon Monday 11 2011 1 52 52 1 52}
+test clock-3.545 {ISO week-based calendar 2011-W52-6} {
+    clock format 1325289600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W52-6
+} {Sat Saturday 11 2011 6 52 52 6 52}
+test clock-3.546 {ISO week-based calendar 2011-W52-7} {
+    clock format 1325376000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2011-W52-7
+} {Sun Sunday 11 2011 7 01 52 0 00}
+test clock-3.547 {ISO week-based calendar 2012-W01-1} {
+    clock format 1325462400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W01-1
+} {Mon Monday 12 2012 1 01 01 1 01}
+test clock-3.548 {ISO week-based calendar 2012-W01-6} {
+    clock format 1325894400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W01-6
+} {Sat Saturday 12 2012 6 01 01 6 01}
+test clock-3.549 {ISO week-based calendar 2012-W01-7} {
+    clock format 1325980800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W01-7
+} {Sun Sunday 12 2012 7 02 01 0 01}
+test clock-3.550 {ISO week-based calendar 2012-W02-1} {
+    clock format 1326067200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W02-1
+} {Mon Monday 12 2012 1 02 02 1 02}
+test clock-3.551 {ISO week-based calendar 2012-W52-1} {
+    clock format 1356307200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W52-1
+} {Mon Monday 12 2012 1 52 52 1 52}
+test clock-3.552 {ISO week-based calendar 2012-W52-6} {
+    clock format 1356739200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W52-6
+} {Sat Saturday 12 2012 6 52 52 6 52}
+test clock-3.553 {ISO week-based calendar 2012-W52-7} {
+    clock format 1356825600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2012-W52-7
+} {Sun Sunday 12 2012 7 53 52 0 52}
+test clock-3.554 {ISO week-based calendar 2013-W01-1} {
+    clock format 1356912000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-1
+} {Mon Monday 13 2013 1 53 01 1 53}
+test clock-3.555 {ISO week-based calendar 2013-W01-2} {
+    clock format 1356998400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-2
+} {Tue Tuesday 13 2013 2 00 01 2 00}
+test clock-3.556 {ISO week-based calendar 2013-W01-6} {
+    clock format 1357344000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-6
+} {Sat Saturday 13 2013 6 00 01 6 00}
+test clock-3.557 {ISO week-based calendar 2013-W01-7} {
+    clock format 1357430400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W01-7
+} {Sun Sunday 13 2013 7 01 01 0 00}
+test clock-3.558 {ISO week-based calendar 2013-W02-1} {
+    clock format 1357516800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2013-W02-1
+} {Mon Monday 13 2013 1 01 02 1 01}
+test clock-3.559 {ISO week-based calendar 2015-W53-1} {
+    clock format 1451260800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-1
+} {Mon Monday 15 2015 1 52 53 1 52}
+test clock-3.560 {ISO week-based calendar 2015-W53-5} {
+    clock format 1451606400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-5
+} {Fri Friday 15 2015 5 00 53 5 00}
+test clock-3.561 {ISO week-based calendar 2015-W53-6} {
+    clock format 1451692800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-6
+} {Sat Saturday 15 2015 6 00 53 6 00}
+test clock-3.562 {ISO week-based calendar 2015-W53-7} {
+    clock format 1451779200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2015-W53-7
+} {Sun Sunday 15 2015 7 01 53 0 00}
+test clock-3.563 {ISO week-based calendar 2016-W01-1} {
+    clock format 1451865600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W01-1
+} {Mon Monday 16 2016 1 01 01 1 01}
+test clock-3.564 {ISO week-based calendar 2016-W01-6} {
+    clock format 1452297600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W01-6
+} {Sat Saturday 16 2016 6 01 01 6 01}
+test clock-3.565 {ISO week-based calendar 2016-W01-7} {
+    clock format 1452384000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W01-7
+} {Sun Sunday 16 2016 7 02 01 0 01}
+test clock-3.566 {ISO week-based calendar 2016-W02-1} {
+    clock format 1452470400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W02-1
+} {Mon Monday 16 2016 1 02 02 1 02}
+test clock-3.567 {ISO week-based calendar 2016-W52-1} {
+    clock format 1482710400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W52-1
+} {Mon Monday 16 2016 1 52 52 1 52}
+test clock-3.568 {ISO week-based calendar 2016-W52-6} {
+    clock format 1483142400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W52-6
+} {Sat Saturday 16 2016 6 52 52 6 52}
+test clock-3.569 {ISO week-based calendar 2016-W52-7} {
+    clock format 1483228800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2016-W52-7
+} {Sun Sunday 16 2016 7 01 52 0 00}
+test clock-3.570 {ISO week-based calendar 2017-W01-1} {
+    clock format 1483315200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W01-1
+} {Mon Monday 17 2017 1 01 01 1 01}
+test clock-3.571 {ISO week-based calendar 2017-W01-6} {
+    clock format 1483747200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W01-6
+} {Sat Saturday 17 2017 6 01 01 6 01}
+test clock-3.572 {ISO week-based calendar 2017-W01-7} {
+    clock format 1483833600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W01-7
+} {Sun Sunday 17 2017 7 02 01 0 01}
+test clock-3.573 {ISO week-based calendar 2017-W02-1} {
+    clock format 1483920000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2017-W02-1
+} {Mon Monday 17 2017 1 02 02 1 02}
+test clock-3.574 {ISO week-based calendar 2019-W52-1} {
+    clock format 1577059200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2019-W52-1
+} {Mon Monday 19 2019 1 51 52 1 51}
+test clock-3.575 {ISO week-based calendar 2019-W52-6} {
+    clock format 1577491200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2019-W52-6
+} {Sat Saturday 19 2019 6 51 52 6 51}
+test clock-3.576 {ISO week-based calendar 2019-W52-7} {
+    clock format 1577577600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2019-W52-7
+} {Sun Sunday 19 2019 7 52 52 0 51}
+test clock-3.577 {ISO week-based calendar 2020-W01-1} {
+    clock format 1577664000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-1
+} {Mon Monday 20 2020 1 52 01 1 52}
+test clock-3.578 {ISO week-based calendar 2020-W01-3} {
+    clock format 1577836800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-3
+} {Wed Wednesday 20 2020 3 00 01 3 00}
+test clock-3.579 {ISO week-based calendar 2020-W01-6} {
+    clock format 1578096000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-6
+} {Sat Saturday 20 2020 6 00 01 6 00}
+test clock-3.580 {ISO week-based calendar 2020-W01-7} {
+    clock format 1578182400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W01-7
+} {Sun Sunday 20 2020 7 01 01 0 00}
+test clock-3.581 {ISO week-based calendar 2020-W02-1} {
+    clock format 1578268800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W02-1
+} {Mon Monday 20 2020 1 01 02 1 01}
+test clock-3.582 {ISO week-based calendar 2020-W53-1} {
+    clock format 1609113600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-1
+} {Mon Monday 20 2020 1 52 53 1 52}
+test clock-3.583 {ISO week-based calendar 2020-W53-5} {
+    clock format 1609459200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-5
+} {Fri Friday 20 2020 5 00 53 5 00}
+test clock-3.584 {ISO week-based calendar 2020-W53-6} {
+    clock format 1609545600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-6
+} {Sat Saturday 20 2020 6 00 53 6 00}
+test clock-3.585 {ISO week-based calendar 2020-W53-7} {
+    clock format 1609632000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2020-W53-7
+} {Sun Sunday 20 2020 7 01 53 0 00}
+test clock-3.586 {ISO week-based calendar 2021-W01-1} {
+    clock format 1609718400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W01-1
+} {Mon Monday 21 2021 1 01 01 1 01}
+test clock-3.587 {ISO week-based calendar 2021-W01-6} {
+    clock format 1610150400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W01-6
+} {Sat Saturday 21 2021 6 01 01 6 01}
+test clock-3.588 {ISO week-based calendar 2021-W01-7} {
+    clock format 1610236800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W01-7
+} {Sun Sunday 21 2021 7 02 01 0 01}
+test clock-3.589 {ISO week-based calendar 2021-W02-1} {
+    clock format 1610323200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2021-W02-1
+} {Mon Monday 21 2021 1 02 02 1 02}
+test clock-3.590 {ISO week-based calendar 2023-W52-1} {
+    clock format 1703462400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2023-W52-1
+} {Mon Monday 23 2023 1 52 52 1 52}
+test clock-3.591 {ISO week-based calendar 2023-W52-6} {
+    clock format 1703894400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2023-W52-6
+} {Sat Saturday 23 2023 6 52 52 6 52}
+test clock-3.592 {ISO week-based calendar 2023-W52-7} {
+    clock format 1703980800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2023-W52-7
+} {Sun Sunday 23 2023 7 53 52 0 52}
+test clock-3.593 {ISO week-based calendar 2024-W01-1} {
+    clock format 1704067200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W01-1
+} {Mon Monday 24 2024 1 00 01 1 01}
+test clock-3.594 {ISO week-based calendar 2024-W01-6} {
+    clock format 1704499200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W01-6
+} {Sat Saturday 24 2024 6 00 01 6 01}
+test clock-3.595 {ISO week-based calendar 2024-W01-7} {
+    clock format 1704585600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W01-7
+} {Sun Sunday 24 2024 7 01 01 0 01}
+test clock-3.596 {ISO week-based calendar 2024-W02-1} {
+    clock format 1704672000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W02-1
+} {Mon Monday 24 2024 1 01 02 1 02}
+test clock-3.597 {ISO week-based calendar 2024-W52-1} {
+    clock format 1734912000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W52-1
+} {Mon Monday 24 2024 1 51 52 1 52}
+test clock-3.598 {ISO week-based calendar 2024-W52-6} {
+    clock format 1735344000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W52-6
+} {Sat Saturday 24 2024 6 51 52 6 52}
+test clock-3.599 {ISO week-based calendar 2024-W52-7} {
+    clock format 1735430400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2024-W52-7
+} {Sun Sunday 24 2024 7 52 52 0 52}
+test clock-3.600 {ISO week-based calendar 2025-W01-1} {
+    clock format 1735516800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-1
+} {Mon Monday 25 2025 1 52 01 1 53}
+test clock-3.601 {ISO week-based calendar 2025-W01-3} {
+    clock format 1735689600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-3
+} {Wed Wednesday 25 2025 3 00 01 3 00}
+test clock-3.602 {ISO week-based calendar 2025-W01-6} {
+    clock format 1735948800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-6
+} {Sat Saturday 25 2025 6 00 01 6 00}
+test clock-3.603 {ISO week-based calendar 2025-W01-7} {
+    clock format 1736035200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W01-7
+} {Sun Sunday 25 2025 7 01 01 0 00}
+test clock-3.604 {ISO week-based calendar 2025-W02-1} {
+    clock format 1736121600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2025-W02-1
+} {Mon Monday 25 2025 1 01 02 1 01}
+test clock-3.605 {ISO week-based calendar 2036-W52-1} {
+    clock format 2113516800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2036-W52-1
+} {Mon Monday 36 2036 1 51 52 1 51}
+test clock-3.606 {ISO week-based calendar 2036-W52-6} {
+    clock format 2113948800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2036-W52-6
+} {Sat Saturday 36 2036 6 51 52 6 51}
+test clock-3.607 {ISO week-based calendar 2036-W52-7} {
+    clock format 2114035200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2036-W52-7
+} {Sun Sunday 36 2036 7 52 52 0 51}
+test clock-3.608 {ISO week-based calendar 2037-W01-1} {
+    clock format 2114121600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-1
+} {Mon Monday 37 2037 1 52 01 1 52}
+test clock-3.609 {ISO week-based calendar 2037-W01-4} {
+    clock format 2114380800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-4
+} {Thu Thursday 37 2037 4 00 01 4 00}
+test clock-3.610 {ISO week-based calendar 2037-W01-6} {
+    clock format 2114553600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-6
+} {Sat Saturday 37 2037 6 00 01 6 00}
+test clock-3.611 {ISO week-based calendar 2037-W01-7} {
+    clock format 2114640000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W01-7
+} {Sun Sunday 37 2037 7 01 01 0 00}
+test clock-3.612 {ISO week-based calendar 2037-W02-1} {
+    clock format 2114726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W02-1
+} {Mon Monday 37 2037 1 01 02 1 01}
+test clock-3.613 {ISO week-based calendar 2037-W53-1} {
+    clock format 2145571200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-1
+} {Mon Monday 37 2037 1 52 53 1 52}
+test clock-3.614 {ISO week-based calendar 2037-W53-5} {
+    clock format 2145916800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-5
+} {Fri Friday 37 2037 5 00 53 5 00}
+test clock-3.615 {ISO week-based calendar 2037-W53-6} {
+    clock format 2146003200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-6
+} {Sat Saturday 37 2037 6 00 53 6 00}
+test clock-3.616 {ISO week-based calendar 2037-W53-7} {
+    clock format 2146089600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2037-W53-7
+} {Sun Sunday 37 2037 7 01 53 0 00}
+test clock-3.617 {ISO week-based calendar 2038-W01-1} {
+    clock format 2146176000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W01-1
+} {Mon Monday 38 2038 1 01 01 1 01}
+test clock-3.618 {ISO week-based calendar 2038-W01-6} {
+    clock format 2146608000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W01-6
+} {Sat Saturday 38 2038 6 01 01 6 01}
+test clock-3.619 {ISO week-based calendar 2038-W01-7} {
+    clock format 2146694400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W01-7
+} {Sun Sunday 38 2038 7 02 01 0 01}
+test clock-3.620 {ISO week-based calendar 2038-W02-1} {
+    clock format 2146780800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W02-1
+} {Mon Monday 38 2038 1 02 02 1 02}
+test clock-3.621 {ISO week-based calendar 2038-W52-1} {
+    clock format 2177020800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W52-1
+} {Mon Monday 38 2038 1 52 52 1 52}
+test clock-3.622 {ISO week-based calendar 2038-W52-6} {
+    clock format 2177452800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W52-6
+} {Sat Saturday 38 2038 6 00 52 6 00}
+test clock-3.623 {ISO week-based calendar 2038-W52-7} {
+    clock format 2177539200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2038-W52-7
+} {Sun Sunday 38 2038 7 01 52 0 00}
+test clock-3.624 {ISO week-based calendar 2039-W01-1} {
+    clock format 2177625600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W01-1
+} {Mon Monday 39 2039 1 01 01 1 01}
+test clock-3.625 {ISO week-based calendar 2039-W01-6} {
+    clock format 2178057600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W01-6
+} {Sat Saturday 39 2039 6 01 01 6 01}
+test clock-3.626 {ISO week-based calendar 2039-W01-7} {
+    clock format 2178144000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W01-7
+} {Sun Sunday 39 2039 7 02 01 0 01}
+test clock-3.627 {ISO week-based calendar 2039-W02-1} {
+    clock format 2178230400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W02-1
+} {Mon Monday 39 2039 1 02 02 1 02}
+test clock-3.628 {ISO week-based calendar 2039-W52-1} {
+    clock format 2208470400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W52-1
+} {Mon Monday 39 2039 1 52 52 1 52}
+test clock-3.629 {ISO week-based calendar 2039-W52-6} {
+    clock format 2208902400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W52-6
+} {Sat Saturday 39 2039 6 52 52 6 52}
+test clock-3.630 {ISO week-based calendar 2039-W52-7} {
+    clock format 2208988800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2039-W52-7
+} {Sun Sunday 39 2039 7 01 52 0 00}
+test clock-3.631 {ISO week-based calendar 2040-W01-1} {
+    clock format 2209075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W01-1
+} {Mon Monday 40 2040 1 01 01 1 01}
+test clock-3.632 {ISO week-based calendar 2040-W01-6} {
+    clock format 2209507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W01-6
+} {Sat Saturday 40 2040 6 01 01 6 01}
+test clock-3.633 {ISO week-based calendar 2040-W01-7} {
+    clock format 2209593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W01-7
+} {Sun Sunday 40 2040 7 02 01 0 01}
+test clock-3.634 {ISO week-based calendar 2040-W02-1} {
+    clock format 2209680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W02-1
+} {Mon Monday 40 2040 1 02 02 1 02}
+test clock-3.635 {ISO week-based calendar 2040-W52-1} {
+    clock format 2239920000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W52-1
+} {Mon Monday 40 2040 1 52 52 1 52}
+test clock-3.636 {ISO week-based calendar 2040-W52-6} {
+    clock format 2240352000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W52-6
+} {Sat Saturday 40 2040 6 52 52 6 52}
+test clock-3.637 {ISO week-based calendar 2040-W52-7} {
+    clock format 2240438400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2040-W52-7
+} {Sun Sunday 40 2040 7 53 52 0 52}
+test clock-3.638 {ISO week-based calendar 2041-W01-1} {
+    clock format 2240524800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-1
+} {Mon Monday 41 2041 1 53 01 1 53}
+test clock-3.639 {ISO week-based calendar 2041-W01-2} {
+    clock format 2240611200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-2
+} {Tue Tuesday 41 2041 2 00 01 2 00}
+test clock-3.640 {ISO week-based calendar 2041-W01-6} {
+    clock format 2240956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-6
+} {Sat Saturday 41 2041 6 00 01 6 00}
+test clock-3.641 {ISO week-based calendar 2041-W01-7} {
+    clock format 2241043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W01-7
+} {Sun Sunday 41 2041 7 01 01 0 00}
+test clock-3.642 {ISO week-based calendar 2041-W02-1} {
+    clock format 2241129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W02-1
+} {Mon Monday 41 2041 1 01 02 1 01}
+test clock-3.643 {ISO week-based calendar 2041-W52-1} {
+    clock format 2271369600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W52-1
+} {Mon Monday 41 2041 1 51 52 1 51}
+test clock-3.644 {ISO week-based calendar 2041-W52-6} {
+    clock format 2271801600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W52-6
+} {Sat Saturday 41 2041 6 51 52 6 51}
+test clock-3.645 {ISO week-based calendar 2041-W52-7} {
+    clock format 2271888000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2041-W52-7
+} {Sun Sunday 41 2041 7 52 52 0 51}
+test clock-3.646 {ISO week-based calendar 2042-W01-1} {
+    clock format 2271974400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-1
+} {Mon Monday 42 2042 1 52 01 1 52}
+test clock-3.647 {ISO week-based calendar 2042-W01-3} {
+    clock format 2272147200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-3
+} {Wed Wednesday 42 2042 3 00 01 3 00}
+test clock-3.648 {ISO week-based calendar 2042-W01-6} {
+    clock format 2272406400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-6
+} {Sat Saturday 42 2042 6 00 01 6 00}
+test clock-3.649 {ISO week-based calendar 2042-W01-7} {
+    clock format 2272492800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W01-7
+} {Sun Sunday 42 2042 7 01 01 0 00}
+test clock-3.650 {ISO week-based calendar 2042-W02-1} {
+    clock format 2272579200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W02-1
+} {Mon Monday 42 2042 1 01 02 1 01}
+test clock-3.651 {ISO week-based calendar 2042-W52-1} {
+    clock format 2302819200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W52-1
+} {Mon Monday 42 2042 1 51 52 1 51}
+test clock-3.652 {ISO week-based calendar 2042-W52-6} {
+    clock format 2303251200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W52-6
+} {Sat Saturday 42 2042 6 51 52 6 51}
+test clock-3.653 {ISO week-based calendar 2042-W52-7} {
+    clock format 2303337600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2042-W52-7
+} {Sun Sunday 42 2042 7 52 52 0 51}
+test clock-3.654 {ISO week-based calendar 2043-W01-1} {
+    clock format 2303424000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-1
+} {Mon Monday 43 2043 1 52 01 1 52}
+test clock-3.655 {ISO week-based calendar 2043-W01-4} {
+    clock format 2303683200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-4
+} {Thu Thursday 43 2043 4 00 01 4 00}
+test clock-3.656 {ISO week-based calendar 2043-W01-6} {
+    clock format 2303856000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-6
+} {Sat Saturday 43 2043 6 00 01 6 00}
+test clock-3.657 {ISO week-based calendar 2043-W01-7} {
+    clock format 2303942400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W01-7
+} {Sun Sunday 43 2043 7 01 01 0 00}
+test clock-3.658 {ISO week-based calendar 2043-W02-1} {
+    clock format 2304028800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W02-1
+} {Mon Monday 43 2043 1 01 02 1 01}
+test clock-3.659 {ISO week-based calendar 2043-W53-1} {
+    clock format 2334873600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-1
+} {Mon Monday 43 2043 1 52 53 1 52}
+test clock-3.660 {ISO week-based calendar 2043-W53-5} {
+    clock format 2335219200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-5
+} {Fri Friday 43 2043 5 00 53 5 00}
+test clock-3.661 {ISO week-based calendar 2043-W53-6} {
+    clock format 2335305600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-6
+} {Sat Saturday 43 2043 6 00 53 6 00}
+test clock-3.662 {ISO week-based calendar 2043-W53-7} {
+    clock format 2335392000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2043-W53-7
+} {Sun Sunday 43 2043 7 01 53 0 00}
+test clock-3.663 {ISO week-based calendar 2044-W01-1} {
+    clock format 2335478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W01-1
+} {Mon Monday 44 2044 1 01 01 1 01}
+test clock-3.664 {ISO week-based calendar 2044-W01-6} {
+    clock format 2335910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W01-6
+} {Sat Saturday 44 2044 6 01 01 6 01}
+test clock-3.665 {ISO week-based calendar 2044-W01-7} {
+    clock format 2335996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W01-7
+} {Sun Sunday 44 2044 7 02 01 0 01}
+test clock-3.666 {ISO week-based calendar 2044-W02-1} {
+    clock format 2336083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W02-1
+} {Mon Monday 44 2044 1 02 02 1 02}
+test clock-3.667 {ISO week-based calendar 2044-W52-1} {
+    clock format 2366323200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W52-1
+} {Mon Monday 44 2044 1 52 52 1 52}
+test clock-3.668 {ISO week-based calendar 2044-W52-6} {
+    clock format 2366755200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W52-6
+} {Sat Saturday 44 2044 6 52 52 6 52}
+test clock-3.669 {ISO week-based calendar 2044-W52-7} {
+    clock format 2366841600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2044-W52-7
+} {Sun Sunday 44 2044 7 01 52 0 00}
+test clock-3.670 {ISO week-based calendar 2045-W01-1} {
+    clock format 2366928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W01-1
+} {Mon Monday 45 2045 1 01 01 1 01}
+test clock-3.671 {ISO week-based calendar 2045-W01-6} {
+    clock format 2367360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W01-6
+} {Sat Saturday 45 2045 6 01 01 6 01}
+test clock-3.672 {ISO week-based calendar 2045-W01-7} {
+    clock format 2367446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W01-7
+} {Sun Sunday 45 2045 7 02 01 0 01}
+test clock-3.673 {ISO week-based calendar 2045-W02-1} {
+    clock format 2367532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W02-1
+} {Mon Monday 45 2045 1 02 02 1 02}
+test clock-3.674 {ISO week-based calendar 2045-W52-1} {
+    clock format 2397772800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W52-1
+} {Mon Monday 45 2045 1 52 52 1 52}
+test clock-3.675 {ISO week-based calendar 2045-W52-6} {
+    clock format 2398204800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W52-6
+} {Sat Saturday 45 2045 6 52 52 6 52}
+test clock-3.676 {ISO week-based calendar 2045-W52-7} {
+    clock format 2398291200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2045-W52-7
+} {Sun Sunday 45 2045 7 53 52 0 52}
+test clock-3.677 {ISO week-based calendar 2046-W01-1} {
+    clock format 2398377600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W01-1
+} {Mon Monday 46 2046 1 00 01 1 01}
+test clock-3.678 {ISO week-based calendar 2046-W01-6} {
+    clock format 2398809600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W01-6
+} {Sat Saturday 46 2046 6 00 01 6 01}
+test clock-3.679 {ISO week-based calendar 2046-W01-7} {
+    clock format 2398896000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W01-7
+} {Sun Sunday 46 2046 7 01 01 0 01}
+test clock-3.680 {ISO week-based calendar 2046-W02-1} {
+    clock format 2398982400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W02-1
+} {Mon Monday 46 2046 1 01 02 1 02}
+test clock-3.681 {ISO week-based calendar 2046-W52-1} {
+    clock format 2429222400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W52-1
+} {Mon Monday 46 2046 1 51 52 1 52}
+test clock-3.682 {ISO week-based calendar 2046-W52-6} {
+    clock format 2429654400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W52-6
+} {Sat Saturday 46 2046 6 51 52 6 52}
+test clock-3.683 {ISO week-based calendar 2046-W52-7} {
+    clock format 2429740800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2046-W52-7
+} {Sun Sunday 46 2046 7 52 52 0 52}
+test clock-3.684 {ISO week-based calendar 2047-W01-1} {
+    clock format 2429827200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-1
+} {Mon Monday 47 2047 1 52 01 1 53}
+test clock-3.685 {ISO week-based calendar 2047-W01-2} {
+    clock format 2429913600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-2
+} {Tue Tuesday 47 2047 2 00 01 2 00}
+test clock-3.686 {ISO week-based calendar 2047-W01-6} {
+    clock format 2430259200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-6
+} {Sat Saturday 47 2047 6 00 01 6 00}
+test clock-3.687 {ISO week-based calendar 2047-W01-7} {
+    clock format 2430345600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W01-7
+} {Sun Sunday 47 2047 7 01 01 0 00}
+test clock-3.688 {ISO week-based calendar 2047-W02-1} {
+    clock format 2430432000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W02-1
+} {Mon Monday 47 2047 1 01 02 1 01}
+test clock-3.689 {ISO week-based calendar 2047-W52-1} {
+    clock format 2460672000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W52-1
+} {Mon Monday 47 2047 1 51 52 1 51}
+test clock-3.690 {ISO week-based calendar 2047-W52-6} {
+    clock format 2461104000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W52-6
+} {Sat Saturday 47 2047 6 51 52 6 51}
+test clock-3.691 {ISO week-based calendar 2047-W52-7} {
+    clock format 2461190400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2047-W52-7
+} {Sun Sunday 47 2047 7 52 52 0 51}
+test clock-3.692 {ISO week-based calendar 2048-W01-1} {
+    clock format 2461276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-1
+} {Mon Monday 48 2048 1 52 01 1 52}
+test clock-3.693 {ISO week-based calendar 2048-W01-3} {
+    clock format 2461449600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-3
+} {Wed Wednesday 48 2048 3 00 01 3 00}
+test clock-3.694 {ISO week-based calendar 2048-W01-6} {
+    clock format 2461708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-6
+} {Sat Saturday 48 2048 6 00 01 6 00}
+test clock-3.695 {ISO week-based calendar 2048-W01-7} {
+    clock format 2461795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W01-7
+} {Sun Sunday 48 2048 7 01 01 0 00}
+test clock-3.696 {ISO week-based calendar 2048-W02-1} {
+    clock format 2461881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W02-1
+} {Mon Monday 48 2048 1 01 02 1 01}
+test clock-3.697 {ISO week-based calendar 2048-W53-1} {
+    clock format 2492726400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-1
+} {Mon Monday 48 2048 1 52 53 1 52}
+test clock-3.698 {ISO week-based calendar 2048-W53-5} {
+    clock format 2493072000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-5
+} {Fri Friday 48 2048 5 00 53 5 00}
+test clock-3.699 {ISO week-based calendar 2048-W53-6} {
+    clock format 2493158400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-6
+} {Sat Saturday 48 2048 6 00 53 6 00}
+test clock-3.700 {ISO week-based calendar 2048-W53-7} {
+    clock format 2493244800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2048-W53-7
+} {Sun Sunday 48 2048 7 01 53 0 00}
+test clock-3.701 {ISO week-based calendar 2049-W01-1} {
+    clock format 2493331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W01-1
+} {Mon Monday 49 2049 1 01 01 1 01}
+test clock-3.702 {ISO week-based calendar 2049-W01-6} {
+    clock format 2493763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W01-6
+} {Sat Saturday 49 2049 6 01 01 6 01}
+test clock-3.703 {ISO week-based calendar 2049-W01-7} {
+    clock format 2493849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W01-7
+} {Sun Sunday 49 2049 7 02 01 0 01}
+test clock-3.704 {ISO week-based calendar 2049-W02-1} {
+    clock format 2493936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2049-W02-1
+} {Mon Monday 49 2049 1 02 02 1 02}
+test clock-3.705 {ISO week-based calendar 2051-W52-1} {
+    clock format 2587075200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2051-W52-1
+} {Mon Monday 51 2051 1 52 52 1 52}
+test clock-3.706 {ISO week-based calendar 2051-W52-6} {
+    clock format 2587507200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2051-W52-6
+} {Sat Saturday 51 2051 6 52 52 6 52}
+test clock-3.707 {ISO week-based calendar 2051-W52-7} {
+    clock format 2587593600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2051-W52-7
+} {Sun Sunday 51 2051 7 53 52 0 52}
+test clock-3.708 {ISO week-based calendar 2052-W01-1} {
+    clock format 2587680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W01-1
+} {Mon Monday 52 2052 1 00 01 1 01}
+test clock-3.709 {ISO week-based calendar 2052-W01-6} {
+    clock format 2588112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W01-6
+} {Sat Saturday 52 2052 6 00 01 6 01}
+test clock-3.710 {ISO week-based calendar 2052-W01-7} {
+    clock format 2588198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W01-7
+} {Sun Sunday 52 2052 7 01 01 0 01}
+test clock-3.711 {ISO week-based calendar 2052-W02-1} {
+    clock format 2588284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W02-1
+} {Mon Monday 52 2052 1 01 02 1 02}
+test clock-3.712 {ISO week-based calendar 2052-W52-1} {
+    clock format 2618524800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W52-1
+} {Mon Monday 52 2052 1 51 52 1 52}
+test clock-3.713 {ISO week-based calendar 2052-W52-6} {
+    clock format 2618956800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W52-6
+} {Sat Saturday 52 2052 6 51 52 6 52}
+test clock-3.714 {ISO week-based calendar 2052-W52-7} {
+    clock format 2619043200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2052-W52-7
+} {Sun Sunday 52 2052 7 52 52 0 52}
+test clock-3.715 {ISO week-based calendar 2053-W01-1} {
+    clock format 2619129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-1
+} {Mon Monday 53 2053 1 52 01 1 53}
+test clock-3.716 {ISO week-based calendar 2053-W01-3} {
+    clock format 2619302400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-3
+} {Wed Wednesday 53 2053 3 00 01 3 00}
+test clock-3.717 {ISO week-based calendar 2053-W01-6} {
+    clock format 2619561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-6
+} {Sat Saturday 53 2053 6 00 01 6 00}
+test clock-3.718 {ISO week-based calendar 2053-W01-7} {
+    clock format 2619648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W01-7
+} {Sun Sunday 53 2053 7 01 01 0 00}
+test clock-3.719 {ISO week-based calendar 2053-W02-1} {
+    clock format 2619734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2053-W02-1
+} {Mon Monday 53 2053 1 01 02 1 01}
+test clock-3.720 {ISO week-based calendar 2055-W52-1} {
+    clock format 2713478400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2055-W52-1
+} {Mon Monday 55 2055 1 52 52 1 52}
+test clock-3.721 {ISO week-based calendar 2055-W52-6} {
+    clock format 2713910400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2055-W52-6
+} {Sat Saturday 55 2055 6 00 52 6 00}
+test clock-3.722 {ISO week-based calendar 2055-W52-7} {
+    clock format 2713996800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2055-W52-7
+} {Sun Sunday 55 2055 7 01 52 0 00}
+test clock-3.723 {ISO week-based calendar 2056-W01-1} {
+    clock format 2714083200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W01-1
+} {Mon Monday 56 2056 1 01 01 1 01}
+test clock-3.724 {ISO week-based calendar 2056-W01-6} {
+    clock format 2714515200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W01-6
+} {Sat Saturday 56 2056 6 01 01 6 01}
+test clock-3.725 {ISO week-based calendar 2056-W01-7} {
+    clock format 2714601600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W01-7
+} {Sun Sunday 56 2056 7 02 01 0 01}
+test clock-3.726 {ISO week-based calendar 2056-W02-1} {
+    clock format 2714688000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W02-1
+} {Mon Monday 56 2056 1 02 02 1 02}
+test clock-3.727 {ISO week-based calendar 2056-W52-1} {
+    clock format 2744928000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W52-1
+} {Mon Monday 56 2056 1 52 52 1 52}
+test clock-3.728 {ISO week-based calendar 2056-W52-6} {
+    clock format 2745360000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W52-6
+} {Sat Saturday 56 2056 6 52 52 6 52}
+test clock-3.729 {ISO week-based calendar 2056-W52-7} {
+    clock format 2745446400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2056-W52-7
+} {Sun Sunday 56 2056 7 53 52 0 52}
+test clock-3.730 {ISO week-based calendar 2057-W01-1} {
+    clock format 2745532800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W01-1
+} {Mon Monday 57 2057 1 00 01 1 01}
+test clock-3.731 {ISO week-based calendar 2057-W01-6} {
+    clock format 2745964800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W01-6
+} {Sat Saturday 57 2057 6 00 01 6 01}
+test clock-3.732 {ISO week-based calendar 2057-W01-7} {
+    clock format 2746051200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W01-7
+} {Sun Sunday 57 2057 7 01 01 0 01}
+test clock-3.733 {ISO week-based calendar 2057-W02-1} {
+    clock format 2746137600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2057-W02-1
+} {Mon Monday 57 2057 1 01 02 1 02}
+test clock-3.734 {ISO week-based calendar 2059-W52-1} {
+    clock format 2839276800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2059-W52-1
+} {Mon Monday 59 2059 1 51 52 1 51}
+test clock-3.735 {ISO week-based calendar 2059-W52-6} {
+    clock format 2839708800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2059-W52-6
+} {Sat Saturday 59 2059 6 51 52 6 51}
+test clock-3.736 {ISO week-based calendar 2059-W52-7} {
+    clock format 2839795200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2059-W52-7
+} {Sun Sunday 59 2059 7 52 52 0 51}
+test clock-3.737 {ISO week-based calendar 2060-W01-1} {
+    clock format 2839881600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-1
+} {Mon Monday 60 2060 1 52 01 1 52}
+test clock-3.738 {ISO week-based calendar 2060-W01-4} {
+    clock format 2840140800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-4
+} {Thu Thursday 60 2060 4 00 01 4 00}
+test clock-3.739 {ISO week-based calendar 2060-W01-6} {
+    clock format 2840313600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-6
+} {Sat Saturday 60 2060 6 00 01 6 00}
+test clock-3.740 {ISO week-based calendar 2060-W01-7} {
+    clock format 2840400000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W01-7
+} {Sun Sunday 60 2060 7 01 01 0 00}
+test clock-3.741 {ISO week-based calendar 2060-W02-1} {
+    clock format 2840486400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W02-1
+} {Mon Monday 60 2060 1 01 02 1 01}
+test clock-3.742 {ISO week-based calendar 2060-W53-1} {
+    clock format 2871331200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W53-1
+} {Mon Monday 60 2060 1 52 53 1 52}
+test clock-3.743 {ISO week-based calendar 2060-W53-6} {
+    clock format 2871763200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W53-6
+} {Sat Saturday 60 2060 6 00 53 6 00}
+test clock-3.744 {ISO week-based calendar 2060-W53-7} {
+    clock format 2871849600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2060-W53-7
+} {Sun Sunday 60 2060 7 01 53 0 00}
+test clock-3.745 {ISO week-based calendar 2061-W01-1} {
+    clock format 2871936000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W01-1
+} {Mon Monday 61 2061 1 01 01 1 01}
+test clock-3.746 {ISO week-based calendar 2061-W01-6} {
+    clock format 2872368000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W01-6
+} {Sat Saturday 61 2061 6 01 01 6 01}
+test clock-3.747 {ISO week-based calendar 2061-W01-7} {
+    clock format 2872454400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W01-7
+} {Sun Sunday 61 2061 7 02 01 0 01}
+test clock-3.748 {ISO week-based calendar 2061-W02-1} {
+    clock format 2872540800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2061-W02-1
+} {Mon Monday 61 2061 1 02 02 1 02}
+test clock-3.749 {ISO week-based calendar 2063-W52-1} {
+    clock format 2965680000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2063-W52-1
+} {Mon Monday 63 2063 1 51 52 1 52}
+test clock-3.750 {ISO week-based calendar 2063-W52-6} {
+    clock format 2966112000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2063-W52-6
+} {Sat Saturday 63 2063 6 51 52 6 52}
+test clock-3.751 {ISO week-based calendar 2063-W52-7} {
+    clock format 2966198400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2063-W52-7
+} {Sun Sunday 63 2063 7 52 52 0 52}
+test clock-3.752 {ISO week-based calendar 2064-W01-1} {
+    clock format 2966284800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-1
+} {Mon Monday 64 2064 1 52 01 1 53}
+test clock-3.753 {ISO week-based calendar 2064-W01-2} {
+    clock format 2966371200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-2
+} {Tue Tuesday 64 2064 2 00 01 2 00}
+test clock-3.754 {ISO week-based calendar 2064-W01-6} {
+    clock format 2966716800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-6
+} {Sat Saturday 64 2064 6 00 01 6 00}
+test clock-3.755 {ISO week-based calendar 2064-W01-7} {
+    clock format 2966803200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W01-7
+} {Sun Sunday 64 2064 7 01 01 0 00}
+test clock-3.756 {ISO week-based calendar 2064-W02-1} {
+    clock format 2966889600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W02-1
+} {Mon Monday 64 2064 1 01 02 1 01}
+test clock-3.757 {ISO week-based calendar 2064-W52-1} {
+    clock format 2997129600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W52-1
+} {Mon Monday 64 2064 1 51 52 1 51}
+test clock-3.758 {ISO week-based calendar 2064-W52-6} {
+    clock format 2997561600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W52-6
+} {Sat Saturday 64 2064 6 51 52 6 51}
+test clock-3.759 {ISO week-based calendar 2064-W52-7} {
+    clock format 2997648000 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2064-W52-7
+} {Sun Sunday 64 2064 7 52 52 0 51}
+test clock-3.760 {ISO week-based calendar 2065-W01-1} {
+    clock format 2997734400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-1
+} {Mon Monday 65 2065 1 52 01 1 52}
+test clock-3.761 {ISO week-based calendar 2065-W01-4} {
+    clock format 2997993600 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-4
+} {Thu Thursday 65 2065 4 00 01 4 00}
+test clock-3.762 {ISO week-based calendar 2065-W01-6} {
+    clock format 2998166400 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-6
+} {Sat Saturday 65 2065 6 00 01 6 00}
+test clock-3.763 {ISO week-based calendar 2065-W01-7} {
+    clock format 2998252800 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W01-7
+} {Sun Sunday 65 2065 7 01 01 0 00}
+test clock-3.764 {ISO week-based calendar 2065-W02-1} {
+    clock format 2998339200 -format {%a %A %g %G %u %U %V %w %W} -gmt true; # 2065-W02-1
+} {Mon Monday 65 2065 1 01 02 1 01}
 # END testcases3
 
 # BEGIN testcases4
@@ -14774,17 +15297,14 @@ test clock-4.96 { format time of day 23:59:59 } {
 
 # Test formatting of Daylight Saving Time
 
-::tcltest::testConstraint detroit 0
 test clock-5.1 {does Detroit exist} {
     clock format 0 -format {} -timezone :America/Detroit
-    ::tcltest::testConstraint detroit 1
     concat
 } {}
 test clock-5.2 {does Detroit have a Y2038 problem} detroit {
     if { [clock format 2158894800 -format %z -timezone :America/Detroit] ne {-0400} } {
         concat {y2038 problem}
     } else {
-        ::tcltest::testConstraint y2038 1
         concat {ok}
     }
 } ok
@@ -15760,2236 +16280,2236 @@ test clock-5.245 {time zone boundary case 2006-10-29 01:00:01} detroit {
     clock format 1162101601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.246 {time zone boundary case 2007-04-01 01:59:59} detroit {
-    clock format 1175410799 -format {%H:%M:%S %z %Z} \
+test clock-5.246 {time zone boundary case 2007-03-11 01:59:59} detroit {
+    clock format 1173596399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.247 {time zone boundary case 2007-04-01 03:00:00} detroit {
-    clock format 1175410800 -format {%H:%M:%S %z %Z} \
+test clock-5.247 {time zone boundary case 2007-03-11 03:00:00} detroit {
+    clock format 1173596400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.248 {time zone boundary case 2007-04-01 03:00:01} detroit {
-    clock format 1175410801 -format {%H:%M:%S %z %Z} \
+test clock-5.248 {time zone boundary case 2007-03-11 03:00:01} detroit {
+    clock format 1173596401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.249 {time zone boundary case 2007-10-28 01:59:59} detroit {
-    clock format 1193551199 -format {%H:%M:%S %z %Z} \
+test clock-5.249 {time zone boundary case 2007-11-04 01:59:59} detroit {
+    clock format 1194155999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.250 {time zone boundary case 2007-10-28 01:00:00} detroit {
-    clock format 1193551200 -format {%H:%M:%S %z %Z} \
+test clock-5.250 {time zone boundary case 2007-11-04 01:00:00} detroit {
+    clock format 1194156000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.251 {time zone boundary case 2007-10-28 01:00:01} detroit {
-    clock format 1193551201 -format {%H:%M:%S %z %Z} \
+test clock-5.251 {time zone boundary case 2007-11-04 01:00:01} detroit {
+    clock format 1194156001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.252 {time zone boundary case 2008-04-06 01:59:59} detroit {
-    clock format 1207465199 -format {%H:%M:%S %z %Z} \
+test clock-5.252 {time zone boundary case 2008-03-09 01:59:59} detroit {
+    clock format 1205045999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.253 {time zone boundary case 2008-04-06 03:00:00} detroit {
-    clock format 1207465200 -format {%H:%M:%S %z %Z} \
+test clock-5.253 {time zone boundary case 2008-03-09 03:00:00} detroit {
+    clock format 1205046000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.254 {time zone boundary case 2008-04-06 03:00:01} detroit {
-    clock format 1207465201 -format {%H:%M:%S %z %Z} \
+test clock-5.254 {time zone boundary case 2008-03-09 03:00:01} detroit {
+    clock format 1205046001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.255 {time zone boundary case 2008-10-26 01:59:59} detroit {
-    clock format 1225000799 -format {%H:%M:%S %z %Z} \
+test clock-5.255 {time zone boundary case 2008-11-02 01:59:59} detroit {
+    clock format 1225605599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.256 {time zone boundary case 2008-10-26 01:00:00} detroit {
-    clock format 1225000800 -format {%H:%M:%S %z %Z} \
+test clock-5.256 {time zone boundary case 2008-11-02 01:00:00} detroit {
+    clock format 1225605600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.257 {time zone boundary case 2008-10-26 01:00:01} detroit {
-    clock format 1225000801 -format {%H:%M:%S %z %Z} \
+test clock-5.257 {time zone boundary case 2008-11-02 01:00:01} detroit {
+    clock format 1225605601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.258 {time zone boundary case 2009-04-05 01:59:59} detroit {
-    clock format 1238914799 -format {%H:%M:%S %z %Z} \
+test clock-5.258 {time zone boundary case 2009-03-08 01:59:59} detroit {
+    clock format 1236495599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.259 {time zone boundary case 2009-04-05 03:00:00} detroit {
-    clock format 1238914800 -format {%H:%M:%S %z %Z} \
+test clock-5.259 {time zone boundary case 2009-03-08 03:00:00} detroit {
+    clock format 1236495600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.260 {time zone boundary case 2009-04-05 03:00:01} detroit {
-    clock format 1238914801 -format {%H:%M:%S %z %Z} \
+test clock-5.260 {time zone boundary case 2009-03-08 03:00:01} detroit {
+    clock format 1236495601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.261 {time zone boundary case 2009-10-25 01:59:59} detroit {
-    clock format 1256450399 -format {%H:%M:%S %z %Z} \
+test clock-5.261 {time zone boundary case 2009-11-01 01:59:59} detroit {
+    clock format 1257055199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.262 {time zone boundary case 2009-10-25 01:00:00} detroit {
-    clock format 1256450400 -format {%H:%M:%S %z %Z} \
+test clock-5.262 {time zone boundary case 2009-11-01 01:00:00} detroit {
+    clock format 1257055200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.263 {time zone boundary case 2009-10-25 01:00:01} detroit {
-    clock format 1256450401 -format {%H:%M:%S %z %Z} \
+test clock-5.263 {time zone boundary case 2009-11-01 01:00:01} detroit {
+    clock format 1257055201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.264 {time zone boundary case 2010-04-04 01:59:59} detroit {
-    clock format 1270364399 -format {%H:%M:%S %z %Z} \
+test clock-5.264 {time zone boundary case 2010-03-14 01:59:59} detroit {
+    clock format 1268549999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.265 {time zone boundary case 2010-04-04 03:00:00} detroit {
-    clock format 1270364400 -format {%H:%M:%S %z %Z} \
+test clock-5.265 {time zone boundary case 2010-03-14 03:00:00} detroit {
+    clock format 1268550000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.266 {time zone boundary case 2010-04-04 03:00:01} detroit {
-    clock format 1270364401 -format {%H:%M:%S %z %Z} \
+test clock-5.266 {time zone boundary case 2010-03-14 03:00:01} detroit {
+    clock format 1268550001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.267 {time zone boundary case 2010-10-31 01:59:59} detroit {
-    clock format 1288504799 -format {%H:%M:%S %z %Z} \
+test clock-5.267 {time zone boundary case 2010-11-07 01:59:59} detroit {
+    clock format 1289109599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.268 {time zone boundary case 2010-10-31 01:00:00} detroit {
-    clock format 1288504800 -format {%H:%M:%S %z %Z} \
+test clock-5.268 {time zone boundary case 2010-11-07 01:00:00} detroit {
+    clock format 1289109600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.269 {time zone boundary case 2010-10-31 01:00:01} detroit {
-    clock format 1288504801 -format {%H:%M:%S %z %Z} \
+test clock-5.269 {time zone boundary case 2010-11-07 01:00:01} detroit {
+    clock format 1289109601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.270 {time zone boundary case 2011-04-03 01:59:59} detroit {
-    clock format 1301813999 -format {%H:%M:%S %z %Z} \
+test clock-5.270 {time zone boundary case 2011-03-13 01:59:59} detroit {
+    clock format 1299999599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.271 {time zone boundary case 2011-04-03 03:00:00} detroit {
-    clock format 1301814000 -format {%H:%M:%S %z %Z} \
+test clock-5.271 {time zone boundary case 2011-03-13 03:00:00} detroit {
+    clock format 1299999600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.272 {time zone boundary case 2011-04-03 03:00:01} detroit {
-    clock format 1301814001 -format {%H:%M:%S %z %Z} \
+test clock-5.272 {time zone boundary case 2011-03-13 03:00:01} detroit {
+    clock format 1299999601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.273 {time zone boundary case 2011-10-30 01:59:59} detroit {
-    clock format 1319954399 -format {%H:%M:%S %z %Z} \
+test clock-5.273 {time zone boundary case 2011-11-06 01:59:59} detroit {
+    clock format 1320559199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.274 {time zone boundary case 2011-10-30 01:00:00} detroit {
-    clock format 1319954400 -format {%H:%M:%S %z %Z} \
+test clock-5.274 {time zone boundary case 2011-11-06 01:00:00} detroit {
+    clock format 1320559200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.275 {time zone boundary case 2011-10-30 01:00:01} detroit {
-    clock format 1319954401 -format {%H:%M:%S %z %Z} \
+test clock-5.275 {time zone boundary case 2011-11-06 01:00:01} detroit {
+    clock format 1320559201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.276 {time zone boundary case 2012-04-01 01:59:59} detroit {
-    clock format 1333263599 -format {%H:%M:%S %z %Z} \
+test clock-5.276 {time zone boundary case 2012-03-11 01:59:59} detroit {
+    clock format 1331449199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.277 {time zone boundary case 2012-04-01 03:00:00} detroit {
-    clock format 1333263600 -format {%H:%M:%S %z %Z} \
+test clock-5.277 {time zone boundary case 2012-03-11 03:00:00} detroit {
+    clock format 1331449200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.278 {time zone boundary case 2012-04-01 03:00:01} detroit {
-    clock format 1333263601 -format {%H:%M:%S %z %Z} \
+test clock-5.278 {time zone boundary case 2012-03-11 03:00:01} detroit {
+    clock format 1331449201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.279 {time zone boundary case 2012-10-28 01:59:59} detroit {
-    clock format 1351403999 -format {%H:%M:%S %z %Z} \
+test clock-5.279 {time zone boundary case 2012-11-04 01:59:59} detroit {
+    clock format 1352008799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.280 {time zone boundary case 2012-10-28 01:00:00} detroit {
-    clock format 1351404000 -format {%H:%M:%S %z %Z} \
+test clock-5.280 {time zone boundary case 2012-11-04 01:00:00} detroit {
+    clock format 1352008800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.281 {time zone boundary case 2012-10-28 01:00:01} detroit {
-    clock format 1351404001 -format {%H:%M:%S %z %Z} \
+test clock-5.281 {time zone boundary case 2012-11-04 01:00:01} detroit {
+    clock format 1352008801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.282 {time zone boundary case 2013-04-07 01:59:59} detroit {
-    clock format 1365317999 -format {%H:%M:%S %z %Z} \
+test clock-5.282 {time zone boundary case 2013-03-10 01:59:59} detroit {
+    clock format 1362898799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.283 {time zone boundary case 2013-04-07 03:00:00} detroit {
-    clock format 1365318000 -format {%H:%M:%S %z %Z} \
+test clock-5.283 {time zone boundary case 2013-03-10 03:00:00} detroit {
+    clock format 1362898800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.284 {time zone boundary case 2013-04-07 03:00:01} detroit {
-    clock format 1365318001 -format {%H:%M:%S %z %Z} \
+test clock-5.284 {time zone boundary case 2013-03-10 03:00:01} detroit {
+    clock format 1362898801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.285 {time zone boundary case 2013-10-27 01:59:59} detroit {
-    clock format 1382853599 -format {%H:%M:%S %z %Z} \
+test clock-5.285 {time zone boundary case 2013-11-03 01:59:59} detroit {
+    clock format 1383458399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.286 {time zone boundary case 2013-10-27 01:00:00} detroit {
-    clock format 1382853600 -format {%H:%M:%S %z %Z} \
+test clock-5.286 {time zone boundary case 2013-11-03 01:00:00} detroit {
+    clock format 1383458400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.287 {time zone boundary case 2013-10-27 01:00:01} detroit {
-    clock format 1382853601 -format {%H:%M:%S %z %Z} \
+test clock-5.287 {time zone boundary case 2013-11-03 01:00:01} detroit {
+    clock format 1383458401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.288 {time zone boundary case 2014-04-06 01:59:59} detroit {
-    clock format 1396767599 -format {%H:%M:%S %z %Z} \
+test clock-5.288 {time zone boundary case 2014-03-09 01:59:59} detroit {
+    clock format 1394348399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.289 {time zone boundary case 2014-04-06 03:00:00} detroit {
-    clock format 1396767600 -format {%H:%M:%S %z %Z} \
+test clock-5.289 {time zone boundary case 2014-03-09 03:00:00} detroit {
+    clock format 1394348400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.290 {time zone boundary case 2014-04-06 03:00:01} detroit {
-    clock format 1396767601 -format {%H:%M:%S %z %Z} \
+test clock-5.290 {time zone boundary case 2014-03-09 03:00:01} detroit {
+    clock format 1394348401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.291 {time zone boundary case 2014-10-26 01:59:59} detroit {
-    clock format 1414303199 -format {%H:%M:%S %z %Z} \
+test clock-5.291 {time zone boundary case 2014-11-02 01:59:59} detroit {
+    clock format 1414907999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.292 {time zone boundary case 2014-10-26 01:00:00} detroit {
-    clock format 1414303200 -format {%H:%M:%S %z %Z} \
+test clock-5.292 {time zone boundary case 2014-11-02 01:00:00} detroit {
+    clock format 1414908000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.293 {time zone boundary case 2014-10-26 01:00:01} detroit {
-    clock format 1414303201 -format {%H:%M:%S %z %Z} \
+test clock-5.293 {time zone boundary case 2014-11-02 01:00:01} detroit {
+    clock format 1414908001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.294 {time zone boundary case 2015-04-05 01:59:59} detroit {
-    clock format 1428217199 -format {%H:%M:%S %z %Z} \
+test clock-5.294 {time zone boundary case 2015-03-08 01:59:59} detroit {
+    clock format 1425797999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.295 {time zone boundary case 2015-04-05 03:00:00} detroit {
-    clock format 1428217200 -format {%H:%M:%S %z %Z} \
+test clock-5.295 {time zone boundary case 2015-03-08 03:00:00} detroit {
+    clock format 1425798000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.296 {time zone boundary case 2015-04-05 03:00:01} detroit {
-    clock format 1428217201 -format {%H:%M:%S %z %Z} \
+test clock-5.296 {time zone boundary case 2015-03-08 03:00:01} detroit {
+    clock format 1425798001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.297 {time zone boundary case 2015-10-25 01:59:59} detroit {
-    clock format 1445752799 -format {%H:%M:%S %z %Z} \
+test clock-5.297 {time zone boundary case 2015-11-01 01:59:59} detroit {
+    clock format 1446357599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.298 {time zone boundary case 2015-10-25 01:00:00} detroit {
-    clock format 1445752800 -format {%H:%M:%S %z %Z} \
+test clock-5.298 {time zone boundary case 2015-11-01 01:00:00} detroit {
+    clock format 1446357600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.299 {time zone boundary case 2015-10-25 01:00:01} detroit {
-    clock format 1445752801 -format {%H:%M:%S %z %Z} \
+test clock-5.299 {time zone boundary case 2015-11-01 01:00:01} detroit {
+    clock format 1446357601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.300 {time zone boundary case 2016-04-03 01:59:59} detroit {
-    clock format 1459666799 -format {%H:%M:%S %z %Z} \
+test clock-5.300 {time zone boundary case 2016-03-13 01:59:59} detroit {
+    clock format 1457852399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.301 {time zone boundary case 2016-04-03 03:00:00} detroit {
-    clock format 1459666800 -format {%H:%M:%S %z %Z} \
+test clock-5.301 {time zone boundary case 2016-03-13 03:00:00} detroit {
+    clock format 1457852400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.302 {time zone boundary case 2016-04-03 03:00:01} detroit {
-    clock format 1459666801 -format {%H:%M:%S %z %Z} \
+test clock-5.302 {time zone boundary case 2016-03-13 03:00:01} detroit {
+    clock format 1457852401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.303 {time zone boundary case 2016-10-30 01:59:59} detroit {
-    clock format 1477807199 -format {%H:%M:%S %z %Z} \
+test clock-5.303 {time zone boundary case 2016-11-06 01:59:59} detroit {
+    clock format 1478411999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.304 {time zone boundary case 2016-10-30 01:00:00} detroit {
-    clock format 1477807200 -format {%H:%M:%S %z %Z} \
+test clock-5.304 {time zone boundary case 2016-11-06 01:00:00} detroit {
+    clock format 1478412000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.305 {time zone boundary case 2016-10-30 01:00:01} detroit {
-    clock format 1477807201 -format {%H:%M:%S %z %Z} \
+test clock-5.305 {time zone boundary case 2016-11-06 01:00:01} detroit {
+    clock format 1478412001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.306 {time zone boundary case 2017-04-02 01:59:59} detroit {
-    clock format 1491116399 -format {%H:%M:%S %z %Z} \
+test clock-5.306 {time zone boundary case 2017-03-12 01:59:59} detroit {
+    clock format 1489301999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.307 {time zone boundary case 2017-04-02 03:00:00} detroit {
-    clock format 1491116400 -format {%H:%M:%S %z %Z} \
+test clock-5.307 {time zone boundary case 2017-03-12 03:00:00} detroit {
+    clock format 1489302000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.308 {time zone boundary case 2017-04-02 03:00:01} detroit {
-    clock format 1491116401 -format {%H:%M:%S %z %Z} \
+test clock-5.308 {time zone boundary case 2017-03-12 03:00:01} detroit {
+    clock format 1489302001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.309 {time zone boundary case 2017-10-29 01:59:59} detroit {
-    clock format 1509256799 -format {%H:%M:%S %z %Z} \
+test clock-5.309 {time zone boundary case 2017-11-05 01:59:59} detroit {
+    clock format 1509861599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.310 {time zone boundary case 2017-10-29 01:00:00} detroit {
-    clock format 1509256800 -format {%H:%M:%S %z %Z} \
+test clock-5.310 {time zone boundary case 2017-11-05 01:00:00} detroit {
+    clock format 1509861600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.311 {time zone boundary case 2017-10-29 01:00:01} detroit {
-    clock format 1509256801 -format {%H:%M:%S %z %Z} \
+test clock-5.311 {time zone boundary case 2017-11-05 01:00:01} detroit {
+    clock format 1509861601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.312 {time zone boundary case 2018-04-01 01:59:59} detroit {
-    clock format 1522565999 -format {%H:%M:%S %z %Z} \
+test clock-5.312 {time zone boundary case 2018-03-11 01:59:59} detroit {
+    clock format 1520751599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.313 {time zone boundary case 2018-04-01 03:00:00} detroit {
-    clock format 1522566000 -format {%H:%M:%S %z %Z} \
+test clock-5.313 {time zone boundary case 2018-03-11 03:00:00} detroit {
+    clock format 1520751600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.314 {time zone boundary case 2018-04-01 03:00:01} detroit {
-    clock format 1522566001 -format {%H:%M:%S %z %Z} \
+test clock-5.314 {time zone boundary case 2018-03-11 03:00:01} detroit {
+    clock format 1520751601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.315 {time zone boundary case 2018-10-28 01:59:59} detroit {
-    clock format 1540706399 -format {%H:%M:%S %z %Z} \
+test clock-5.315 {time zone boundary case 2018-11-04 01:59:59} detroit {
+    clock format 1541311199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.316 {time zone boundary case 2018-10-28 01:00:00} detroit {
-    clock format 1540706400 -format {%H:%M:%S %z %Z} \
+test clock-5.316 {time zone boundary case 2018-11-04 01:00:00} detroit {
+    clock format 1541311200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.317 {time zone boundary case 2018-10-28 01:00:01} detroit {
-    clock format 1540706401 -format {%H:%M:%S %z %Z} \
+test clock-5.317 {time zone boundary case 2018-11-04 01:00:01} detroit {
+    clock format 1541311201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.318 {time zone boundary case 2019-04-07 01:59:59} detroit {
-    clock format 1554620399 -format {%H:%M:%S %z %Z} \
+test clock-5.318 {time zone boundary case 2019-03-10 01:59:59} detroit {
+    clock format 1552201199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.319 {time zone boundary case 2019-04-07 03:00:00} detroit {
-    clock format 1554620400 -format {%H:%M:%S %z %Z} \
+test clock-5.319 {time zone boundary case 2019-03-10 03:00:00} detroit {
+    clock format 1552201200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.320 {time zone boundary case 2019-04-07 03:00:01} detroit {
-    clock format 1554620401 -format {%H:%M:%S %z %Z} \
+test clock-5.320 {time zone boundary case 2019-03-10 03:00:01} detroit {
+    clock format 1552201201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.321 {time zone boundary case 2019-10-27 01:59:59} detroit {
-    clock format 1572155999 -format {%H:%M:%S %z %Z} \
+test clock-5.321 {time zone boundary case 2019-11-03 01:59:59} detroit {
+    clock format 1572760799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.322 {time zone boundary case 2019-10-27 01:00:00} detroit {
-    clock format 1572156000 -format {%H:%M:%S %z %Z} \
+test clock-5.322 {time zone boundary case 2019-11-03 01:00:00} detroit {
+    clock format 1572760800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.323 {time zone boundary case 2019-10-27 01:00:01} detroit {
-    clock format 1572156001 -format {%H:%M:%S %z %Z} \
+test clock-5.323 {time zone boundary case 2019-11-03 01:00:01} detroit {
+    clock format 1572760801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.324 {time zone boundary case 2020-04-05 01:59:59} detroit {
-    clock format 1586069999 -format {%H:%M:%S %z %Z} \
+test clock-5.324 {time zone boundary case 2020-03-08 01:59:59} detroit {
+    clock format 1583650799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.325 {time zone boundary case 2020-04-05 03:00:00} detroit {
-    clock format 1586070000 -format {%H:%M:%S %z %Z} \
+test clock-5.325 {time zone boundary case 2020-03-08 03:00:00} detroit {
+    clock format 1583650800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.326 {time zone boundary case 2020-04-05 03:00:01} detroit {
-    clock format 1586070001 -format {%H:%M:%S %z %Z} \
+test clock-5.326 {time zone boundary case 2020-03-08 03:00:01} detroit {
+    clock format 1583650801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.327 {time zone boundary case 2020-10-25 01:59:59} detroit {
-    clock format 1603605599 -format {%H:%M:%S %z %Z} \
+test clock-5.327 {time zone boundary case 2020-11-01 01:59:59} detroit {
+    clock format 1604210399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.328 {time zone boundary case 2020-10-25 01:00:00} detroit {
-    clock format 1603605600 -format {%H:%M:%S %z %Z} \
+test clock-5.328 {time zone boundary case 2020-11-01 01:00:00} detroit {
+    clock format 1604210400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.329 {time zone boundary case 2020-10-25 01:00:01} detroit {
-    clock format 1603605601 -format {%H:%M:%S %z %Z} \
+test clock-5.329 {time zone boundary case 2020-11-01 01:00:01} detroit {
+    clock format 1604210401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.330 {time zone boundary case 2021-04-04 01:59:59} detroit {
-    clock format 1617519599 -format {%H:%M:%S %z %Z} \
+test clock-5.330 {time zone boundary case 2021-03-14 01:59:59} detroit {
+    clock format 1615705199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.331 {time zone boundary case 2021-04-04 03:00:00} detroit {
-    clock format 1617519600 -format {%H:%M:%S %z %Z} \
+test clock-5.331 {time zone boundary case 2021-03-14 03:00:00} detroit {
+    clock format 1615705200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.332 {time zone boundary case 2021-04-04 03:00:01} detroit {
-    clock format 1617519601 -format {%H:%M:%S %z %Z} \
+test clock-5.332 {time zone boundary case 2021-03-14 03:00:01} detroit {
+    clock format 1615705201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.333 {time zone boundary case 2021-10-31 01:59:59} detroit {
-    clock format 1635659999 -format {%H:%M:%S %z %Z} \
+test clock-5.333 {time zone boundary case 2021-11-07 01:59:59} detroit {
+    clock format 1636264799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.334 {time zone boundary case 2021-10-31 01:00:00} detroit {
-    clock format 1635660000 -format {%H:%M:%S %z %Z} \
+test clock-5.334 {time zone boundary case 2021-11-07 01:00:00} detroit {
+    clock format 1636264800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.335 {time zone boundary case 2021-10-31 01:00:01} detroit {
-    clock format 1635660001 -format {%H:%M:%S %z %Z} \
+test clock-5.335 {time zone boundary case 2021-11-07 01:00:01} detroit {
+    clock format 1636264801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.336 {time zone boundary case 2022-04-03 01:59:59} detroit {
-    clock format 1648969199 -format {%H:%M:%S %z %Z} \
+test clock-5.336 {time zone boundary case 2022-03-13 01:59:59} detroit {
+    clock format 1647154799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.337 {time zone boundary case 2022-04-03 03:00:00} detroit {
-    clock format 1648969200 -format {%H:%M:%S %z %Z} \
+test clock-5.337 {time zone boundary case 2022-03-13 03:00:00} detroit {
+    clock format 1647154800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.338 {time zone boundary case 2022-04-03 03:00:01} detroit {
-    clock format 1648969201 -format {%H:%M:%S %z %Z} \
+test clock-5.338 {time zone boundary case 2022-03-13 03:00:01} detroit {
+    clock format 1647154801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.339 {time zone boundary case 2022-10-30 01:59:59} detroit {
-    clock format 1667109599 -format {%H:%M:%S %z %Z} \
+test clock-5.339 {time zone boundary case 2022-11-06 01:59:59} detroit {
+    clock format 1667714399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.340 {time zone boundary case 2022-10-30 01:00:00} detroit {
-    clock format 1667109600 -format {%H:%M:%S %z %Z} \
+test clock-5.340 {time zone boundary case 2022-11-06 01:00:00} detroit {
+    clock format 1667714400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.341 {time zone boundary case 2022-10-30 01:00:01} detroit {
-    clock format 1667109601 -format {%H:%M:%S %z %Z} \
+test clock-5.341 {time zone boundary case 2022-11-06 01:00:01} detroit {
+    clock format 1667714401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.342 {time zone boundary case 2023-04-02 01:59:59} detroit {
-    clock format 1680418799 -format {%H:%M:%S %z %Z} \
+test clock-5.342 {time zone boundary case 2023-03-12 01:59:59} detroit {
+    clock format 1678604399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.343 {time zone boundary case 2023-04-02 03:00:00} detroit {
-    clock format 1680418800 -format {%H:%M:%S %z %Z} \
+test clock-5.343 {time zone boundary case 2023-03-12 03:00:00} detroit {
+    clock format 1678604400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.344 {time zone boundary case 2023-04-02 03:00:01} detroit {
-    clock format 1680418801 -format {%H:%M:%S %z %Z} \
+test clock-5.344 {time zone boundary case 2023-03-12 03:00:01} detroit {
+    clock format 1678604401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.345 {time zone boundary case 2023-10-29 01:59:59} detroit {
-    clock format 1698559199 -format {%H:%M:%S %z %Z} \
+test clock-5.345 {time zone boundary case 2023-11-05 01:59:59} detroit {
+    clock format 1699163999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.346 {time zone boundary case 2023-10-29 01:00:00} detroit {
-    clock format 1698559200 -format {%H:%M:%S %z %Z} \
+test clock-5.346 {time zone boundary case 2023-11-05 01:00:00} detroit {
+    clock format 1699164000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.347 {time zone boundary case 2023-10-29 01:00:01} detroit {
-    clock format 1698559201 -format {%H:%M:%S %z %Z} \
+test clock-5.347 {time zone boundary case 2023-11-05 01:00:01} detroit {
+    clock format 1699164001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.348 {time zone boundary case 2024-04-07 01:59:59} detroit {
-    clock format 1712473199 -format {%H:%M:%S %z %Z} \
+test clock-5.348 {time zone boundary case 2024-03-10 01:59:59} detroit {
+    clock format 1710053999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.349 {time zone boundary case 2024-04-07 03:00:00} detroit {
-    clock format 1712473200 -format {%H:%M:%S %z %Z} \
+test clock-5.349 {time zone boundary case 2024-03-10 03:00:00} detroit {
+    clock format 1710054000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.350 {time zone boundary case 2024-04-07 03:00:01} detroit {
-    clock format 1712473201 -format {%H:%M:%S %z %Z} \
+test clock-5.350 {time zone boundary case 2024-03-10 03:00:01} detroit {
+    clock format 1710054001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.351 {time zone boundary case 2024-10-27 01:59:59} detroit {
-    clock format 1730008799 -format {%H:%M:%S %z %Z} \
+test clock-5.351 {time zone boundary case 2024-11-03 01:59:59} detroit {
+    clock format 1730613599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.352 {time zone boundary case 2024-10-27 01:00:00} detroit {
-    clock format 1730008800 -format {%H:%M:%S %z %Z} \
+test clock-5.352 {time zone boundary case 2024-11-03 01:00:00} detroit {
+    clock format 1730613600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.353 {time zone boundary case 2024-10-27 01:00:01} detroit {
-    clock format 1730008801 -format {%H:%M:%S %z %Z} \
+test clock-5.353 {time zone boundary case 2024-11-03 01:00:01} detroit {
+    clock format 1730613601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.354 {time zone boundary case 2025-04-06 01:59:59} detroit {
-    clock format 1743922799 -format {%H:%M:%S %z %Z} \
+test clock-5.354 {time zone boundary case 2025-03-09 01:59:59} detroit {
+    clock format 1741503599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.355 {time zone boundary case 2025-04-06 03:00:00} detroit {
-    clock format 1743922800 -format {%H:%M:%S %z %Z} \
+test clock-5.355 {time zone boundary case 2025-03-09 03:00:00} detroit {
+    clock format 1741503600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.356 {time zone boundary case 2025-04-06 03:00:01} detroit {
-    clock format 1743922801 -format {%H:%M:%S %z %Z} \
+test clock-5.356 {time zone boundary case 2025-03-09 03:00:01} detroit {
+    clock format 1741503601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.357 {time zone boundary case 2025-10-26 01:59:59} detroit {
-    clock format 1761458399 -format {%H:%M:%S %z %Z} \
+test clock-5.357 {time zone boundary case 2025-11-02 01:59:59} detroit {
+    clock format 1762063199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.358 {time zone boundary case 2025-10-26 01:00:00} detroit {
-    clock format 1761458400 -format {%H:%M:%S %z %Z} \
+test clock-5.358 {time zone boundary case 2025-11-02 01:00:00} detroit {
+    clock format 1762063200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.359 {time zone boundary case 2025-10-26 01:00:01} detroit {
-    clock format 1761458401 -format {%H:%M:%S %z %Z} \
+test clock-5.359 {time zone boundary case 2025-11-02 01:00:01} detroit {
+    clock format 1762063201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.360 {time zone boundary case 2026-04-05 01:59:59} detroit {
-    clock format 1775372399 -format {%H:%M:%S %z %Z} \
+test clock-5.360 {time zone boundary case 2026-03-08 01:59:59} detroit {
+    clock format 1772953199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.361 {time zone boundary case 2026-04-05 03:00:00} detroit {
-    clock format 1775372400 -format {%H:%M:%S %z %Z} \
+test clock-5.361 {time zone boundary case 2026-03-08 03:00:00} detroit {
+    clock format 1772953200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.362 {time zone boundary case 2026-04-05 03:00:01} detroit {
-    clock format 1775372401 -format {%H:%M:%S %z %Z} \
+test clock-5.362 {time zone boundary case 2026-03-08 03:00:01} detroit {
+    clock format 1772953201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.363 {time zone boundary case 2026-10-25 01:59:59} detroit {
-    clock format 1792907999 -format {%H:%M:%S %z %Z} \
+test clock-5.363 {time zone boundary case 2026-11-01 01:59:59} detroit {
+    clock format 1793512799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.364 {time zone boundary case 2026-10-25 01:00:00} detroit {
-    clock format 1792908000 -format {%H:%M:%S %z %Z} \
+test clock-5.364 {time zone boundary case 2026-11-01 01:00:00} detroit {
+    clock format 1793512800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.365 {time zone boundary case 2026-10-25 01:00:01} detroit {
-    clock format 1792908001 -format {%H:%M:%S %z %Z} \
+test clock-5.365 {time zone boundary case 2026-11-01 01:00:01} detroit {
+    clock format 1793512801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.366 {time zone boundary case 2027-04-04 01:59:59} detroit {
-    clock format 1806821999 -format {%H:%M:%S %z %Z} \
+test clock-5.366 {time zone boundary case 2027-03-14 01:59:59} detroit {
+    clock format 1805007599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.367 {time zone boundary case 2027-04-04 03:00:00} detroit {
-    clock format 1806822000 -format {%H:%M:%S %z %Z} \
+test clock-5.367 {time zone boundary case 2027-03-14 03:00:00} detroit {
+    clock format 1805007600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.368 {time zone boundary case 2027-04-04 03:00:01} detroit {
-    clock format 1806822001 -format {%H:%M:%S %z %Z} \
+test clock-5.368 {time zone boundary case 2027-03-14 03:00:01} detroit {
+    clock format 1805007601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.369 {time zone boundary case 2027-10-31 01:59:59} detroit {
-    clock format 1824962399 -format {%H:%M:%S %z %Z} \
+test clock-5.369 {time zone boundary case 2027-11-07 01:59:59} detroit {
+    clock format 1825567199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.370 {time zone boundary case 2027-10-31 01:00:00} detroit {
-    clock format 1824962400 -format {%H:%M:%S %z %Z} \
+test clock-5.370 {time zone boundary case 2027-11-07 01:00:00} detroit {
+    clock format 1825567200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.371 {time zone boundary case 2027-10-31 01:00:01} detroit {
-    clock format 1824962401 -format {%H:%M:%S %z %Z} \
+test clock-5.371 {time zone boundary case 2027-11-07 01:00:01} detroit {
+    clock format 1825567201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.372 {time zone boundary case 2028-04-02 01:59:59} detroit {
-    clock format 1838271599 -format {%H:%M:%S %z %Z} \
+test clock-5.372 {time zone boundary case 2028-03-12 01:59:59} detroit {
+    clock format 1836457199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.373 {time zone boundary case 2028-04-02 03:00:00} detroit {
-    clock format 1838271600 -format {%H:%M:%S %z %Z} \
+test clock-5.373 {time zone boundary case 2028-03-12 03:00:00} detroit {
+    clock format 1836457200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.374 {time zone boundary case 2028-04-02 03:00:01} detroit {
-    clock format 1838271601 -format {%H:%M:%S %z %Z} \
+test clock-5.374 {time zone boundary case 2028-03-12 03:00:01} detroit {
+    clock format 1836457201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.375 {time zone boundary case 2028-10-29 01:59:59} detroit {
-    clock format 1856411999 -format {%H:%M:%S %z %Z} \
+test clock-5.375 {time zone boundary case 2028-11-05 01:59:59} detroit {
+    clock format 1857016799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.376 {time zone boundary case 2028-10-29 01:00:00} detroit {
-    clock format 1856412000 -format {%H:%M:%S %z %Z} \
+test clock-5.376 {time zone boundary case 2028-11-05 01:00:00} detroit {
+    clock format 1857016800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.377 {time zone boundary case 2028-10-29 01:00:01} detroit {
-    clock format 1856412001 -format {%H:%M:%S %z %Z} \
+test clock-5.377 {time zone boundary case 2028-11-05 01:00:01} detroit {
+    clock format 1857016801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.378 {time zone boundary case 2029-04-01 01:59:59} detroit {
-    clock format 1869721199 -format {%H:%M:%S %z %Z} \
+test clock-5.378 {time zone boundary case 2029-03-11 01:59:59} detroit {
+    clock format 1867906799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.379 {time zone boundary case 2029-04-01 03:00:00} detroit {
-    clock format 1869721200 -format {%H:%M:%S %z %Z} \
+test clock-5.379 {time zone boundary case 2029-03-11 03:00:00} detroit {
+    clock format 1867906800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.380 {time zone boundary case 2029-04-01 03:00:01} detroit {
-    clock format 1869721201 -format {%H:%M:%S %z %Z} \
+test clock-5.380 {time zone boundary case 2029-03-11 03:00:01} detroit {
+    clock format 1867906801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.381 {time zone boundary case 2029-10-28 01:59:59} detroit {
-    clock format 1887861599 -format {%H:%M:%S %z %Z} \
+test clock-5.381 {time zone boundary case 2029-11-04 01:59:59} detroit {
+    clock format 1888466399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.382 {time zone boundary case 2029-10-28 01:00:00} detroit {
-    clock format 1887861600 -format {%H:%M:%S %z %Z} \
+test clock-5.382 {time zone boundary case 2029-11-04 01:00:00} detroit {
+    clock format 1888466400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.383 {time zone boundary case 2029-10-28 01:00:01} detroit {
-    clock format 1887861601 -format {%H:%M:%S %z %Z} \
+test clock-5.383 {time zone boundary case 2029-11-04 01:00:01} detroit {
+    clock format 1888466401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.384 {time zone boundary case 2030-04-07 01:59:59} detroit {
-    clock format 1901775599 -format {%H:%M:%S %z %Z} \
+test clock-5.384 {time zone boundary case 2030-03-10 01:59:59} detroit {
+    clock format 1899356399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.385 {time zone boundary case 2030-04-07 03:00:00} detroit {
-    clock format 1901775600 -format {%H:%M:%S %z %Z} \
+test clock-5.385 {time zone boundary case 2030-03-10 03:00:00} detroit {
+    clock format 1899356400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.386 {time zone boundary case 2030-04-07 03:00:01} detroit {
-    clock format 1901775601 -format {%H:%M:%S %z %Z} \
+test clock-5.386 {time zone boundary case 2030-03-10 03:00:01} detroit {
+    clock format 1899356401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.387 {time zone boundary case 2030-10-27 01:59:59} detroit {
-    clock format 1919311199 -format {%H:%M:%S %z %Z} \
+test clock-5.387 {time zone boundary case 2030-11-03 01:59:59} detroit {
+    clock format 1919915999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.388 {time zone boundary case 2030-10-27 01:00:00} detroit {
-    clock format 1919311200 -format {%H:%M:%S %z %Z} \
+test clock-5.388 {time zone boundary case 2030-11-03 01:00:00} detroit {
+    clock format 1919916000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.389 {time zone boundary case 2030-10-27 01:00:01} detroit {
-    clock format 1919311201 -format {%H:%M:%S %z %Z} \
+test clock-5.389 {time zone boundary case 2030-11-03 01:00:01} detroit {
+    clock format 1919916001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.390 {time zone boundary case 2031-04-06 01:59:59} detroit {
-    clock format 1933225199 -format {%H:%M:%S %z %Z} \
+test clock-5.390 {time zone boundary case 2031-03-09 01:59:59} detroit {
+    clock format 1930805999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.391 {time zone boundary case 2031-04-06 03:00:00} detroit {
-    clock format 1933225200 -format {%H:%M:%S %z %Z} \
+test clock-5.391 {time zone boundary case 2031-03-09 03:00:00} detroit {
+    clock format 1930806000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.392 {time zone boundary case 2031-04-06 03:00:01} detroit {
-    clock format 1933225201 -format {%H:%M:%S %z %Z} \
+test clock-5.392 {time zone boundary case 2031-03-09 03:00:01} detroit {
+    clock format 1930806001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.393 {time zone boundary case 2031-10-26 01:59:59} detroit {
-    clock format 1950760799 -format {%H:%M:%S %z %Z} \
+test clock-5.393 {time zone boundary case 2031-11-02 01:59:59} detroit {
+    clock format 1951365599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.394 {time zone boundary case 2031-10-26 01:00:00} detroit {
-    clock format 1950760800 -format {%H:%M:%S %z %Z} \
+test clock-5.394 {time zone boundary case 2031-11-02 01:00:00} detroit {
+    clock format 1951365600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.395 {time zone boundary case 2031-10-26 01:00:01} detroit {
-    clock format 1950760801 -format {%H:%M:%S %z %Z} \
+test clock-5.395 {time zone boundary case 2031-11-02 01:00:01} detroit {
+    clock format 1951365601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.396 {time zone boundary case 2032-04-04 01:59:59} detroit {
-    clock format 1964674799 -format {%H:%M:%S %z %Z} \
+test clock-5.396 {time zone boundary case 2032-03-14 01:59:59} detroit {
+    clock format 1962860399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.397 {time zone boundary case 2032-04-04 03:00:00} detroit {
-    clock format 1964674800 -format {%H:%M:%S %z %Z} \
+test clock-5.397 {time zone boundary case 2032-03-14 03:00:00} detroit {
+    clock format 1962860400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.398 {time zone boundary case 2032-04-04 03:00:01} detroit {
-    clock format 1964674801 -format {%H:%M:%S %z %Z} \
+test clock-5.398 {time zone boundary case 2032-03-14 03:00:01} detroit {
+    clock format 1962860401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.399 {time zone boundary case 2032-10-31 01:59:59} detroit {
-    clock format 1982815199 -format {%H:%M:%S %z %Z} \
+test clock-5.399 {time zone boundary case 2032-11-07 01:59:59} detroit {
+    clock format 1983419999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.400 {time zone boundary case 2032-10-31 01:00:00} detroit {
-    clock format 1982815200 -format {%H:%M:%S %z %Z} \
+test clock-5.400 {time zone boundary case 2032-11-07 01:00:00} detroit {
+    clock format 1983420000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.401 {time zone boundary case 2032-10-31 01:00:01} detroit {
-    clock format 1982815201 -format {%H:%M:%S %z %Z} \
+test clock-5.401 {time zone boundary case 2032-11-07 01:00:01} detroit {
+    clock format 1983420001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.402 {time zone boundary case 2033-04-03 01:59:59} detroit {
-    clock format 1996124399 -format {%H:%M:%S %z %Z} \
+test clock-5.402 {time zone boundary case 2033-03-13 01:59:59} detroit {
+    clock format 1994309999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.403 {time zone boundary case 2033-04-03 03:00:00} detroit {
-    clock format 1996124400 -format {%H:%M:%S %z %Z} \
+test clock-5.403 {time zone boundary case 2033-03-13 03:00:00} detroit {
+    clock format 1994310000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.404 {time zone boundary case 2033-04-03 03:00:01} detroit {
-    clock format 1996124401 -format {%H:%M:%S %z %Z} \
+test clock-5.404 {time zone boundary case 2033-03-13 03:00:01} detroit {
+    clock format 1994310001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.405 {time zone boundary case 2033-10-30 01:59:59} detroit {
-    clock format 2014264799 -format {%H:%M:%S %z %Z} \
+test clock-5.405 {time zone boundary case 2033-11-06 01:59:59} detroit {
+    clock format 2014869599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.406 {time zone boundary case 2033-10-30 01:00:00} detroit {
-    clock format 2014264800 -format {%H:%M:%S %z %Z} \
+test clock-5.406 {time zone boundary case 2033-11-06 01:00:00} detroit {
+    clock format 2014869600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.407 {time zone boundary case 2033-10-30 01:00:01} detroit {
-    clock format 2014264801 -format {%H:%M:%S %z %Z} \
+test clock-5.407 {time zone boundary case 2033-11-06 01:00:01} detroit {
+    clock format 2014869601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.408 {time zone boundary case 2034-04-02 01:59:59} detroit {
-    clock format 2027573999 -format {%H:%M:%S %z %Z} \
+test clock-5.408 {time zone boundary case 2034-03-12 01:59:59} detroit {
+    clock format 2025759599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.409 {time zone boundary case 2034-04-02 03:00:00} detroit {
-    clock format 2027574000 -format {%H:%M:%S %z %Z} \
+test clock-5.409 {time zone boundary case 2034-03-12 03:00:00} detroit {
+    clock format 2025759600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.410 {time zone boundary case 2034-04-02 03:00:01} detroit {
-    clock format 2027574001 -format {%H:%M:%S %z %Z} \
+test clock-5.410 {time zone boundary case 2034-03-12 03:00:01} detroit {
+    clock format 2025759601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.411 {time zone boundary case 2034-10-29 01:59:59} detroit {
-    clock format 2045714399 -format {%H:%M:%S %z %Z} \
+test clock-5.411 {time zone boundary case 2034-11-05 01:59:59} detroit {
+    clock format 2046319199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.412 {time zone boundary case 2034-10-29 01:00:00} detroit {
-    clock format 2045714400 -format {%H:%M:%S %z %Z} \
+test clock-5.412 {time zone boundary case 2034-11-05 01:00:00} detroit {
+    clock format 2046319200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.413 {time zone boundary case 2034-10-29 01:00:01} detroit {
-    clock format 2045714401 -format {%H:%M:%S %z %Z} \
+test clock-5.413 {time zone boundary case 2034-11-05 01:00:01} detroit {
+    clock format 2046319201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.414 {time zone boundary case 2035-04-01 01:59:59} detroit {
-    clock format 2059023599 -format {%H:%M:%S %z %Z} \
+test clock-5.414 {time zone boundary case 2035-03-11 01:59:59} detroit {
+    clock format 2057209199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.415 {time zone boundary case 2035-04-01 03:00:00} detroit {
-    clock format 2059023600 -format {%H:%M:%S %z %Z} \
+test clock-5.415 {time zone boundary case 2035-03-11 03:00:00} detroit {
+    clock format 2057209200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.416 {time zone boundary case 2035-04-01 03:00:01} detroit {
-    clock format 2059023601 -format {%H:%M:%S %z %Z} \
+test clock-5.416 {time zone boundary case 2035-03-11 03:00:01} detroit {
+    clock format 2057209201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.417 {time zone boundary case 2035-10-28 01:59:59} detroit {
-    clock format 2077163999 -format {%H:%M:%S %z %Z} \
+test clock-5.417 {time zone boundary case 2035-11-04 01:59:59} detroit {
+    clock format 2077768799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.418 {time zone boundary case 2035-10-28 01:00:00} detroit {
-    clock format 2077164000 -format {%H:%M:%S %z %Z} \
+test clock-5.418 {time zone boundary case 2035-11-04 01:00:00} detroit {
+    clock format 2077768800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.419 {time zone boundary case 2035-10-28 01:00:01} detroit {
-    clock format 2077164001 -format {%H:%M:%S %z %Z} \
+test clock-5.419 {time zone boundary case 2035-11-04 01:00:01} detroit {
+    clock format 2077768801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.420 {time zone boundary case 2036-04-06 01:59:59} detroit {
-    clock format 2091077999 -format {%H:%M:%S %z %Z} \
+test clock-5.420 {time zone boundary case 2036-03-09 01:59:59} detroit {
+    clock format 2088658799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.421 {time zone boundary case 2036-04-06 03:00:00} detroit {
-    clock format 2091078000 -format {%H:%M:%S %z %Z} \
+test clock-5.421 {time zone boundary case 2036-03-09 03:00:00} detroit {
+    clock format 2088658800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.422 {time zone boundary case 2036-04-06 03:00:01} detroit {
-    clock format 2091078001 -format {%H:%M:%S %z %Z} \
+test clock-5.422 {time zone boundary case 2036-03-09 03:00:01} detroit {
+    clock format 2088658801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.423 {time zone boundary case 2036-10-26 01:59:59} detroit {
-    clock format 2108613599 -format {%H:%M:%S %z %Z} \
+test clock-5.423 {time zone boundary case 2036-11-02 01:59:59} detroit {
+    clock format 2109218399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.424 {time zone boundary case 2036-10-26 01:00:00} detroit {
-    clock format 2108613600 -format {%H:%M:%S %z %Z} \
+test clock-5.424 {time zone boundary case 2036-11-02 01:00:00} detroit {
+    clock format 2109218400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.425 {time zone boundary case 2036-10-26 01:00:01} detroit {
-    clock format 2108613601 -format {%H:%M:%S %z %Z} \
+test clock-5.425 {time zone boundary case 2036-11-02 01:00:01} detroit {
+    clock format 2109218401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.426 {time zone boundary case 2037-04-05 01:59:59} detroit {
-    clock format 2122527599 -format {%H:%M:%S %z %Z} \
+test clock-5.426 {time zone boundary case 2037-03-08 01:59:59} detroit {
+    clock format 2120108399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.427 {time zone boundary case 2037-04-05 03:00:00} detroit {
-    clock format 2122527600 -format {%H:%M:%S %z %Z} \
+test clock-5.427 {time zone boundary case 2037-03-08 03:00:00} detroit {
+    clock format 2120108400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.428 {time zone boundary case 2037-04-05 03:00:01} detroit {
-    clock format 2122527601 -format {%H:%M:%S %z %Z} \
+test clock-5.428 {time zone boundary case 2037-03-08 03:00:01} detroit {
+    clock format 2120108401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.429 {time zone boundary case 2037-10-25 01:59:59} detroit {
-    clock format 2140063199 -format {%H:%M:%S %z %Z} \
+test clock-5.429 {time zone boundary case 2037-11-01 01:59:59} detroit {
+    clock format 2140667999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.430 {time zone boundary case 2037-10-25 01:00:00} detroit {
-    clock format 2140063200 -format {%H:%M:%S %z %Z} \
+test clock-5.430 {time zone boundary case 2037-11-01 01:00:00} detroit {
+    clock format 2140668000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.431 {time zone boundary case 2037-10-25 01:00:01} detroit {
-    clock format 2140063201 -format {%H:%M:%S %z %Z} \
+test clock-5.431 {time zone boundary case 2037-11-01 01:00:01} detroit {
+    clock format 2140668001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.432 {time zone boundary case 2038-04-04 01:59:59} {detroit y2038} {
-    clock format 2153977199 -format {%H:%M:%S %z %Z} \
+test clock-5.432 {time zone boundary case 2038-03-14 01:59:59} {detroit y2038} {
+    clock format 2152162799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.433 {time zone boundary case 2038-04-04 03:00:00} {detroit y2038} {
-    clock format 2153977200 -format {%H:%M:%S %z %Z} \
+test clock-5.433 {time zone boundary case 2038-03-14 03:00:00} {detroit y2038} {
+    clock format 2152162800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.434 {time zone boundary case 2038-04-04 03:00:01} {detroit y2038} {
-    clock format 2153977201 -format {%H:%M:%S %z %Z} \
+test clock-5.434 {time zone boundary case 2038-03-14 03:00:01} {detroit y2038} {
+    clock format 2152162801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.435 {time zone boundary case 2038-10-31 01:59:59} {detroit y2038} {
-    clock format 2172117599 -format {%H:%M:%S %z %Z} \
+test clock-5.435 {time zone boundary case 2038-11-07 01:59:59} {detroit y2038} {
+    clock format 2172722399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.436 {time zone boundary case 2038-10-31 01:00:00} {detroit y2038} {
-    clock format 2172117600 -format {%H:%M:%S %z %Z} \
+test clock-5.436 {time zone boundary case 2038-11-07 01:00:00} {detroit y2038} {
+    clock format 2172722400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.437 {time zone boundary case 2038-10-31 01:00:01} {detroit y2038} {
-    clock format 2172117601 -format {%H:%M:%S %z %Z} \
+test clock-5.437 {time zone boundary case 2038-11-07 01:00:01} {detroit y2038} {
+    clock format 2172722401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.438 {time zone boundary case 2039-04-03 01:59:59} {detroit y2038} {
-    clock format 2185426799 -format {%H:%M:%S %z %Z} \
+test clock-5.438 {time zone boundary case 2039-03-13 01:59:59} {detroit y2038} {
+    clock format 2183612399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.439 {time zone boundary case 2039-04-03 03:00:00} {detroit y2038} {
-    clock format 2185426800 -format {%H:%M:%S %z %Z} \
+test clock-5.439 {time zone boundary case 2039-03-13 03:00:00} {detroit y2038} {
+    clock format 2183612400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.440 {time zone boundary case 2039-04-03 03:00:01} {detroit y2038} {
-    clock format 2185426801 -format {%H:%M:%S %z %Z} \
+test clock-5.440 {time zone boundary case 2039-03-13 03:00:01} {detroit y2038} {
+    clock format 2183612401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.441 {time zone boundary case 2039-10-30 01:59:59} {detroit y2038} {
-    clock format 2203567199 -format {%H:%M:%S %z %Z} \
+test clock-5.441 {time zone boundary case 2039-11-06 01:59:59} {detroit y2038} {
+    clock format 2204171999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.442 {time zone boundary case 2039-10-30 01:00:00} {detroit y2038} {
-    clock format 2203567200 -format {%H:%M:%S %z %Z} \
+test clock-5.442 {time zone boundary case 2039-11-06 01:00:00} {detroit y2038} {
+    clock format 2204172000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.443 {time zone boundary case 2039-10-30 01:00:01} {detroit y2038} {
-    clock format 2203567201 -format {%H:%M:%S %z %Z} \
+test clock-5.443 {time zone boundary case 2039-11-06 01:00:01} {detroit y2038} {
+    clock format 2204172001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.444 {time zone boundary case 2040-04-01 01:59:59} {detroit y2038} {
-    clock format 2216876399 -format {%H:%M:%S %z %Z} \
+test clock-5.444 {time zone boundary case 2040-03-11 01:59:59} {detroit y2038} {
+    clock format 2215061999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.445 {time zone boundary case 2040-04-01 03:00:00} {detroit y2038} {
-    clock format 2216876400 -format {%H:%M:%S %z %Z} \
+test clock-5.445 {time zone boundary case 2040-03-11 03:00:00} {detroit y2038} {
+    clock format 2215062000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.446 {time zone boundary case 2040-04-01 03:00:01} {detroit y2038} {
-    clock format 2216876401 -format {%H:%M:%S %z %Z} \
+test clock-5.446 {time zone boundary case 2040-03-11 03:00:01} {detroit y2038} {
+    clock format 2215062001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.447 {time zone boundary case 2040-10-28 01:59:59} {detroit y2038} {
-    clock format 2235016799 -format {%H:%M:%S %z %Z} \
+test clock-5.447 {time zone boundary case 2040-11-04 01:59:59} {detroit y2038} {
+    clock format 2235621599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.448 {time zone boundary case 2040-10-28 01:00:00} {detroit y2038} {
-    clock format 2235016800 -format {%H:%M:%S %z %Z} \
+test clock-5.448 {time zone boundary case 2040-11-04 01:00:00} {detroit y2038} {
+    clock format 2235621600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.449 {time zone boundary case 2040-10-28 01:00:01} {detroit y2038} {
-    clock format 2235016801 -format {%H:%M:%S %z %Z} \
+test clock-5.449 {time zone boundary case 2040-11-04 01:00:01} {detroit y2038} {
+    clock format 2235621601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.450 {time zone boundary case 2041-04-07 01:59:59} {detroit y2038} {
-    clock format 2248930799 -format {%H:%M:%S %z %Z} \
+test clock-5.450 {time zone boundary case 2041-03-10 01:59:59} {detroit y2038} {
+    clock format 2246511599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.451 {time zone boundary case 2041-04-07 03:00:00} {detroit y2038} {
-    clock format 2248930800 -format {%H:%M:%S %z %Z} \
+test clock-5.451 {time zone boundary case 2041-03-10 03:00:00} {detroit y2038} {
+    clock format 2246511600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.452 {time zone boundary case 2041-04-07 03:00:01} {detroit y2038} {
-    clock format 2248930801 -format {%H:%M:%S %z %Z} \
+test clock-5.452 {time zone boundary case 2041-03-10 03:00:01} {detroit y2038} {
+    clock format 2246511601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.453 {time zone boundary case 2041-10-27 01:59:59} {detroit y2038} {
-    clock format 2266466399 -format {%H:%M:%S %z %Z} \
+test clock-5.453 {time zone boundary case 2041-11-03 01:59:59} {detroit y2038} {
+    clock format 2267071199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.454 {time zone boundary case 2041-10-27 01:00:00} {detroit y2038} {
-    clock format 2266466400 -format {%H:%M:%S %z %Z} \
+test clock-5.454 {time zone boundary case 2041-11-03 01:00:00} {detroit y2038} {
+    clock format 2267071200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.455 {time zone boundary case 2041-10-27 01:00:01} {detroit y2038} {
-    clock format 2266466401 -format {%H:%M:%S %z %Z} \
+test clock-5.455 {time zone boundary case 2041-11-03 01:00:01} {detroit y2038} {
+    clock format 2267071201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.456 {time zone boundary case 2042-04-06 01:59:59} {detroit y2038} {
-    clock format 2280380399 -format {%H:%M:%S %z %Z} \
+test clock-5.456 {time zone boundary case 2042-03-09 01:59:59} {detroit y2038} {
+    clock format 2277961199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.457 {time zone boundary case 2042-04-06 03:00:00} {detroit y2038} {
-    clock format 2280380400 -format {%H:%M:%S %z %Z} \
+test clock-5.457 {time zone boundary case 2042-03-09 03:00:00} {detroit y2038} {
+    clock format 2277961200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.458 {time zone boundary case 2042-04-06 03:00:01} {detroit y2038} {
-    clock format 2280380401 -format {%H:%M:%S %z %Z} \
+test clock-5.458 {time zone boundary case 2042-03-09 03:00:01} {detroit y2038} {
+    clock format 2277961201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.459 {time zone boundary case 2042-10-26 01:59:59} {detroit y2038} {
-    clock format 2297915999 -format {%H:%M:%S %z %Z} \
+test clock-5.459 {time zone boundary case 2042-11-02 01:59:59} {detroit y2038} {
+    clock format 2298520799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.460 {time zone boundary case 2042-10-26 01:00:00} {detroit y2038} {
-    clock format 2297916000 -format {%H:%M:%S %z %Z} \
+test clock-5.460 {time zone boundary case 2042-11-02 01:00:00} {detroit y2038} {
+    clock format 2298520800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.461 {time zone boundary case 2042-10-26 01:00:01} {detroit y2038} {
-    clock format 2297916001 -format {%H:%M:%S %z %Z} \
+test clock-5.461 {time zone boundary case 2042-11-02 01:00:01} {detroit y2038} {
+    clock format 2298520801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.462 {time zone boundary case 2043-04-05 01:59:59} {detroit y2038} {
-    clock format 2311829999 -format {%H:%M:%S %z %Z} \
+test clock-5.462 {time zone boundary case 2043-03-08 01:59:59} {detroit y2038} {
+    clock format 2309410799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.463 {time zone boundary case 2043-04-05 03:00:00} {detroit y2038} {
-    clock format 2311830000 -format {%H:%M:%S %z %Z} \
+test clock-5.463 {time zone boundary case 2043-03-08 03:00:00} {detroit y2038} {
+    clock format 2309410800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.464 {time zone boundary case 2043-04-05 03:00:01} {detroit y2038} {
-    clock format 2311830001 -format {%H:%M:%S %z %Z} \
+test clock-5.464 {time zone boundary case 2043-03-08 03:00:01} {detroit y2038} {
+    clock format 2309410801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.465 {time zone boundary case 2043-10-25 01:59:59} {detroit y2038} {
-    clock format 2329365599 -format {%H:%M:%S %z %Z} \
+test clock-5.465 {time zone boundary case 2043-11-01 01:59:59} {detroit y2038} {
+    clock format 2329970399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.466 {time zone boundary case 2043-10-25 01:00:00} {detroit y2038} {
-    clock format 2329365600 -format {%H:%M:%S %z %Z} \
+test clock-5.466 {time zone boundary case 2043-11-01 01:00:00} {detroit y2038} {
+    clock format 2329970400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.467 {time zone boundary case 2043-10-25 01:00:01} {detroit y2038} {
-    clock format 2329365601 -format {%H:%M:%S %z %Z} \
+test clock-5.467 {time zone boundary case 2043-11-01 01:00:01} {detroit y2038} {
+    clock format 2329970401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.468 {time zone boundary case 2044-04-03 01:59:59} {detroit y2038} {
-    clock format 2343279599 -format {%H:%M:%S %z %Z} \
+test clock-5.468 {time zone boundary case 2044-03-13 01:59:59} {detroit y2038} {
+    clock format 2341465199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.469 {time zone boundary case 2044-04-03 03:00:00} {detroit y2038} {
-    clock format 2343279600 -format {%H:%M:%S %z %Z} \
+test clock-5.469 {time zone boundary case 2044-03-13 03:00:00} {detroit y2038} {
+    clock format 2341465200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.470 {time zone boundary case 2044-04-03 03:00:01} {detroit y2038} {
-    clock format 2343279601 -format {%H:%M:%S %z %Z} \
+test clock-5.470 {time zone boundary case 2044-03-13 03:00:01} {detroit y2038} {
+    clock format 2341465201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.471 {time zone boundary case 2044-10-30 01:59:59} {detroit y2038} {
-    clock format 2361419999 -format {%H:%M:%S %z %Z} \
+test clock-5.471 {time zone boundary case 2044-11-06 01:59:59} {detroit y2038} {
+    clock format 2362024799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.472 {time zone boundary case 2044-10-30 01:00:00} {detroit y2038} {
-    clock format 2361420000 -format {%H:%M:%S %z %Z} \
+test clock-5.472 {time zone boundary case 2044-11-06 01:00:00} {detroit y2038} {
+    clock format 2362024800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.473 {time zone boundary case 2044-10-30 01:00:01} {detroit y2038} {
-    clock format 2361420001 -format {%H:%M:%S %z %Z} \
+test clock-5.473 {time zone boundary case 2044-11-06 01:00:01} {detroit y2038} {
+    clock format 2362024801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.474 {time zone boundary case 2045-04-02 01:59:59} {detroit y2038} {
-    clock format 2374729199 -format {%H:%M:%S %z %Z} \
+test clock-5.474 {time zone boundary case 2045-03-12 01:59:59} {detroit y2038} {
+    clock format 2372914799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.475 {time zone boundary case 2045-04-02 03:00:00} {detroit y2038} {
-    clock format 2374729200 -format {%H:%M:%S %z %Z} \
+test clock-5.475 {time zone boundary case 2045-03-12 03:00:00} {detroit y2038} {
+    clock format 2372914800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.476 {time zone boundary case 2045-04-02 03:00:01} {detroit y2038} {
-    clock format 2374729201 -format {%H:%M:%S %z %Z} \
+test clock-5.476 {time zone boundary case 2045-03-12 03:00:01} {detroit y2038} {
+    clock format 2372914801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.477 {time zone boundary case 2045-10-29 01:59:59} {detroit y2038} {
-    clock format 2392869599 -format {%H:%M:%S %z %Z} \
+test clock-5.477 {time zone boundary case 2045-11-05 01:59:59} {detroit y2038} {
+    clock format 2393474399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.478 {time zone boundary case 2045-10-29 01:00:00} {detroit y2038} {
-    clock format 2392869600 -format {%H:%M:%S %z %Z} \
+test clock-5.478 {time zone boundary case 2045-11-05 01:00:00} {detroit y2038} {
+    clock format 2393474400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.479 {time zone boundary case 2045-10-29 01:00:01} {detroit y2038} {
-    clock format 2392869601 -format {%H:%M:%S %z %Z} \
+test clock-5.479 {time zone boundary case 2045-11-05 01:00:01} {detroit y2038} {
+    clock format 2393474401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.480 {time zone boundary case 2046-04-01 01:59:59} {detroit y2038} {
-    clock format 2406178799 -format {%H:%M:%S %z %Z} \
+test clock-5.480 {time zone boundary case 2046-03-11 01:59:59} {detroit y2038} {
+    clock format 2404364399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.481 {time zone boundary case 2046-04-01 03:00:00} {detroit y2038} {
-    clock format 2406178800 -format {%H:%M:%S %z %Z} \
+test clock-5.481 {time zone boundary case 2046-03-11 03:00:00} {detroit y2038} {
+    clock format 2404364400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.482 {time zone boundary case 2046-04-01 03:00:01} {detroit y2038} {
-    clock format 2406178801 -format {%H:%M:%S %z %Z} \
+test clock-5.482 {time zone boundary case 2046-03-11 03:00:01} {detroit y2038} {
+    clock format 2404364401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.483 {time zone boundary case 2046-10-28 01:59:59} {detroit y2038} {
-    clock format 2424319199 -format {%H:%M:%S %z %Z} \
+test clock-5.483 {time zone boundary case 2046-11-04 01:59:59} {detroit y2038} {
+    clock format 2424923999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.484 {time zone boundary case 2046-10-28 01:00:00} {detroit y2038} {
-    clock format 2424319200 -format {%H:%M:%S %z %Z} \
+test clock-5.484 {time zone boundary case 2046-11-04 01:00:00} {detroit y2038} {
+    clock format 2424924000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.485 {time zone boundary case 2046-10-28 01:00:01} {detroit y2038} {
-    clock format 2424319201 -format {%H:%M:%S %z %Z} \
+test clock-5.485 {time zone boundary case 2046-11-04 01:00:01} {detroit y2038} {
+    clock format 2424924001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.486 {time zone boundary case 2047-04-07 01:59:59} {detroit y2038} {
-    clock format 2438233199 -format {%H:%M:%S %z %Z} \
+test clock-5.486 {time zone boundary case 2047-03-10 01:59:59} {detroit y2038} {
+    clock format 2435813999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.487 {time zone boundary case 2047-04-07 03:00:00} {detroit y2038} {
-    clock format 2438233200 -format {%H:%M:%S %z %Z} \
+test clock-5.487 {time zone boundary case 2047-03-10 03:00:00} {detroit y2038} {
+    clock format 2435814000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.488 {time zone boundary case 2047-04-07 03:00:01} {detroit y2038} {
-    clock format 2438233201 -format {%H:%M:%S %z %Z} \
+test clock-5.488 {time zone boundary case 2047-03-10 03:00:01} {detroit y2038} {
+    clock format 2435814001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.489 {time zone boundary case 2047-10-27 01:59:59} {detroit y2038} {
-    clock format 2455768799 -format {%H:%M:%S %z %Z} \
+test clock-5.489 {time zone boundary case 2047-11-03 01:59:59} {detroit y2038} {
+    clock format 2456373599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.490 {time zone boundary case 2047-10-27 01:00:00} {detroit y2038} {
-    clock format 2455768800 -format {%H:%M:%S %z %Z} \
+test clock-5.490 {time zone boundary case 2047-11-03 01:00:00} {detroit y2038} {
+    clock format 2456373600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.491 {time zone boundary case 2047-10-27 01:00:01} {detroit y2038} {
-    clock format 2455768801 -format {%H:%M:%S %z %Z} \
+test clock-5.491 {time zone boundary case 2047-11-03 01:00:01} {detroit y2038} {
+    clock format 2456373601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.492 {time zone boundary case 2048-04-05 01:59:59} {detroit y2038} {
-    clock format 2469682799 -format {%H:%M:%S %z %Z} \
+test clock-5.492 {time zone boundary case 2048-03-08 01:59:59} {detroit y2038} {
+    clock format 2467263599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.493 {time zone boundary case 2048-04-05 03:00:00} {detroit y2038} {
-    clock format 2469682800 -format {%H:%M:%S %z %Z} \
+test clock-5.493 {time zone boundary case 2048-03-08 03:00:00} {detroit y2038} {
+    clock format 2467263600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.494 {time zone boundary case 2048-04-05 03:00:01} {detroit y2038} {
-    clock format 2469682801 -format {%H:%M:%S %z %Z} \
+test clock-5.494 {time zone boundary case 2048-03-08 03:00:01} {detroit y2038} {
+    clock format 2467263601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.495 {time zone boundary case 2048-10-25 01:59:59} {detroit y2038} {
-    clock format 2487218399 -format {%H:%M:%S %z %Z} \
+test clock-5.495 {time zone boundary case 2048-11-01 01:59:59} {detroit y2038} {
+    clock format 2487823199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.496 {time zone boundary case 2048-10-25 01:00:00} {detroit y2038} {
-    clock format 2487218400 -format {%H:%M:%S %z %Z} \
+test clock-5.496 {time zone boundary case 2048-11-01 01:00:00} {detroit y2038} {
+    clock format 2487823200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.497 {time zone boundary case 2048-10-25 01:00:01} {detroit y2038} {
-    clock format 2487218401 -format {%H:%M:%S %z %Z} \
+test clock-5.497 {time zone boundary case 2048-11-01 01:00:01} {detroit y2038} {
+    clock format 2487823201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.498 {time zone boundary case 2049-04-04 01:59:59} {detroit y2038} {
-    clock format 2501132399 -format {%H:%M:%S %z %Z} \
+test clock-5.498 {time zone boundary case 2049-03-14 01:59:59} {detroit y2038} {
+    clock format 2499317999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.499 {time zone boundary case 2049-04-04 03:00:00} {detroit y2038} {
-    clock format 2501132400 -format {%H:%M:%S %z %Z} \
+test clock-5.499 {time zone boundary case 2049-03-14 03:00:00} {detroit y2038} {
+    clock format 2499318000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.500 {time zone boundary case 2049-04-04 03:00:01} {detroit y2038} {
-    clock format 2501132401 -format {%H:%M:%S %z %Z} \
+test clock-5.500 {time zone boundary case 2049-03-14 03:00:01} {detroit y2038} {
+    clock format 2499318001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.501 {time zone boundary case 2049-10-31 01:59:59} {detroit y2038} {
-    clock format 2519272799 -format {%H:%M:%S %z %Z} \
+test clock-5.501 {time zone boundary case 2049-11-07 01:59:59} {detroit y2038} {
+    clock format 2519877599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.502 {time zone boundary case 2049-10-31 01:00:00} {detroit y2038} {
-    clock format 2519272800 -format {%H:%M:%S %z %Z} \
+test clock-5.502 {time zone boundary case 2049-11-07 01:00:00} {detroit y2038} {
+    clock format 2519877600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.503 {time zone boundary case 2049-10-31 01:00:01} {detroit y2038} {
-    clock format 2519272801 -format {%H:%M:%S %z %Z} \
+test clock-5.503 {time zone boundary case 2049-11-07 01:00:01} {detroit y2038} {
+    clock format 2519877601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.504 {time zone boundary case 2050-04-03 01:59:59} {detroit y2038} {
-    clock format 2532581999 -format {%H:%M:%S %z %Z} \
+test clock-5.504 {time zone boundary case 2050-03-13 01:59:59} {detroit y2038} {
+    clock format 2530767599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.505 {time zone boundary case 2050-04-03 03:00:00} {detroit y2038} {
-    clock format 2532582000 -format {%H:%M:%S %z %Z} \
+test clock-5.505 {time zone boundary case 2050-03-13 03:00:00} {detroit y2038} {
+    clock format 2530767600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.506 {time zone boundary case 2050-04-03 03:00:01} {detroit y2038} {
-    clock format 2532582001 -format {%H:%M:%S %z %Z} \
+test clock-5.506 {time zone boundary case 2050-03-13 03:00:01} {detroit y2038} {
+    clock format 2530767601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.507 {time zone boundary case 2050-10-30 01:59:59} {detroit y2038} {
-    clock format 2550722399 -format {%H:%M:%S %z %Z} \
+test clock-5.507 {time zone boundary case 2050-11-06 01:59:59} {detroit y2038} {
+    clock format 2551327199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.508 {time zone boundary case 2050-10-30 01:00:00} {detroit y2038} {
-    clock format 2550722400 -format {%H:%M:%S %z %Z} \
+test clock-5.508 {time zone boundary case 2050-11-06 01:00:00} {detroit y2038} {
+    clock format 2551327200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.509 {time zone boundary case 2050-10-30 01:00:01} {detroit y2038} {
-    clock format 2550722401 -format {%H:%M:%S %z %Z} \
+test clock-5.509 {time zone boundary case 2050-11-06 01:00:01} {detroit y2038} {
+    clock format 2551327201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.510 {time zone boundary case 2051-04-02 01:59:59} {detroit y2038} {
-    clock format 2564031599 -format {%H:%M:%S %z %Z} \
+test clock-5.510 {time zone boundary case 2051-03-12 01:59:59} {detroit y2038} {
+    clock format 2562217199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.511 {time zone boundary case 2051-04-02 03:00:00} {detroit y2038} {
-    clock format 2564031600 -format {%H:%M:%S %z %Z} \
+test clock-5.511 {time zone boundary case 2051-03-12 03:00:00} {detroit y2038} {
+    clock format 2562217200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.512 {time zone boundary case 2051-04-02 03:00:01} {detroit y2038} {
-    clock format 2564031601 -format {%H:%M:%S %z %Z} \
+test clock-5.512 {time zone boundary case 2051-03-12 03:00:01} {detroit y2038} {
+    clock format 2562217201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.513 {time zone boundary case 2051-10-29 01:59:59} {detroit y2038} {
-    clock format 2582171999 -format {%H:%M:%S %z %Z} \
+test clock-5.513 {time zone boundary case 2051-11-05 01:59:59} {detroit y2038} {
+    clock format 2582776799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.514 {time zone boundary case 2051-10-29 01:00:00} {detroit y2038} {
-    clock format 2582172000 -format {%H:%M:%S %z %Z} \
+test clock-5.514 {time zone boundary case 2051-11-05 01:00:00} {detroit y2038} {
+    clock format 2582776800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.515 {time zone boundary case 2051-10-29 01:00:01} {detroit y2038} {
-    clock format 2582172001 -format {%H:%M:%S %z %Z} \
+test clock-5.515 {time zone boundary case 2051-11-05 01:00:01} {detroit y2038} {
+    clock format 2582776801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.516 {time zone boundary case 2052-04-07 01:59:59} {detroit y2038} {
-    clock format 2596085999 -format {%H:%M:%S %z %Z} \
+test clock-5.516 {time zone boundary case 2052-03-10 01:59:59} {detroit y2038} {
+    clock format 2593666799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.517 {time zone boundary case 2052-04-07 03:00:00} {detroit y2038} {
-    clock format 2596086000 -format {%H:%M:%S %z %Z} \
+test clock-5.517 {time zone boundary case 2052-03-10 03:00:00} {detroit y2038} {
+    clock format 2593666800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.518 {time zone boundary case 2052-04-07 03:00:01} {detroit y2038} {
-    clock format 2596086001 -format {%H:%M:%S %z %Z} \
+test clock-5.518 {time zone boundary case 2052-03-10 03:00:01} {detroit y2038} {
+    clock format 2593666801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.519 {time zone boundary case 2052-10-27 01:59:59} {detroit y2038} {
-    clock format 2613621599 -format {%H:%M:%S %z %Z} \
+test clock-5.519 {time zone boundary case 2052-11-03 01:59:59} {detroit y2038} {
+    clock format 2614226399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.520 {time zone boundary case 2052-10-27 01:00:00} {detroit y2038} {
-    clock format 2613621600 -format {%H:%M:%S %z %Z} \
+test clock-5.520 {time zone boundary case 2052-11-03 01:00:00} {detroit y2038} {
+    clock format 2614226400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.521 {time zone boundary case 2052-10-27 01:00:01} {detroit y2038} {
-    clock format 2613621601 -format {%H:%M:%S %z %Z} \
+test clock-5.521 {time zone boundary case 2052-11-03 01:00:01} {detroit y2038} {
+    clock format 2614226401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.522 {time zone boundary case 2053-04-06 01:59:59} {detroit y2038} {
-    clock format 2627535599 -format {%H:%M:%S %z %Z} \
+test clock-5.522 {time zone boundary case 2053-03-09 01:59:59} {detroit y2038} {
+    clock format 2625116399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.523 {time zone boundary case 2053-04-06 03:00:00} {detroit y2038} {
-    clock format 2627535600 -format {%H:%M:%S %z %Z} \
+test clock-5.523 {time zone boundary case 2053-03-09 03:00:00} {detroit y2038} {
+    clock format 2625116400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.524 {time zone boundary case 2053-04-06 03:00:01} {detroit y2038} {
-    clock format 2627535601 -format {%H:%M:%S %z %Z} \
+test clock-5.524 {time zone boundary case 2053-03-09 03:00:01} {detroit y2038} {
+    clock format 2625116401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.525 {time zone boundary case 2053-10-26 01:59:59} {detroit y2038} {
-    clock format 2645071199 -format {%H:%M:%S %z %Z} \
+test clock-5.525 {time zone boundary case 2053-11-02 01:59:59} {detroit y2038} {
+    clock format 2645675999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.526 {time zone boundary case 2053-10-26 01:00:00} {detroit y2038} {
-    clock format 2645071200 -format {%H:%M:%S %z %Z} \
+test clock-5.526 {time zone boundary case 2053-11-02 01:00:00} {detroit y2038} {
+    clock format 2645676000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.527 {time zone boundary case 2053-10-26 01:00:01} {detroit y2038} {
-    clock format 2645071201 -format {%H:%M:%S %z %Z} \
+test clock-5.527 {time zone boundary case 2053-11-02 01:00:01} {detroit y2038} {
+    clock format 2645676001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.528 {time zone boundary case 2054-04-05 01:59:59} {detroit y2038} {
-    clock format 2658985199 -format {%H:%M:%S %z %Z} \
+test clock-5.528 {time zone boundary case 2054-03-08 01:59:59} {detroit y2038} {
+    clock format 2656565999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.529 {time zone boundary case 2054-04-05 03:00:00} {detroit y2038} {
-    clock format 2658985200 -format {%H:%M:%S %z %Z} \
+test clock-5.529 {time zone boundary case 2054-03-08 03:00:00} {detroit y2038} {
+    clock format 2656566000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.530 {time zone boundary case 2054-04-05 03:00:01} {detroit y2038} {
-    clock format 2658985201 -format {%H:%M:%S %z %Z} \
+test clock-5.530 {time zone boundary case 2054-03-08 03:00:01} {detroit y2038} {
+    clock format 2656566001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.531 {time zone boundary case 2054-10-25 01:59:59} {detroit y2038} {
-    clock format 2676520799 -format {%H:%M:%S %z %Z} \
+test clock-5.531 {time zone boundary case 2054-11-01 01:59:59} {detroit y2038} {
+    clock format 2677125599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.532 {time zone boundary case 2054-10-25 01:00:00} {detroit y2038} {
-    clock format 2676520800 -format {%H:%M:%S %z %Z} \
+test clock-5.532 {time zone boundary case 2054-11-01 01:00:00} {detroit y2038} {
+    clock format 2677125600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.533 {time zone boundary case 2054-10-25 01:00:01} {detroit y2038} {
-    clock format 2676520801 -format {%H:%M:%S %z %Z} \
+test clock-5.533 {time zone boundary case 2054-11-01 01:00:01} {detroit y2038} {
+    clock format 2677125601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.534 {time zone boundary case 2055-04-04 01:59:59} {detroit y2038} {
-    clock format 2690434799 -format {%H:%M:%S %z %Z} \
+test clock-5.534 {time zone boundary case 2055-03-14 01:59:59} {detroit y2038} {
+    clock format 2688620399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.535 {time zone boundary case 2055-04-04 03:00:00} {detroit y2038} {
-    clock format 2690434800 -format {%H:%M:%S %z %Z} \
+test clock-5.535 {time zone boundary case 2055-03-14 03:00:00} {detroit y2038} {
+    clock format 2688620400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.536 {time zone boundary case 2055-04-04 03:00:01} {detroit y2038} {
-    clock format 2690434801 -format {%H:%M:%S %z %Z} \
+test clock-5.536 {time zone boundary case 2055-03-14 03:00:01} {detroit y2038} {
+    clock format 2688620401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.537 {time zone boundary case 2055-10-31 01:59:59} {detroit y2038} {
-    clock format 2708575199 -format {%H:%M:%S %z %Z} \
+test clock-5.537 {time zone boundary case 2055-11-07 01:59:59} {detroit y2038} {
+    clock format 2709179999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.538 {time zone boundary case 2055-10-31 01:00:00} {detroit y2038} {
-    clock format 2708575200 -format {%H:%M:%S %z %Z} \
+test clock-5.538 {time zone boundary case 2055-11-07 01:00:00} {detroit y2038} {
+    clock format 2709180000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.539 {time zone boundary case 2055-10-31 01:00:01} {detroit y2038} {
-    clock format 2708575201 -format {%H:%M:%S %z %Z} \
+test clock-5.539 {time zone boundary case 2055-11-07 01:00:01} {detroit y2038} {
+    clock format 2709180001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.540 {time zone boundary case 2056-04-02 01:59:59} {detroit y2038} {
-    clock format 2721884399 -format {%H:%M:%S %z %Z} \
+test clock-5.540 {time zone boundary case 2056-03-12 01:59:59} {detroit y2038} {
+    clock format 2720069999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.541 {time zone boundary case 2056-04-02 03:00:00} {detroit y2038} {
-    clock format 2721884400 -format {%H:%M:%S %z %Z} \
+test clock-5.541 {time zone boundary case 2056-03-12 03:00:00} {detroit y2038} {
+    clock format 2720070000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.542 {time zone boundary case 2056-04-02 03:00:01} {detroit y2038} {
-    clock format 2721884401 -format {%H:%M:%S %z %Z} \
+test clock-5.542 {time zone boundary case 2056-03-12 03:00:01} {detroit y2038} {
+    clock format 2720070001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.543 {time zone boundary case 2056-10-29 01:59:59} {detroit y2038} {
-    clock format 2740024799 -format {%H:%M:%S %z %Z} \
+test clock-5.543 {time zone boundary case 2056-11-05 01:59:59} {detroit y2038} {
+    clock format 2740629599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.544 {time zone boundary case 2056-10-29 01:00:00} {detroit y2038} {
-    clock format 2740024800 -format {%H:%M:%S %z %Z} \
+test clock-5.544 {time zone boundary case 2056-11-05 01:00:00} {detroit y2038} {
+    clock format 2740629600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.545 {time zone boundary case 2056-10-29 01:00:01} {detroit y2038} {
-    clock format 2740024801 -format {%H:%M:%S %z %Z} \
+test clock-5.545 {time zone boundary case 2056-11-05 01:00:01} {detroit y2038} {
+    clock format 2740629601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.546 {time zone boundary case 2057-04-01 01:59:59} {detroit y2038} {
-    clock format 2753333999 -format {%H:%M:%S %z %Z} \
+test clock-5.546 {time zone boundary case 2057-03-11 01:59:59} {detroit y2038} {
+    clock format 2751519599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.547 {time zone boundary case 2057-04-01 03:00:00} {detroit y2038} {
-    clock format 2753334000 -format {%H:%M:%S %z %Z} \
+test clock-5.547 {time zone boundary case 2057-03-11 03:00:00} {detroit y2038} {
+    clock format 2751519600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.548 {time zone boundary case 2057-04-01 03:00:01} {detroit y2038} {
-    clock format 2753334001 -format {%H:%M:%S %z %Z} \
+test clock-5.548 {time zone boundary case 2057-03-11 03:00:01} {detroit y2038} {
+    clock format 2751519601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.549 {time zone boundary case 2057-10-28 01:59:59} {detroit y2038} {
-    clock format 2771474399 -format {%H:%M:%S %z %Z} \
+test clock-5.549 {time zone boundary case 2057-11-04 01:59:59} {detroit y2038} {
+    clock format 2772079199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.550 {time zone boundary case 2057-10-28 01:00:00} {detroit y2038} {
-    clock format 2771474400 -format {%H:%M:%S %z %Z} \
+test clock-5.550 {time zone boundary case 2057-11-04 01:00:00} {detroit y2038} {
+    clock format 2772079200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.551 {time zone boundary case 2057-10-28 01:00:01} {detroit y2038} {
-    clock format 2771474401 -format {%H:%M:%S %z %Z} \
+test clock-5.551 {time zone boundary case 2057-11-04 01:00:01} {detroit y2038} {
+    clock format 2772079201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.552 {time zone boundary case 2058-04-07 01:59:59} {detroit y2038} {
-    clock format 2785388399 -format {%H:%M:%S %z %Z} \
+test clock-5.552 {time zone boundary case 2058-03-10 01:59:59} {detroit y2038} {
+    clock format 2782969199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.553 {time zone boundary case 2058-04-07 03:00:00} {detroit y2038} {
-    clock format 2785388400 -format {%H:%M:%S %z %Z} \
+test clock-5.553 {time zone boundary case 2058-03-10 03:00:00} {detroit y2038} {
+    clock format 2782969200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.554 {time zone boundary case 2058-04-07 03:00:01} {detroit y2038} {
-    clock format 2785388401 -format {%H:%M:%S %z %Z} \
+test clock-5.554 {time zone boundary case 2058-03-10 03:00:01} {detroit y2038} {
+    clock format 2782969201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.555 {time zone boundary case 2058-10-27 01:59:59} {detroit y2038} {
-    clock format 2802923999 -format {%H:%M:%S %z %Z} \
+test clock-5.555 {time zone boundary case 2058-11-03 01:59:59} {detroit y2038} {
+    clock format 2803528799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.556 {time zone boundary case 2058-10-27 01:00:00} {detroit y2038} {
-    clock format 2802924000 -format {%H:%M:%S %z %Z} \
+test clock-5.556 {time zone boundary case 2058-11-03 01:00:00} {detroit y2038} {
+    clock format 2803528800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.557 {time zone boundary case 2058-10-27 01:00:01} {detroit y2038} {
-    clock format 2802924001 -format {%H:%M:%S %z %Z} \
+test clock-5.557 {time zone boundary case 2058-11-03 01:00:01} {detroit y2038} {
+    clock format 2803528801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.558 {time zone boundary case 2059-04-06 01:59:59} {detroit y2038} {
-    clock format 2816837999 -format {%H:%M:%S %z %Z} \
+test clock-5.558 {time zone boundary case 2059-03-09 01:59:59} {detroit y2038} {
+    clock format 2814418799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.559 {time zone boundary case 2059-04-06 03:00:00} {detroit y2038} {
-    clock format 2816838000 -format {%H:%M:%S %z %Z} \
+test clock-5.559 {time zone boundary case 2059-03-09 03:00:00} {detroit y2038} {
+    clock format 2814418800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.560 {time zone boundary case 2059-04-06 03:00:01} {detroit y2038} {
-    clock format 2816838001 -format {%H:%M:%S %z %Z} \
+test clock-5.560 {time zone boundary case 2059-03-09 03:00:01} {detroit y2038} {
+    clock format 2814418801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.561 {time zone boundary case 2059-10-26 01:59:59} {detroit y2038} {
-    clock format 2834373599 -format {%H:%M:%S %z %Z} \
+test clock-5.561 {time zone boundary case 2059-11-02 01:59:59} {detroit y2038} {
+    clock format 2834978399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.562 {time zone boundary case 2059-10-26 01:00:00} {detroit y2038} {
-    clock format 2834373600 -format {%H:%M:%S %z %Z} \
+test clock-5.562 {time zone boundary case 2059-11-02 01:00:00} {detroit y2038} {
+    clock format 2834978400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.563 {time zone boundary case 2059-10-26 01:00:01} {detroit y2038} {
-    clock format 2834373601 -format {%H:%M:%S %z %Z} \
+test clock-5.563 {time zone boundary case 2059-11-02 01:00:01} {detroit y2038} {
+    clock format 2834978401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.564 {time zone boundary case 2060-04-04 01:59:59} {detroit y2038} {
-    clock format 2848287599 -format {%H:%M:%S %z %Z} \
+test clock-5.564 {time zone boundary case 2060-03-14 01:59:59} {detroit y2038} {
+    clock format 2846473199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.565 {time zone boundary case 2060-04-04 03:00:00} {detroit y2038} {
-    clock format 2848287600 -format {%H:%M:%S %z %Z} \
+test clock-5.565 {time zone boundary case 2060-03-14 03:00:00} {detroit y2038} {
+    clock format 2846473200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.566 {time zone boundary case 2060-04-04 03:00:01} {detroit y2038} {
-    clock format 2848287601 -format {%H:%M:%S %z %Z} \
+test clock-5.566 {time zone boundary case 2060-03-14 03:00:01} {detroit y2038} {
+    clock format 2846473201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.567 {time zone boundary case 2060-10-31 01:59:59} {detroit y2038} {
-    clock format 2866427999 -format {%H:%M:%S %z %Z} \
+test clock-5.567 {time zone boundary case 2060-11-07 01:59:59} {detroit y2038} {
+    clock format 2867032799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.568 {time zone boundary case 2060-10-31 01:00:00} {detroit y2038} {
-    clock format 2866428000 -format {%H:%M:%S %z %Z} \
+test clock-5.568 {time zone boundary case 2060-11-07 01:00:00} {detroit y2038} {
+    clock format 2867032800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.569 {time zone boundary case 2060-10-31 01:00:01} {detroit y2038} {
-    clock format 2866428001 -format {%H:%M:%S %z %Z} \
+test clock-5.569 {time zone boundary case 2060-11-07 01:00:01} {detroit y2038} {
+    clock format 2867032801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.570 {time zone boundary case 2061-04-03 01:59:59} {detroit y2038} {
-    clock format 2879737199 -format {%H:%M:%S %z %Z} \
+test clock-5.570 {time zone boundary case 2061-03-13 01:59:59} {detroit y2038} {
+    clock format 2877922799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.571 {time zone boundary case 2061-04-03 03:00:00} {detroit y2038} {
-    clock format 2879737200 -format {%H:%M:%S %z %Z} \
+test clock-5.571 {time zone boundary case 2061-03-13 03:00:00} {detroit y2038} {
+    clock format 2877922800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.572 {time zone boundary case 2061-04-03 03:00:01} {detroit y2038} {
-    clock format 2879737201 -format {%H:%M:%S %z %Z} \
+test clock-5.572 {time zone boundary case 2061-03-13 03:00:01} {detroit y2038} {
+    clock format 2877922801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.573 {time zone boundary case 2061-10-30 01:59:59} {detroit y2038} {
-    clock format 2897877599 -format {%H:%M:%S %z %Z} \
+test clock-5.573 {time zone boundary case 2061-11-06 01:59:59} {detroit y2038} {
+    clock format 2898482399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.574 {time zone boundary case 2061-10-30 01:00:00} {detroit y2038} {
-    clock format 2897877600 -format {%H:%M:%S %z %Z} \
+test clock-5.574 {time zone boundary case 2061-11-06 01:00:00} {detroit y2038} {
+    clock format 2898482400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.575 {time zone boundary case 2061-10-30 01:00:01} {detroit y2038} {
-    clock format 2897877601 -format {%H:%M:%S %z %Z} \
+test clock-5.575 {time zone boundary case 2061-11-06 01:00:01} {detroit y2038} {
+    clock format 2898482401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.576 {time zone boundary case 2062-04-02 01:59:59} {detroit y2038} {
-    clock format 2911186799 -format {%H:%M:%S %z %Z} \
+test clock-5.576 {time zone boundary case 2062-03-12 01:59:59} {detroit y2038} {
+    clock format 2909372399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.577 {time zone boundary case 2062-04-02 03:00:00} {detroit y2038} {
-    clock format 2911186800 -format {%H:%M:%S %z %Z} \
+test clock-5.577 {time zone boundary case 2062-03-12 03:00:00} {detroit y2038} {
+    clock format 2909372400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.578 {time zone boundary case 2062-04-02 03:00:01} {detroit y2038} {
-    clock format 2911186801 -format {%H:%M:%S %z %Z} \
+test clock-5.578 {time zone boundary case 2062-03-12 03:00:01} {detroit y2038} {
+    clock format 2909372401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.579 {time zone boundary case 2062-10-29 01:59:59} {detroit y2038} {
-    clock format 2929327199 -format {%H:%M:%S %z %Z} \
+test clock-5.579 {time zone boundary case 2062-11-05 01:59:59} {detroit y2038} {
+    clock format 2929931999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.580 {time zone boundary case 2062-10-29 01:00:00} {detroit y2038} {
-    clock format 2929327200 -format {%H:%M:%S %z %Z} \
+test clock-5.580 {time zone boundary case 2062-11-05 01:00:00} {detroit y2038} {
+    clock format 2929932000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.581 {time zone boundary case 2062-10-29 01:00:01} {detroit y2038} {
-    clock format 2929327201 -format {%H:%M:%S %z %Z} \
+test clock-5.581 {time zone boundary case 2062-11-05 01:00:01} {detroit y2038} {
+    clock format 2929932001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.582 {time zone boundary case 2063-04-01 01:59:59} {detroit y2038} {
-    clock format 2942636399 -format {%H:%M:%S %z %Z} \
+test clock-5.582 {time zone boundary case 2063-03-11 01:59:59} {detroit y2038} {
+    clock format 2940821999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.583 {time zone boundary case 2063-04-01 03:00:00} {detroit y2038} {
-    clock format 2942636400 -format {%H:%M:%S %z %Z} \
+test clock-5.583 {time zone boundary case 2063-03-11 03:00:00} {detroit y2038} {
+    clock format 2940822000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.584 {time zone boundary case 2063-04-01 03:00:01} {detroit y2038} {
-    clock format 2942636401 -format {%H:%M:%S %z %Z} \
+test clock-5.584 {time zone boundary case 2063-03-11 03:00:01} {detroit y2038} {
+    clock format 2940822001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.585 {time zone boundary case 2063-10-28 01:59:59} {detroit y2038} {
-    clock format 2960776799 -format {%H:%M:%S %z %Z} \
+test clock-5.585 {time zone boundary case 2063-11-04 01:59:59} {detroit y2038} {
+    clock format 2961381599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.586 {time zone boundary case 2063-10-28 01:00:00} {detroit y2038} {
-    clock format 2960776800 -format {%H:%M:%S %z %Z} \
+test clock-5.586 {time zone boundary case 2063-11-04 01:00:00} {detroit y2038} {
+    clock format 2961381600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.587 {time zone boundary case 2063-10-28 01:00:01} {detroit y2038} {
-    clock format 2960776801 -format {%H:%M:%S %z %Z} \
+test clock-5.587 {time zone boundary case 2063-11-04 01:00:01} {detroit y2038} {
+    clock format 2961381601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.588 {time zone boundary case 2064-04-06 01:59:59} {detroit y2038} {
-    clock format 2974690799 -format {%H:%M:%S %z %Z} \
+test clock-5.588 {time zone boundary case 2064-03-09 01:59:59} {detroit y2038} {
+    clock format 2972271599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.589 {time zone boundary case 2064-04-06 03:00:00} {detroit y2038} {
-    clock format 2974690800 -format {%H:%M:%S %z %Z} \
+test clock-5.589 {time zone boundary case 2064-03-09 03:00:00} {detroit y2038} {
+    clock format 2972271600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.590 {time zone boundary case 2064-04-06 03:00:01} {detroit y2038} {
-    clock format 2974690801 -format {%H:%M:%S %z %Z} \
+test clock-5.590 {time zone boundary case 2064-03-09 03:00:01} {detroit y2038} {
+    clock format 2972271601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.591 {time zone boundary case 2064-10-26 01:59:59} {detroit y2038} {
-    clock format 2992226399 -format {%H:%M:%S %z %Z} \
+test clock-5.591 {time zone boundary case 2064-11-02 01:59:59} {detroit y2038} {
+    clock format 2992831199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.592 {time zone boundary case 2064-10-26 01:00:00} {detroit y2038} {
-    clock format 2992226400 -format {%H:%M:%S %z %Z} \
+test clock-5.592 {time zone boundary case 2064-11-02 01:00:00} {detroit y2038} {
+    clock format 2992831200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.593 {time zone boundary case 2064-10-26 01:00:01} {detroit y2038} {
-    clock format 2992226401 -format {%H:%M:%S %z %Z} \
+test clock-5.593 {time zone boundary case 2064-11-02 01:00:01} {detroit y2038} {
+    clock format 2992831201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.594 {time zone boundary case 2065-04-05 01:59:59} {detroit y2038} {
-    clock format 3006140399 -format {%H:%M:%S %z %Z} \
+test clock-5.594 {time zone boundary case 2065-03-08 01:59:59} {detroit y2038} {
+    clock format 3003721199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.595 {time zone boundary case 2065-04-05 03:00:00} {detroit y2038} {
-    clock format 3006140400 -format {%H:%M:%S %z %Z} \
+test clock-5.595 {time zone boundary case 2065-03-08 03:00:00} {detroit y2038} {
+    clock format 3003721200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.596 {time zone boundary case 2065-04-05 03:00:01} {detroit y2038} {
-    clock format 3006140401 -format {%H:%M:%S %z %Z} \
+test clock-5.596 {time zone boundary case 2065-03-08 03:00:01} {detroit y2038} {
+    clock format 3003721201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.597 {time zone boundary case 2065-10-25 01:59:59} {detroit y2038} {
-    clock format 3023675999 -format {%H:%M:%S %z %Z} \
+test clock-5.597 {time zone boundary case 2065-11-01 01:59:59} {detroit y2038} {
+    clock format 3024280799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.598 {time zone boundary case 2065-10-25 01:00:00} {detroit y2038} {
-    clock format 3023676000 -format {%H:%M:%S %z %Z} \
+test clock-5.598 {time zone boundary case 2065-11-01 01:00:00} {detroit y2038} {
+    clock format 3024280800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.599 {time zone boundary case 2065-10-25 01:00:01} {detroit y2038} {
-    clock format 3023676001 -format {%H:%M:%S %z %Z} \
+test clock-5.599 {time zone boundary case 2065-11-01 01:00:01} {detroit y2038} {
+    clock format 3024280801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.600 {time zone boundary case 2066-04-04 01:59:59} {detroit y2038} {
-    clock format 3037589999 -format {%H:%M:%S %z %Z} \
+test clock-5.600 {time zone boundary case 2066-03-14 01:59:59} {detroit y2038} {
+    clock format 3035775599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.601 {time zone boundary case 2066-04-04 03:00:00} {detroit y2038} {
-    clock format 3037590000 -format {%H:%M:%S %z %Z} \
+test clock-5.601 {time zone boundary case 2066-03-14 03:00:00} {detroit y2038} {
+    clock format 3035775600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.602 {time zone boundary case 2066-04-04 03:00:01} {detroit y2038} {
-    clock format 3037590001 -format {%H:%M:%S %z %Z} \
+test clock-5.602 {time zone boundary case 2066-03-14 03:00:01} {detroit y2038} {
+    clock format 3035775601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.603 {time zone boundary case 2066-10-31 01:59:59} {detroit y2038} {
-    clock format 3055730399 -format {%H:%M:%S %z %Z} \
+test clock-5.603 {time zone boundary case 2066-11-07 01:59:59} {detroit y2038} {
+    clock format 3056335199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.604 {time zone boundary case 2066-10-31 01:00:00} {detroit y2038} {
-    clock format 3055730400 -format {%H:%M:%S %z %Z} \
+test clock-5.604 {time zone boundary case 2066-11-07 01:00:00} {detroit y2038} {
+    clock format 3056335200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.605 {time zone boundary case 2066-10-31 01:00:01} {detroit y2038} {
-    clock format 3055730401 -format {%H:%M:%S %z %Z} \
+test clock-5.605 {time zone boundary case 2066-11-07 01:00:01} {detroit y2038} {
+    clock format 3056335201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.606 {time zone boundary case 2067-04-03 01:59:59} {detroit y2038} {
-    clock format 3069039599 -format {%H:%M:%S %z %Z} \
+test clock-5.606 {time zone boundary case 2067-03-13 01:59:59} {detroit y2038} {
+    clock format 3067225199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.607 {time zone boundary case 2067-04-03 03:00:00} {detroit y2038} {
-    clock format 3069039600 -format {%H:%M:%S %z %Z} \
+test clock-5.607 {time zone boundary case 2067-03-13 03:00:00} {detroit y2038} {
+    clock format 3067225200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.608 {time zone boundary case 2067-04-03 03:00:01} {detroit y2038} {
-    clock format 3069039601 -format {%H:%M:%S %z %Z} \
+test clock-5.608 {time zone boundary case 2067-03-13 03:00:01} {detroit y2038} {
+    clock format 3067225201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.609 {time zone boundary case 2067-10-30 01:59:59} {detroit y2038} {
-    clock format 3087179999 -format {%H:%M:%S %z %Z} \
+test clock-5.609 {time zone boundary case 2067-11-06 01:59:59} {detroit y2038} {
+    clock format 3087784799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.610 {time zone boundary case 2067-10-30 01:00:00} {detroit y2038} {
-    clock format 3087180000 -format {%H:%M:%S %z %Z} \
+test clock-5.610 {time zone boundary case 2067-11-06 01:00:00} {detroit y2038} {
+    clock format 3087784800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.611 {time zone boundary case 2067-10-30 01:00:01} {detroit y2038} {
-    clock format 3087180001 -format {%H:%M:%S %z %Z} \
+test clock-5.611 {time zone boundary case 2067-11-06 01:00:01} {detroit y2038} {
+    clock format 3087784801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.612 {time zone boundary case 2068-04-01 01:59:59} {detroit y2038} {
-    clock format 3100489199 -format {%H:%M:%S %z %Z} \
+test clock-5.612 {time zone boundary case 2068-03-11 01:59:59} {detroit y2038} {
+    clock format 3098674799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.613 {time zone boundary case 2068-04-01 03:00:00} {detroit y2038} {
-    clock format 3100489200 -format {%H:%M:%S %z %Z} \
+test clock-5.613 {time zone boundary case 2068-03-11 03:00:00} {detroit y2038} {
+    clock format 3098674800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.614 {time zone boundary case 2068-04-01 03:00:01} {detroit y2038} {
-    clock format 3100489201 -format {%H:%M:%S %z %Z} \
+test clock-5.614 {time zone boundary case 2068-03-11 03:00:01} {detroit y2038} {
+    clock format 3098674801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.615 {time zone boundary case 2068-10-28 01:59:59} {detroit y2038} {
-    clock format 3118629599 -format {%H:%M:%S %z %Z} \
+test clock-5.615 {time zone boundary case 2068-11-04 01:59:59} {detroit y2038} {
+    clock format 3119234399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.616 {time zone boundary case 2068-10-28 01:00:00} {detroit y2038} {
-    clock format 3118629600 -format {%H:%M:%S %z %Z} \
+test clock-5.616 {time zone boundary case 2068-11-04 01:00:00} {detroit y2038} {
+    clock format 3119234400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.617 {time zone boundary case 2068-10-28 01:00:01} {detroit y2038} {
-    clock format 3118629601 -format {%H:%M:%S %z %Z} \
+test clock-5.617 {time zone boundary case 2068-11-04 01:00:01} {detroit y2038} {
+    clock format 3119234401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.618 {time zone boundary case 2069-04-07 01:59:59} {detroit y2038} {
-    clock format 3132543599 -format {%H:%M:%S %z %Z} \
+test clock-5.618 {time zone boundary case 2069-03-10 01:59:59} {detroit y2038} {
+    clock format 3130124399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.619 {time zone boundary case 2069-04-07 03:00:00} {detroit y2038} {
-    clock format 3132543600 -format {%H:%M:%S %z %Z} \
+test clock-5.619 {time zone boundary case 2069-03-10 03:00:00} {detroit y2038} {
+    clock format 3130124400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.620 {time zone boundary case 2069-04-07 03:00:01} {detroit y2038} {
-    clock format 3132543601 -format {%H:%M:%S %z %Z} \
+test clock-5.620 {time zone boundary case 2069-03-10 03:00:01} {detroit y2038} {
+    clock format 3130124401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.621 {time zone boundary case 2069-10-27 01:59:59} {detroit y2038} {
-    clock format 3150079199 -format {%H:%M:%S %z %Z} \
+test clock-5.621 {time zone boundary case 2069-11-03 01:59:59} {detroit y2038} {
+    clock format 3150683999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.622 {time zone boundary case 2069-10-27 01:00:00} {detroit y2038} {
-    clock format 3150079200 -format {%H:%M:%S %z %Z} \
+test clock-5.622 {time zone boundary case 2069-11-03 01:00:00} {detroit y2038} {
+    clock format 3150684000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.623 {time zone boundary case 2069-10-27 01:00:01} {detroit y2038} {
-    clock format 3150079201 -format {%H:%M:%S %z %Z} \
+test clock-5.623 {time zone boundary case 2069-11-03 01:00:01} {detroit y2038} {
+    clock format 3150684001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.624 {time zone boundary case 2070-04-06 01:59:59} {detroit y2038} {
-    clock format 3163993199 -format {%H:%M:%S %z %Z} \
+test clock-5.624 {time zone boundary case 2070-03-09 01:59:59} {detroit y2038} {
+    clock format 3161573999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.625 {time zone boundary case 2070-04-06 03:00:00} {detroit y2038} {
-    clock format 3163993200 -format {%H:%M:%S %z %Z} \
+test clock-5.625 {time zone boundary case 2070-03-09 03:00:00} {detroit y2038} {
+    clock format 3161574000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.626 {time zone boundary case 2070-04-06 03:00:01} {detroit y2038} {
-    clock format 3163993201 -format {%H:%M:%S %z %Z} \
+test clock-5.626 {time zone boundary case 2070-03-09 03:00:01} {detroit y2038} {
+    clock format 3161574001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.627 {time zone boundary case 2070-10-26 01:59:59} {detroit y2038} {
-    clock format 3181528799 -format {%H:%M:%S %z %Z} \
+test clock-5.627 {time zone boundary case 2070-11-02 01:59:59} {detroit y2038} {
+    clock format 3182133599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.628 {time zone boundary case 2070-10-26 01:00:00} {detroit y2038} {
-    clock format 3181528800 -format {%H:%M:%S %z %Z} \
+test clock-5.628 {time zone boundary case 2070-11-02 01:00:00} {detroit y2038} {
+    clock format 3182133600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.629 {time zone boundary case 2070-10-26 01:00:01} {detroit y2038} {
-    clock format 3181528801 -format {%H:%M:%S %z %Z} \
+test clock-5.629 {time zone boundary case 2070-11-02 01:00:01} {detroit y2038} {
+    clock format 3182133601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.630 {time zone boundary case 2071-04-05 01:59:59} {detroit y2038} {
-    clock format 3195442799 -format {%H:%M:%S %z %Z} \
+test clock-5.630 {time zone boundary case 2071-03-08 01:59:59} {detroit y2038} {
+    clock format 3193023599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.631 {time zone boundary case 2071-04-05 03:00:00} {detroit y2038} {
-    clock format 3195442800 -format {%H:%M:%S %z %Z} \
+test clock-5.631 {time zone boundary case 2071-03-08 03:00:00} {detroit y2038} {
+    clock format 3193023600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.632 {time zone boundary case 2071-04-05 03:00:01} {detroit y2038} {
-    clock format 3195442801 -format {%H:%M:%S %z %Z} \
+test clock-5.632 {time zone boundary case 2071-03-08 03:00:01} {detroit y2038} {
+    clock format 3193023601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.633 {time zone boundary case 2071-10-25 01:59:59} {detroit y2038} {
-    clock format 3212978399 -format {%H:%M:%S %z %Z} \
+test clock-5.633 {time zone boundary case 2071-11-01 01:59:59} {detroit y2038} {
+    clock format 3213583199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.634 {time zone boundary case 2071-10-25 01:00:00} {detroit y2038} {
-    clock format 3212978400 -format {%H:%M:%S %z %Z} \
+test clock-5.634 {time zone boundary case 2071-11-01 01:00:00} {detroit y2038} {
+    clock format 3213583200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.635 {time zone boundary case 2071-10-25 01:00:01} {detroit y2038} {
-    clock format 3212978401 -format {%H:%M:%S %z %Z} \
+test clock-5.635 {time zone boundary case 2071-11-01 01:00:01} {detroit y2038} {
+    clock format 3213583201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.636 {time zone boundary case 2072-04-03 01:59:59} {detroit y2038} {
-    clock format 3226892399 -format {%H:%M:%S %z %Z} \
+test clock-5.636 {time zone boundary case 2072-03-13 01:59:59} {detroit y2038} {
+    clock format 3225077999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.637 {time zone boundary case 2072-04-03 03:00:00} {detroit y2038} {
-    clock format 3226892400 -format {%H:%M:%S %z %Z} \
+test clock-5.637 {time zone boundary case 2072-03-13 03:00:00} {detroit y2038} {
+    clock format 3225078000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.638 {time zone boundary case 2072-04-03 03:00:01} {detroit y2038} {
-    clock format 3226892401 -format {%H:%M:%S %z %Z} \
+test clock-5.638 {time zone boundary case 2072-03-13 03:00:01} {detroit y2038} {
+    clock format 3225078001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.639 {time zone boundary case 2072-10-30 01:59:59} {detroit y2038} {
-    clock format 3245032799 -format {%H:%M:%S %z %Z} \
+test clock-5.639 {time zone boundary case 2072-11-06 01:59:59} {detroit y2038} {
+    clock format 3245637599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.640 {time zone boundary case 2072-10-30 01:00:00} {detroit y2038} {
-    clock format 3245032800 -format {%H:%M:%S %z %Z} \
+test clock-5.640 {time zone boundary case 2072-11-06 01:00:00} {detroit y2038} {
+    clock format 3245637600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.641 {time zone boundary case 2072-10-30 01:00:01} {detroit y2038} {
-    clock format 3245032801 -format {%H:%M:%S %z %Z} \
+test clock-5.641 {time zone boundary case 2072-11-06 01:00:01} {detroit y2038} {
+    clock format 3245637601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.642 {time zone boundary case 2073-04-02 01:59:59} {detroit y2038} {
-    clock format 3258341999 -format {%H:%M:%S %z %Z} \
+test clock-5.642 {time zone boundary case 2073-03-12 01:59:59} {detroit y2038} {
+    clock format 3256527599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.643 {time zone boundary case 2073-04-02 03:00:00} {detroit y2038} {
-    clock format 3258342000 -format {%H:%M:%S %z %Z} \
+test clock-5.643 {time zone boundary case 2073-03-12 03:00:00} {detroit y2038} {
+    clock format 3256527600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.644 {time zone boundary case 2073-04-02 03:00:01} {detroit y2038} {
-    clock format 3258342001 -format {%H:%M:%S %z %Z} \
+test clock-5.644 {time zone boundary case 2073-03-12 03:00:01} {detroit y2038} {
+    clock format 3256527601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.645 {time zone boundary case 2073-10-29 01:59:59} {detroit y2038} {
-    clock format 3276482399 -format {%H:%M:%S %z %Z} \
+test clock-5.645 {time zone boundary case 2073-11-05 01:59:59} {detroit y2038} {
+    clock format 3277087199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.646 {time zone boundary case 2073-10-29 01:00:00} {detroit y2038} {
-    clock format 3276482400 -format {%H:%M:%S %z %Z} \
+test clock-5.646 {time zone boundary case 2073-11-05 01:00:00} {detroit y2038} {
+    clock format 3277087200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.647 {time zone boundary case 2073-10-29 01:00:01} {detroit y2038} {
-    clock format 3276482401 -format {%H:%M:%S %z %Z} \
+test clock-5.647 {time zone boundary case 2073-11-05 01:00:01} {detroit y2038} {
+    clock format 3277087201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.648 {time zone boundary case 2074-04-01 01:59:59} {detroit y2038} {
-    clock format 3289791599 -format {%H:%M:%S %z %Z} \
+test clock-5.648 {time zone boundary case 2074-03-11 01:59:59} {detroit y2038} {
+    clock format 3287977199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.649 {time zone boundary case 2074-04-01 03:00:00} {detroit y2038} {
-    clock format 3289791600 -format {%H:%M:%S %z %Z} \
+test clock-5.649 {time zone boundary case 2074-03-11 03:00:00} {detroit y2038} {
+    clock format 3287977200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.650 {time zone boundary case 2074-04-01 03:00:01} {detroit y2038} {
-    clock format 3289791601 -format {%H:%M:%S %z %Z} \
+test clock-5.650 {time zone boundary case 2074-03-11 03:00:01} {detroit y2038} {
+    clock format 3287977201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.651 {time zone boundary case 2074-10-28 01:59:59} {detroit y2038} {
-    clock format 3307931999 -format {%H:%M:%S %z %Z} \
+test clock-5.651 {time zone boundary case 2074-11-04 01:59:59} {detroit y2038} {
+    clock format 3308536799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.652 {time zone boundary case 2074-10-28 01:00:00} {detroit y2038} {
-    clock format 3307932000 -format {%H:%M:%S %z %Z} \
+test clock-5.652 {time zone boundary case 2074-11-04 01:00:00} {detroit y2038} {
+    clock format 3308536800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.653 {time zone boundary case 2074-10-28 01:00:01} {detroit y2038} {
-    clock format 3307932001 -format {%H:%M:%S %z %Z} \
+test clock-5.653 {time zone boundary case 2074-11-04 01:00:01} {detroit y2038} {
+    clock format 3308536801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.654 {time zone boundary case 2075-04-07 01:59:59} {detroit y2038} {
-    clock format 3321845999 -format {%H:%M:%S %z %Z} \
+test clock-5.654 {time zone boundary case 2075-03-10 01:59:59} {detroit y2038} {
+    clock format 3319426799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.655 {time zone boundary case 2075-04-07 03:00:00} {detroit y2038} {
-    clock format 3321846000 -format {%H:%M:%S %z %Z} \
+test clock-5.655 {time zone boundary case 2075-03-10 03:00:00} {detroit y2038} {
+    clock format 3319426800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.656 {time zone boundary case 2075-04-07 03:00:01} {detroit y2038} {
-    clock format 3321846001 -format {%H:%M:%S %z %Z} \
+test clock-5.656 {time zone boundary case 2075-03-10 03:00:01} {detroit y2038} {
+    clock format 3319426801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.657 {time zone boundary case 2075-10-27 01:59:59} {detroit y2038} {
-    clock format 3339381599 -format {%H:%M:%S %z %Z} \
+test clock-5.657 {time zone boundary case 2075-11-03 01:59:59} {detroit y2038} {
+    clock format 3339986399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.658 {time zone boundary case 2075-10-27 01:00:00} {detroit y2038} {
-    clock format 3339381600 -format {%H:%M:%S %z %Z} \
+test clock-5.658 {time zone boundary case 2075-11-03 01:00:00} {detroit y2038} {
+    clock format 3339986400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.659 {time zone boundary case 2075-10-27 01:00:01} {detroit y2038} {
-    clock format 3339381601 -format {%H:%M:%S %z %Z} \
+test clock-5.659 {time zone boundary case 2075-11-03 01:00:01} {detroit y2038} {
+    clock format 3339986401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.660 {time zone boundary case 2076-04-05 01:59:59} {detroit y2038} {
-    clock format 3353295599 -format {%H:%M:%S %z %Z} \
+test clock-5.660 {time zone boundary case 2076-03-08 01:59:59} {detroit y2038} {
+    clock format 3350876399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.661 {time zone boundary case 2076-04-05 03:00:00} {detroit y2038} {
-    clock format 3353295600 -format {%H:%M:%S %z %Z} \
+test clock-5.661 {time zone boundary case 2076-03-08 03:00:00} {detroit y2038} {
+    clock format 3350876400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.662 {time zone boundary case 2076-04-05 03:00:01} {detroit y2038} {
-    clock format 3353295601 -format {%H:%M:%S %z %Z} \
+test clock-5.662 {time zone boundary case 2076-03-08 03:00:01} {detroit y2038} {
+    clock format 3350876401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.663 {time zone boundary case 2076-10-25 01:59:59} {detroit y2038} {
-    clock format 3370831199 -format {%H:%M:%S %z %Z} \
+test clock-5.663 {time zone boundary case 2076-11-01 01:59:59} {detroit y2038} {
+    clock format 3371435999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.664 {time zone boundary case 2076-10-25 01:00:00} {detroit y2038} {
-    clock format 3370831200 -format {%H:%M:%S %z %Z} \
+test clock-5.664 {time zone boundary case 2076-11-01 01:00:00} {detroit y2038} {
+    clock format 3371436000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.665 {time zone boundary case 2076-10-25 01:00:01} {detroit y2038} {
-    clock format 3370831201 -format {%H:%M:%S %z %Z} \
+test clock-5.665 {time zone boundary case 2076-11-01 01:00:01} {detroit y2038} {
+    clock format 3371436001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.666 {time zone boundary case 2077-04-04 01:59:59} {detroit y2038} {
-    clock format 3384745199 -format {%H:%M:%S %z %Z} \
+test clock-5.666 {time zone boundary case 2077-03-14 01:59:59} {detroit y2038} {
+    clock format 3382930799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.667 {time zone boundary case 2077-04-04 03:00:00} {detroit y2038} {
-    clock format 3384745200 -format {%H:%M:%S %z %Z} \
+test clock-5.667 {time zone boundary case 2077-03-14 03:00:00} {detroit y2038} {
+    clock format 3382930800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.668 {time zone boundary case 2077-04-04 03:00:01} {detroit y2038} {
-    clock format 3384745201 -format {%H:%M:%S %z %Z} \
+test clock-5.668 {time zone boundary case 2077-03-14 03:00:01} {detroit y2038} {
+    clock format 3382930801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.669 {time zone boundary case 2077-10-31 01:59:59} {detroit y2038} {
-    clock format 3402885599 -format {%H:%M:%S %z %Z} \
+test clock-5.669 {time zone boundary case 2077-11-07 01:59:59} {detroit y2038} {
+    clock format 3403490399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.670 {time zone boundary case 2077-10-31 01:00:00} {detroit y2038} {
-    clock format 3402885600 -format {%H:%M:%S %z %Z} \
+test clock-5.670 {time zone boundary case 2077-11-07 01:00:00} {detroit y2038} {
+    clock format 3403490400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.671 {time zone boundary case 2077-10-31 01:00:01} {detroit y2038} {
-    clock format 3402885601 -format {%H:%M:%S %z %Z} \
+test clock-5.671 {time zone boundary case 2077-11-07 01:00:01} {detroit y2038} {
+    clock format 3403490401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.672 {time zone boundary case 2078-04-03 01:59:59} {detroit y2038} {
-    clock format 3416194799 -format {%H:%M:%S %z %Z} \
+test clock-5.672 {time zone boundary case 2078-03-13 01:59:59} {detroit y2038} {
+    clock format 3414380399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.673 {time zone boundary case 2078-04-03 03:00:00} {detroit y2038} {
-    clock format 3416194800 -format {%H:%M:%S %z %Z} \
+test clock-5.673 {time zone boundary case 2078-03-13 03:00:00} {detroit y2038} {
+    clock format 3414380400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.674 {time zone boundary case 2078-04-03 03:00:01} {detroit y2038} {
-    clock format 3416194801 -format {%H:%M:%S %z %Z} \
+test clock-5.674 {time zone boundary case 2078-03-13 03:00:01} {detroit y2038} {
+    clock format 3414380401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.675 {time zone boundary case 2078-10-30 01:59:59} {detroit y2038} {
-    clock format 3434335199 -format {%H:%M:%S %z %Z} \
+test clock-5.675 {time zone boundary case 2078-11-06 01:59:59} {detroit y2038} {
+    clock format 3434939999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.676 {time zone boundary case 2078-10-30 01:00:00} {detroit y2038} {
-    clock format 3434335200 -format {%H:%M:%S %z %Z} \
+test clock-5.676 {time zone boundary case 2078-11-06 01:00:00} {detroit y2038} {
+    clock format 3434940000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.677 {time zone boundary case 2078-10-30 01:00:01} {detroit y2038} {
-    clock format 3434335201 -format {%H:%M:%S %z %Z} \
+test clock-5.677 {time zone boundary case 2078-11-06 01:00:01} {detroit y2038} {
+    clock format 3434940001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.678 {time zone boundary case 2079-04-02 01:59:59} {detroit y2038} {
-    clock format 3447644399 -format {%H:%M:%S %z %Z} \
+test clock-5.678 {time zone boundary case 2079-03-12 01:59:59} {detroit y2038} {
+    clock format 3445829999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.679 {time zone boundary case 2079-04-02 03:00:00} {detroit y2038} {
-    clock format 3447644400 -format {%H:%M:%S %z %Z} \
+test clock-5.679 {time zone boundary case 2079-03-12 03:00:00} {detroit y2038} {
+    clock format 3445830000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.680 {time zone boundary case 2079-04-02 03:00:01} {detroit y2038} {
-    clock format 3447644401 -format {%H:%M:%S %z %Z} \
+test clock-5.680 {time zone boundary case 2079-03-12 03:00:01} {detroit y2038} {
+    clock format 3445830001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.681 {time zone boundary case 2079-10-29 01:59:59} {detroit y2038} {
-    clock format 3465784799 -format {%H:%M:%S %z %Z} \
+test clock-5.681 {time zone boundary case 2079-11-05 01:59:59} {detroit y2038} {
+    clock format 3466389599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.682 {time zone boundary case 2079-10-29 01:00:00} {detroit y2038} {
-    clock format 3465784800 -format {%H:%M:%S %z %Z} \
+test clock-5.682 {time zone boundary case 2079-11-05 01:00:00} {detroit y2038} {
+    clock format 3466389600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.683 {time zone boundary case 2079-10-29 01:00:01} {detroit y2038} {
-    clock format 3465784801 -format {%H:%M:%S %z %Z} \
+test clock-5.683 {time zone boundary case 2079-11-05 01:00:01} {detroit y2038} {
+    clock format 3466389601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.684 {time zone boundary case 2080-04-07 01:59:59} {detroit y2038} {
-    clock format 3479698799 -format {%H:%M:%S %z %Z} \
+test clock-5.684 {time zone boundary case 2080-03-10 01:59:59} {detroit y2038} {
+    clock format 3477279599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.685 {time zone boundary case 2080-04-07 03:00:00} {detroit y2038} {
-    clock format 3479698800 -format {%H:%M:%S %z %Z} \
+test clock-5.685 {time zone boundary case 2080-03-10 03:00:00} {detroit y2038} {
+    clock format 3477279600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.686 {time zone boundary case 2080-04-07 03:00:01} {detroit y2038} {
-    clock format 3479698801 -format {%H:%M:%S %z %Z} \
+test clock-5.686 {time zone boundary case 2080-03-10 03:00:01} {detroit y2038} {
+    clock format 3477279601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.687 {time zone boundary case 2080-10-27 01:59:59} {detroit y2038} {
-    clock format 3497234399 -format {%H:%M:%S %z %Z} \
+test clock-5.687 {time zone boundary case 2080-11-03 01:59:59} {detroit y2038} {
+    clock format 3497839199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.688 {time zone boundary case 2080-10-27 01:00:00} {detroit y2038} {
-    clock format 3497234400 -format {%H:%M:%S %z %Z} \
+test clock-5.688 {time zone boundary case 2080-11-03 01:00:00} {detroit y2038} {
+    clock format 3497839200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.689 {time zone boundary case 2080-10-27 01:00:01} {detroit y2038} {
-    clock format 3497234401 -format {%H:%M:%S %z %Z} \
+test clock-5.689 {time zone boundary case 2080-11-03 01:00:01} {detroit y2038} {
+    clock format 3497839201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.690 {time zone boundary case 2081-04-06 01:59:59} {detroit y2038} {
-    clock format 3511148399 -format {%H:%M:%S %z %Z} \
+test clock-5.690 {time zone boundary case 2081-03-09 01:59:59} {detroit y2038} {
+    clock format 3508729199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.691 {time zone boundary case 2081-04-06 03:00:00} {detroit y2038} {
-    clock format 3511148400 -format {%H:%M:%S %z %Z} \
+test clock-5.691 {time zone boundary case 2081-03-09 03:00:00} {detroit y2038} {
+    clock format 3508729200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.692 {time zone boundary case 2081-04-06 03:00:01} {detroit y2038} {
-    clock format 3511148401 -format {%H:%M:%S %z %Z} \
+test clock-5.692 {time zone boundary case 2081-03-09 03:00:01} {detroit y2038} {
+    clock format 3508729201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.693 {time zone boundary case 2081-10-26 01:59:59} {detroit y2038} {
-    clock format 3528683999 -format {%H:%M:%S %z %Z} \
+test clock-5.693 {time zone boundary case 2081-11-02 01:59:59} {detroit y2038} {
+    clock format 3529288799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.694 {time zone boundary case 2081-10-26 01:00:00} {detroit y2038} {
-    clock format 3528684000 -format {%H:%M:%S %z %Z} \
+test clock-5.694 {time zone boundary case 2081-11-02 01:00:00} {detroit y2038} {
+    clock format 3529288800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.695 {time zone boundary case 2081-10-26 01:00:01} {detroit y2038} {
-    clock format 3528684001 -format {%H:%M:%S %z %Z} \
+test clock-5.695 {time zone boundary case 2081-11-02 01:00:01} {detroit y2038} {
+    clock format 3529288801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.696 {time zone boundary case 2082-04-05 01:59:59} {detroit y2038} {
-    clock format 3542597999 -format {%H:%M:%S %z %Z} \
+test clock-5.696 {time zone boundary case 2082-03-08 01:59:59} {detroit y2038} {
+    clock format 3540178799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.697 {time zone boundary case 2082-04-05 03:00:00} {detroit y2038} {
-    clock format 3542598000 -format {%H:%M:%S %z %Z} \
+test clock-5.697 {time zone boundary case 2082-03-08 03:00:00} {detroit y2038} {
+    clock format 3540178800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.698 {time zone boundary case 2082-04-05 03:00:01} {detroit y2038} {
-    clock format 3542598001 -format {%H:%M:%S %z %Z} \
+test clock-5.698 {time zone boundary case 2082-03-08 03:00:01} {detroit y2038} {
+    clock format 3540178801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.699 {time zone boundary case 2082-10-25 01:59:59} {detroit y2038} {
-    clock format 3560133599 -format {%H:%M:%S %z %Z} \
+test clock-5.699 {time zone boundary case 2082-11-01 01:59:59} {detroit y2038} {
+    clock format 3560738399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.700 {time zone boundary case 2082-10-25 01:00:00} {detroit y2038} {
-    clock format 3560133600 -format {%H:%M:%S %z %Z} \
+test clock-5.700 {time zone boundary case 2082-11-01 01:00:00} {detroit y2038} {
+    clock format 3560738400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.701 {time zone boundary case 2082-10-25 01:00:01} {detroit y2038} {
-    clock format 3560133601 -format {%H:%M:%S %z %Z} \
+test clock-5.701 {time zone boundary case 2082-11-01 01:00:01} {detroit y2038} {
+    clock format 3560738401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.702 {time zone boundary case 2083-04-04 01:59:59} {detroit y2038} {
-    clock format 3574047599 -format {%H:%M:%S %z %Z} \
+test clock-5.702 {time zone boundary case 2083-03-14 01:59:59} {detroit y2038} {
+    clock format 3572233199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.703 {time zone boundary case 2083-04-04 03:00:00} {detroit y2038} {
-    clock format 3574047600 -format {%H:%M:%S %z %Z} \
+test clock-5.703 {time zone boundary case 2083-03-14 03:00:00} {detroit y2038} {
+    clock format 3572233200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.704 {time zone boundary case 2083-04-04 03:00:01} {detroit y2038} {
-    clock format 3574047601 -format {%H:%M:%S %z %Z} \
+test clock-5.704 {time zone boundary case 2083-03-14 03:00:01} {detroit y2038} {
+    clock format 3572233201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.705 {time zone boundary case 2083-10-31 01:59:59} {detroit y2038} {
-    clock format 3592187999 -format {%H:%M:%S %z %Z} \
+test clock-5.705 {time zone boundary case 2083-11-07 01:59:59} {detroit y2038} {
+    clock format 3592792799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.706 {time zone boundary case 2083-10-31 01:00:00} {detroit y2038} {
-    clock format 3592188000 -format {%H:%M:%S %z %Z} \
+test clock-5.706 {time zone boundary case 2083-11-07 01:00:00} {detroit y2038} {
+    clock format 3592792800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.707 {time zone boundary case 2083-10-31 01:00:01} {detroit y2038} {
-    clock format 3592188001 -format {%H:%M:%S %z %Z} \
+test clock-5.707 {time zone boundary case 2083-11-07 01:00:01} {detroit y2038} {
+    clock format 3592792801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.708 {time zone boundary case 2084-04-02 01:59:59} {detroit y2038} {
-    clock format 3605497199 -format {%H:%M:%S %z %Z} \
+test clock-5.708 {time zone boundary case 2084-03-12 01:59:59} {detroit y2038} {
+    clock format 3603682799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.709 {time zone boundary case 2084-04-02 03:00:00} {detroit y2038} {
-    clock format 3605497200 -format {%H:%M:%S %z %Z} \
+test clock-5.709 {time zone boundary case 2084-03-12 03:00:00} {detroit y2038} {
+    clock format 3603682800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.710 {time zone boundary case 2084-04-02 03:00:01} {detroit y2038} {
-    clock format 3605497201 -format {%H:%M:%S %z %Z} \
+test clock-5.710 {time zone boundary case 2084-03-12 03:00:01} {detroit y2038} {
+    clock format 3603682801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.711 {time zone boundary case 2084-10-29 01:59:59} {detroit y2038} {
-    clock format 3623637599 -format {%H:%M:%S %z %Z} \
+test clock-5.711 {time zone boundary case 2084-11-05 01:59:59} {detroit y2038} {
+    clock format 3624242399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.712 {time zone boundary case 2084-10-29 01:00:00} {detroit y2038} {
-    clock format 3623637600 -format {%H:%M:%S %z %Z} \
+test clock-5.712 {time zone boundary case 2084-11-05 01:00:00} {detroit y2038} {
+    clock format 3624242400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.713 {time zone boundary case 2084-10-29 01:00:01} {detroit y2038} {
-    clock format 3623637601 -format {%H:%M:%S %z %Z} \
+test clock-5.713 {time zone boundary case 2084-11-05 01:00:01} {detroit y2038} {
+    clock format 3624242401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.714 {time zone boundary case 2085-04-01 01:59:59} {detroit y2038} {
-    clock format 3636946799 -format {%H:%M:%S %z %Z} \
+test clock-5.714 {time zone boundary case 2085-03-11 01:59:59} {detroit y2038} {
+    clock format 3635132399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.715 {time zone boundary case 2085-04-01 03:00:00} {detroit y2038} {
-    clock format 3636946800 -format {%H:%M:%S %z %Z} \
+test clock-5.715 {time zone boundary case 2085-03-11 03:00:00} {detroit y2038} {
+    clock format 3635132400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.716 {time zone boundary case 2085-04-01 03:00:01} {detroit y2038} {
-    clock format 3636946801 -format {%H:%M:%S %z %Z} \
+test clock-5.716 {time zone boundary case 2085-03-11 03:00:01} {detroit y2038} {
+    clock format 3635132401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.717 {time zone boundary case 2085-10-28 01:59:59} {detroit y2038} {
-    clock format 3655087199 -format {%H:%M:%S %z %Z} \
+test clock-5.717 {time zone boundary case 2085-11-04 01:59:59} {detroit y2038} {
+    clock format 3655691999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.718 {time zone boundary case 2085-10-28 01:00:00} {detroit y2038} {
-    clock format 3655087200 -format {%H:%M:%S %z %Z} \
+test clock-5.718 {time zone boundary case 2085-11-04 01:00:00} {detroit y2038} {
+    clock format 3655692000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.719 {time zone boundary case 2085-10-28 01:00:01} {detroit y2038} {
-    clock format 3655087201 -format {%H:%M:%S %z %Z} \
+test clock-5.719 {time zone boundary case 2085-11-04 01:00:01} {detroit y2038} {
+    clock format 3655692001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.720 {time zone boundary case 2086-04-07 01:59:59} {detroit y2038} {
-    clock format 3669001199 -format {%H:%M:%S %z %Z} \
+test clock-5.720 {time zone boundary case 2086-03-10 01:59:59} {detroit y2038} {
+    clock format 3666581999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.721 {time zone boundary case 2086-04-07 03:00:00} {detroit y2038} {
-    clock format 3669001200 -format {%H:%M:%S %z %Z} \
+test clock-5.721 {time zone boundary case 2086-03-10 03:00:00} {detroit y2038} {
+    clock format 3666582000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.722 {time zone boundary case 2086-04-07 03:00:01} {detroit y2038} {
-    clock format 3669001201 -format {%H:%M:%S %z %Z} \
+test clock-5.722 {time zone boundary case 2086-03-10 03:00:01} {detroit y2038} {
+    clock format 3666582001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.723 {time zone boundary case 2086-10-27 01:59:59} {detroit y2038} {
-    clock format 3686536799 -format {%H:%M:%S %z %Z} \
+test clock-5.723 {time zone boundary case 2086-11-03 01:59:59} {detroit y2038} {
+    clock format 3687141599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.724 {time zone boundary case 2086-10-27 01:00:00} {detroit y2038} {
-    clock format 3686536800 -format {%H:%M:%S %z %Z} \
+test clock-5.724 {time zone boundary case 2086-11-03 01:00:00} {detroit y2038} {
+    clock format 3687141600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.725 {time zone boundary case 2086-10-27 01:00:01} {detroit y2038} {
-    clock format 3686536801 -format {%H:%M:%S %z %Z} \
+test clock-5.725 {time zone boundary case 2086-11-03 01:00:01} {detroit y2038} {
+    clock format 3687141601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.726 {time zone boundary case 2087-04-06 01:59:59} {detroit y2038} {
-    clock format 3700450799 -format {%H:%M:%S %z %Z} \
+test clock-5.726 {time zone boundary case 2087-03-09 01:59:59} {detroit y2038} {
+    clock format 3698031599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.727 {time zone boundary case 2087-04-06 03:00:00} {detroit y2038} {
-    clock format 3700450800 -format {%H:%M:%S %z %Z} \
+test clock-5.727 {time zone boundary case 2087-03-09 03:00:00} {detroit y2038} {
+    clock format 3698031600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.728 {time zone boundary case 2087-04-06 03:00:01} {detroit y2038} {
-    clock format 3700450801 -format {%H:%M:%S %z %Z} \
+test clock-5.728 {time zone boundary case 2087-03-09 03:00:01} {detroit y2038} {
+    clock format 3698031601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.729 {time zone boundary case 2087-10-26 01:59:59} {detroit y2038} {
-    clock format 3717986399 -format {%H:%M:%S %z %Z} \
+test clock-5.729 {time zone boundary case 2087-11-02 01:59:59} {detroit y2038} {
+    clock format 3718591199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.730 {time zone boundary case 2087-10-26 01:00:00} {detroit y2038} {
-    clock format 3717986400 -format {%H:%M:%S %z %Z} \
+test clock-5.730 {time zone boundary case 2087-11-02 01:00:00} {detroit y2038} {
+    clock format 3718591200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.731 {time zone boundary case 2087-10-26 01:00:01} {detroit y2038} {
-    clock format 3717986401 -format {%H:%M:%S %z %Z} \
+test clock-5.731 {time zone boundary case 2087-11-02 01:00:01} {detroit y2038} {
+    clock format 3718591201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.732 {time zone boundary case 2088-04-04 01:59:59} {detroit y2038} {
-    clock format 3731900399 -format {%H:%M:%S %z %Z} \
+test clock-5.732 {time zone boundary case 2088-03-14 01:59:59} {detroit y2038} {
+    clock format 3730085999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.733 {time zone boundary case 2088-04-04 03:00:00} {detroit y2038} {
-    clock format 3731900400 -format {%H:%M:%S %z %Z} \
+test clock-5.733 {time zone boundary case 2088-03-14 03:00:00} {detroit y2038} {
+    clock format 3730086000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.734 {time zone boundary case 2088-04-04 03:00:01} {detroit y2038} {
-    clock format 3731900401 -format {%H:%M:%S %z %Z} \
+test clock-5.734 {time zone boundary case 2088-03-14 03:00:01} {detroit y2038} {
+    clock format 3730086001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.735 {time zone boundary case 2088-10-31 01:59:59} {detroit y2038} {
-    clock format 3750040799 -format {%H:%M:%S %z %Z} \
+test clock-5.735 {time zone boundary case 2088-11-07 01:59:59} {detroit y2038} {
+    clock format 3750645599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.736 {time zone boundary case 2088-10-31 01:00:00} {detroit y2038} {
-    clock format 3750040800 -format {%H:%M:%S %z %Z} \
+test clock-5.736 {time zone boundary case 2088-11-07 01:00:00} {detroit y2038} {
+    clock format 3750645600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.737 {time zone boundary case 2088-10-31 01:00:01} {detroit y2038} {
-    clock format 3750040801 -format {%H:%M:%S %z %Z} \
+test clock-5.737 {time zone boundary case 2088-11-07 01:00:01} {detroit y2038} {
+    clock format 3750645601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.738 {time zone boundary case 2089-04-03 01:59:59} {detroit y2038} {
-    clock format 3763349999 -format {%H:%M:%S %z %Z} \
+test clock-5.738 {time zone boundary case 2089-03-13 01:59:59} {detroit y2038} {
+    clock format 3761535599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.739 {time zone boundary case 2089-04-03 03:00:00} {detroit y2038} {
-    clock format 3763350000 -format {%H:%M:%S %z %Z} \
+test clock-5.739 {time zone boundary case 2089-03-13 03:00:00} {detroit y2038} {
+    clock format 3761535600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.740 {time zone boundary case 2089-04-03 03:00:01} {detroit y2038} {
-    clock format 3763350001 -format {%H:%M:%S %z %Z} \
+test clock-5.740 {time zone boundary case 2089-03-13 03:00:01} {detroit y2038} {
+    clock format 3761535601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.741 {time zone boundary case 2089-10-30 01:59:59} {detroit y2038} {
-    clock format 3781490399 -format {%H:%M:%S %z %Z} \
+test clock-5.741 {time zone boundary case 2089-11-06 01:59:59} {detroit y2038} {
+    clock format 3782095199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.742 {time zone boundary case 2089-10-30 01:00:00} {detroit y2038} {
-    clock format 3781490400 -format {%H:%M:%S %z %Z} \
+test clock-5.742 {time zone boundary case 2089-11-06 01:00:00} {detroit y2038} {
+    clock format 3782095200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.743 {time zone boundary case 2089-10-30 01:00:01} {detroit y2038} {
-    clock format 3781490401 -format {%H:%M:%S %z %Z} \
+test clock-5.743 {time zone boundary case 2089-11-06 01:00:01} {detroit y2038} {
+    clock format 3782095201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.744 {time zone boundary case 2090-04-02 01:59:59} {detroit y2038} {
-    clock format 3794799599 -format {%H:%M:%S %z %Z} \
+test clock-5.744 {time zone boundary case 2090-03-12 01:59:59} {detroit y2038} {
+    clock format 3792985199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.745 {time zone boundary case 2090-04-02 03:00:00} {detroit y2038} {
-    clock format 3794799600 -format {%H:%M:%S %z %Z} \
+test clock-5.745 {time zone boundary case 2090-03-12 03:00:00} {detroit y2038} {
+    clock format 3792985200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.746 {time zone boundary case 2090-04-02 03:00:01} {detroit y2038} {
-    clock format 3794799601 -format {%H:%M:%S %z %Z} \
+test clock-5.746 {time zone boundary case 2090-03-12 03:00:01} {detroit y2038} {
+    clock format 3792985201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.747 {time zone boundary case 2090-10-29 01:59:59} {detroit y2038} {
-    clock format 3812939999 -format {%H:%M:%S %z %Z} \
+test clock-5.747 {time zone boundary case 2090-11-05 01:59:59} {detroit y2038} {
+    clock format 3813544799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.748 {time zone boundary case 2090-10-29 01:00:00} {detroit y2038} {
-    clock format 3812940000 -format {%H:%M:%S %z %Z} \
+test clock-5.748 {time zone boundary case 2090-11-05 01:00:00} {detroit y2038} {
+    clock format 3813544800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.749 {time zone boundary case 2090-10-29 01:00:01} {detroit y2038} {
-    clock format 3812940001 -format {%H:%M:%S %z %Z} \
+test clock-5.749 {time zone boundary case 2090-11-05 01:00:01} {detroit y2038} {
+    clock format 3813544801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.750 {time zone boundary case 2091-04-01 01:59:59} {detroit y2038} {
-    clock format 3826249199 -format {%H:%M:%S %z %Z} \
+test clock-5.750 {time zone boundary case 2091-03-11 01:59:59} {detroit y2038} {
+    clock format 3824434799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.751 {time zone boundary case 2091-04-01 03:00:00} {detroit y2038} {
-    clock format 3826249200 -format {%H:%M:%S %z %Z} \
+test clock-5.751 {time zone boundary case 2091-03-11 03:00:00} {detroit y2038} {
+    clock format 3824434800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.752 {time zone boundary case 2091-04-01 03:00:01} {detroit y2038} {
-    clock format 3826249201 -format {%H:%M:%S %z %Z} \
+test clock-5.752 {time zone boundary case 2091-03-11 03:00:01} {detroit y2038} {
+    clock format 3824434801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.753 {time zone boundary case 2091-10-28 01:59:59} {detroit y2038} {
-    clock format 3844389599 -format {%H:%M:%S %z %Z} \
+test clock-5.753 {time zone boundary case 2091-11-04 01:59:59} {detroit y2038} {
+    clock format 3844994399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.754 {time zone boundary case 2091-10-28 01:00:00} {detroit y2038} {
-    clock format 3844389600 -format {%H:%M:%S %z %Z} \
+test clock-5.754 {time zone boundary case 2091-11-04 01:00:00} {detroit y2038} {
+    clock format 3844994400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.755 {time zone boundary case 2091-10-28 01:00:01} {detroit y2038} {
-    clock format 3844389601 -format {%H:%M:%S %z %Z} \
+test clock-5.755 {time zone boundary case 2091-11-04 01:00:01} {detroit y2038} {
+    clock format 3844994401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.756 {time zone boundary case 2092-04-06 01:59:59} {detroit y2038} {
-    clock format 3858303599 -format {%H:%M:%S %z %Z} \
+test clock-5.756 {time zone boundary case 2092-03-09 01:59:59} {detroit y2038} {
+    clock format 3855884399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.757 {time zone boundary case 2092-04-06 03:00:00} {detroit y2038} {
-    clock format 3858303600 -format {%H:%M:%S %z %Z} \
+test clock-5.757 {time zone boundary case 2092-03-09 03:00:00} {detroit y2038} {
+    clock format 3855884400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.758 {time zone boundary case 2092-04-06 03:00:01} {detroit y2038} {
-    clock format 3858303601 -format {%H:%M:%S %z %Z} \
+test clock-5.758 {time zone boundary case 2092-03-09 03:00:01} {detroit y2038} {
+    clock format 3855884401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.759 {time zone boundary case 2092-10-26 01:59:59} {detroit y2038} {
-    clock format 3875839199 -format {%H:%M:%S %z %Z} \
+test clock-5.759 {time zone boundary case 2092-11-02 01:59:59} {detroit y2038} {
+    clock format 3876443999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.760 {time zone boundary case 2092-10-26 01:00:00} {detroit y2038} {
-    clock format 3875839200 -format {%H:%M:%S %z %Z} \
+test clock-5.760 {time zone boundary case 2092-11-02 01:00:00} {detroit y2038} {
+    clock format 3876444000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.761 {time zone boundary case 2092-10-26 01:00:01} {detroit y2038} {
-    clock format 3875839201 -format {%H:%M:%S %z %Z} \
+test clock-5.761 {time zone boundary case 2092-11-02 01:00:01} {detroit y2038} {
+    clock format 3876444001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.762 {time zone boundary case 2093-04-05 01:59:59} {detroit y2038} {
-    clock format 3889753199 -format {%H:%M:%S %z %Z} \
+test clock-5.762 {time zone boundary case 2093-03-08 01:59:59} {detroit y2038} {
+    clock format 3887333999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.763 {time zone boundary case 2093-04-05 03:00:00} {detroit y2038} {
-    clock format 3889753200 -format {%H:%M:%S %z %Z} \
+test clock-5.763 {time zone boundary case 2093-03-08 03:00:00} {detroit y2038} {
+    clock format 3887334000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.764 {time zone boundary case 2093-04-05 03:00:01} {detroit y2038} {
-    clock format 3889753201 -format {%H:%M:%S %z %Z} \
+test clock-5.764 {time zone boundary case 2093-03-08 03:00:01} {detroit y2038} {
+    clock format 3887334001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.765 {time zone boundary case 2093-10-25 01:59:59} {detroit y2038} {
-    clock format 3907288799 -format {%H:%M:%S %z %Z} \
+test clock-5.765 {time zone boundary case 2093-11-01 01:59:59} {detroit y2038} {
+    clock format 3907893599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.766 {time zone boundary case 2093-10-25 01:00:00} {detroit y2038} {
-    clock format 3907288800 -format {%H:%M:%S %z %Z} \
+test clock-5.766 {time zone boundary case 2093-11-01 01:00:00} {detroit y2038} {
+    clock format 3907893600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.767 {time zone boundary case 2093-10-25 01:00:01} {detroit y2038} {
-    clock format 3907288801 -format {%H:%M:%S %z %Z} \
+test clock-5.767 {time zone boundary case 2093-11-01 01:00:01} {detroit y2038} {
+    clock format 3907893601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.768 {time zone boundary case 2094-04-04 01:59:59} {detroit y2038} {
-    clock format 3921202799 -format {%H:%M:%S %z %Z} \
+test clock-5.768 {time zone boundary case 2094-03-14 01:59:59} {detroit y2038} {
+    clock format 3919388399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.769 {time zone boundary case 2094-04-04 03:00:00} {detroit y2038} {
-    clock format 3921202800 -format {%H:%M:%S %z %Z} \
+test clock-5.769 {time zone boundary case 2094-03-14 03:00:00} {detroit y2038} {
+    clock format 3919388400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.770 {time zone boundary case 2094-04-04 03:00:01} {detroit y2038} {
-    clock format 3921202801 -format {%H:%M:%S %z %Z} \
+test clock-5.770 {time zone boundary case 2094-03-14 03:00:01} {detroit y2038} {
+    clock format 3919388401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.771 {time zone boundary case 2094-10-31 01:59:59} {detroit y2038} {
-    clock format 3939343199 -format {%H:%M:%S %z %Z} \
+test clock-5.771 {time zone boundary case 2094-11-07 01:59:59} {detroit y2038} {
+    clock format 3939947999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.772 {time zone boundary case 2094-10-31 01:00:00} {detroit y2038} {
-    clock format 3939343200 -format {%H:%M:%S %z %Z} \
+test clock-5.772 {time zone boundary case 2094-11-07 01:00:00} {detroit y2038} {
+    clock format 3939948000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.773 {time zone boundary case 2094-10-31 01:00:01} {detroit y2038} {
-    clock format 3939343201 -format {%H:%M:%S %z %Z} \
+test clock-5.773 {time zone boundary case 2094-11-07 01:00:01} {detroit y2038} {
+    clock format 3939948001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.774 {time zone boundary case 2095-04-03 01:59:59} {detroit y2038} {
-    clock format 3952652399 -format {%H:%M:%S %z %Z} \
+test clock-5.774 {time zone boundary case 2095-03-13 01:59:59} {detroit y2038} {
+    clock format 3950837999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.775 {time zone boundary case 2095-04-03 03:00:00} {detroit y2038} {
-    clock format 3952652400 -format {%H:%M:%S %z %Z} \
+test clock-5.775 {time zone boundary case 2095-03-13 03:00:00} {detroit y2038} {
+    clock format 3950838000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.776 {time zone boundary case 2095-04-03 03:00:01} {detroit y2038} {
-    clock format 3952652401 -format {%H:%M:%S %z %Z} \
+test clock-5.776 {time zone boundary case 2095-03-13 03:00:01} {detroit y2038} {
+    clock format 3950838001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.777 {time zone boundary case 2095-10-30 01:59:59} {detroit y2038} {
-    clock format 3970792799 -format {%H:%M:%S %z %Z} \
+test clock-5.777 {time zone boundary case 2095-11-06 01:59:59} {detroit y2038} {
+    clock format 3971397599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.778 {time zone boundary case 2095-10-30 01:00:00} {detroit y2038} {
-    clock format 3970792800 -format {%H:%M:%S %z %Z} \
+test clock-5.778 {time zone boundary case 2095-11-06 01:00:00} {detroit y2038} {
+    clock format 3971397600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.779 {time zone boundary case 2095-10-30 01:00:01} {detroit y2038} {
-    clock format 3970792801 -format {%H:%M:%S %z %Z} \
+test clock-5.779 {time zone boundary case 2095-11-06 01:00:01} {detroit y2038} {
+    clock format 3971397601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.780 {time zone boundary case 2096-04-01 01:59:59} {detroit y2038} {
-    clock format 3984101999 -format {%H:%M:%S %z %Z} \
+test clock-5.780 {time zone boundary case 2096-03-11 01:59:59} {detroit y2038} {
+    clock format 3982287599 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.781 {time zone boundary case 2096-04-01 03:00:00} {detroit y2038} {
-    clock format 3984102000 -format {%H:%M:%S %z %Z} \
+test clock-5.781 {time zone boundary case 2096-03-11 03:00:00} {detroit y2038} {
+    clock format 3982287600 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.782 {time zone boundary case 2096-04-01 03:00:01} {detroit y2038} {
-    clock format 3984102001 -format {%H:%M:%S %z %Z} \
+test clock-5.782 {time zone boundary case 2096-03-11 03:00:01} {detroit y2038} {
+    clock format 3982287601 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.783 {time zone boundary case 2096-10-28 01:59:59} {detroit y2038} {
-    clock format 4002242399 -format {%H:%M:%S %z %Z} \
+test clock-5.783 {time zone boundary case 2096-11-04 01:59:59} {detroit y2038} {
+    clock format 4002847199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.784 {time zone boundary case 2096-10-28 01:00:00} {detroit y2038} {
-    clock format 4002242400 -format {%H:%M:%S %z %Z} \
+test clock-5.784 {time zone boundary case 2096-11-04 01:00:00} {detroit y2038} {
+    clock format 4002847200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.785 {time zone boundary case 2096-10-28 01:00:01} {detroit y2038} {
-    clock format 4002242401 -format {%H:%M:%S %z %Z} \
+test clock-5.785 {time zone boundary case 2096-11-04 01:00:01} {detroit y2038} {
+    clock format 4002847201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.786 {time zone boundary case 2097-04-07 01:59:59} {detroit y2038} {
-    clock format 4016156399 -format {%H:%M:%S %z %Z} \
+test clock-5.786 {time zone boundary case 2097-03-10 01:59:59} {detroit y2038} {
+    clock format 4013737199 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.787 {time zone boundary case 2097-04-07 03:00:00} {detroit y2038} {
-    clock format 4016156400 -format {%H:%M:%S %z %Z} \
+test clock-5.787 {time zone boundary case 2097-03-10 03:00:00} {detroit y2038} {
+    clock format 4013737200 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.788 {time zone boundary case 2097-04-07 03:00:01} {detroit y2038} {
-    clock format 4016156401 -format {%H:%M:%S %z %Z} \
+test clock-5.788 {time zone boundary case 2097-03-10 03:00:01} {detroit y2038} {
+    clock format 4013737201 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.789 {time zone boundary case 2097-10-27 01:59:59} {detroit y2038} {
-    clock format 4033691999 -format {%H:%M:%S %z %Z} \
+test clock-5.789 {time zone boundary case 2097-11-03 01:59:59} {detroit y2038} {
+    clock format 4034296799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.790 {time zone boundary case 2097-10-27 01:00:00} {detroit y2038} {
-    clock format 4033692000 -format {%H:%M:%S %z %Z} \
+test clock-5.790 {time zone boundary case 2097-11-03 01:00:00} {detroit y2038} {
+    clock format 4034296800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.791 {time zone boundary case 2097-10-27 01:00:01} {detroit y2038} {
-    clock format 4033692001 -format {%H:%M:%S %z %Z} \
+test clock-5.791 {time zone boundary case 2097-11-03 01:00:01} {detroit y2038} {
+    clock format 4034296801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.792 {time zone boundary case 2098-04-06 01:59:59} {detroit y2038} {
-    clock format 4047605999 -format {%H:%M:%S %z %Z} \
+test clock-5.792 {time zone boundary case 2098-03-09 01:59:59} {detroit y2038} {
+    clock format 4045186799 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.793 {time zone boundary case 2098-04-06 03:00:00} {detroit y2038} {
-    clock format 4047606000 -format {%H:%M:%S %z %Z} \
+test clock-5.793 {time zone boundary case 2098-03-09 03:00:00} {detroit y2038} {
+    clock format 4045186800 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.794 {time zone boundary case 2098-04-06 03:00:01} {detroit y2038} {
-    clock format 4047606001 -format {%H:%M:%S %z %Z} \
+test clock-5.794 {time zone boundary case 2098-03-09 03:00:01} {detroit y2038} {
+    clock format 4045186801 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.795 {time zone boundary case 2098-10-26 01:59:59} {detroit y2038} {
-    clock format 4065141599 -format {%H:%M:%S %z %Z} \
+test clock-5.795 {time zone boundary case 2098-11-02 01:59:59} {detroit y2038} {
+    clock format 4065746399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.796 {time zone boundary case 2098-10-26 01:00:00} {detroit y2038} {
-    clock format 4065141600 -format {%H:%M:%S %z %Z} \
+test clock-5.796 {time zone boundary case 2098-11-02 01:00:00} {detroit y2038} {
+    clock format 4065746400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.797 {time zone boundary case 2098-10-26 01:00:01} {detroit y2038} {
-    clock format 4065141601 -format {%H:%M:%S %z %Z} \
+test clock-5.797 {time zone boundary case 2098-11-02 01:00:01} {detroit y2038} {
+    clock format 4065746401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
-test clock-5.798 {time zone boundary case 2099-04-05 01:59:59} {detroit y2038} {
-    clock format 4079055599 -format {%H:%M:%S %z %Z} \
+test clock-5.798 {time zone boundary case 2099-03-08 01:59:59} {detroit y2038} {
+    clock format 4076636399 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0500 EST}
-test clock-5.799 {time zone boundary case 2099-04-05 03:00:00} {detroit y2038} {
-    clock format 4079055600 -format {%H:%M:%S %z %Z} \
+test clock-5.799 {time zone boundary case 2099-03-08 03:00:00} {detroit y2038} {
+    clock format 4076636400 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:00 -0400 EDT}
-test clock-5.800 {time zone boundary case 2099-04-05 03:00:01} {detroit y2038} {
-    clock format 4079055601 -format {%H:%M:%S %z %Z} \
+test clock-5.800 {time zone boundary case 2099-03-08 03:00:01} {detroit y2038} {
+    clock format 4076636401 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {03:00:01 -0400 EDT}
-test clock-5.801 {time zone boundary case 2099-10-25 01:59:59} {detroit y2038} {
-    clock format 4096591199 -format {%H:%M:%S %z %Z} \
+test clock-5.801 {time zone boundary case 2099-11-01 01:59:59} {detroit y2038} {
+    clock format 4097195999 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:59:59 -0400 EDT}
-test clock-5.802 {time zone boundary case 2099-10-25 01:00:00} {detroit y2038} {
-    clock format 4096591200 -format {%H:%M:%S %z %Z} \
+test clock-5.802 {time zone boundary case 2099-11-01 01:00:00} {detroit y2038} {
+    clock format 4097196000 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:00 -0500 EST}
-test clock-5.803 {time zone boundary case 2099-10-25 01:00:01} {detroit y2038} {
-    clock format 4096591201 -format {%H:%M:%S %z %Z} \
+test clock-5.803 {time zone boundary case 2099-11-01 01:00:01} {detroit y2038} {
+    clock format 4097196001 -format {%H:%M:%S %z %Z} \
         -timezone :America/Detroit
 } {01:00:01 -0500 EST}
 # END testcases5
@@ -34536,56 +35056,78 @@ test clock-30.9 {clock add days} {
 } {{2000-01-02 12:34:56} {1999-12-31 12:34:56}}
 test clock-30.10 {clock add days, spring DST conversion, before} {
     set t [clock scan {2004-04-03 01:59:59} -format {%Y-%m-%d %H:%M:%S} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 1 day -timezone EST5EDT]
-    set f2 [clock add $t 2 days -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
-    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 1 day \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f2 [clock add $t 2 days \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
     list $x1 $x2
 } {{2004-04-04 01:59:59 -0500} {2004-04-05 01:59:59 -0400}}
 test clock-30.11 {clock add days, spring DST conversion, bad case} {
     set t [clock scan {2004-04-03 02:30:00} -format {%Y-%m-%d %H:%M:%S} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 1 day -timezone EST5EDT]
-    set f2 [clock add $t 2 day -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
-    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 1 day \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f2 [clock add $t 2 day \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
     list $x1 $x2
 } {{2004-04-04 03:30:00 -0400} {2004-04-05 02:30:00 -0400}}
 test clock-30.12 {clock add days, spring DST conversion, after} {
     set t [clock scan {2004-04-03 03:00:00} -format {%Y-%m-%d %H:%M:%S} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 1 day -timezone EST5EDT]
-    set f2 [clock add $t 2 day -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
-    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 1 day -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f2 [clock add $t 2 day -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
     list $x1 $x2
 } {{2004-04-04 03:00:00 -0400} {2004-04-05 03:00:00 -0400}}
 test clock-30.13 {clock add days, fall DST conversion, before} {
     set t [clock scan {2004-10-30 00:59:59} -format {%Y-%m-%d %H:%M:%S} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 1 day -timezone EST5EDT]
-    set f2 [clock add $t 2 day -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
-    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 1 day \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f2 [clock add $t 2 day \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
     list $x1 $x2
 } {{2004-10-31 00:59:59 -0400} {2004-11-01 00:59:59 -0500}}
 test clock-30.14 {clock add days, fall DST conversion, bad case} {
     set t [clock scan {2004-10-30 01:30:00} -format {%Y-%m-%d %H:%M:%S} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 1 day -timezone EST5EDT]
-    set f2 [clock add $t 2 day -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
-    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 1 day \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f2 [clock add $t 2 day \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
     list $x1 $x2
 } {{2004-10-31 01:30:00 -0400} {2004-11-01 01:30:00 -0500}}
 test clock-30.15 {clock add days, fall DST conversion, after} {
     set t [clock scan {2004-10-30 02:30:00} -format {%Y-%m-%d %H:%M:%S} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 1 day -timezone EST5EDT]
-    set f2 [clock add $t 2 day -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
-    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 1 day \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f2 [clock add $t 2 day \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x2 [clock format $f2 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
     list $x1 $x2
 } {{2004-10-31 02:30:00 -0500} {2004-11-01 02:30:00 -0500}}
 test clock-30.16 {clock add weeks} {
@@ -34609,16 +35151,19 @@ test clock-30.17 {clock add hours} {
 test clock-30.18 {clock add hours at DST conversion} {
     set t [clock scan {2004-04-04 01:00:00 -0500} \
 	       -format {%Y-%m-%d %H:%M:%S %z} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 1 hour -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 1 hour -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
 } {2004-04-04 03:00:00 -0400}
 test clock-30.19 {clock add hours at DST conversion} {
     set t [clock scan {2004-10-31 01:00:00 -0400} \
 	       -format {%Y-%m-%d %H:%M:%S %z} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 1 hour -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 1 hour \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
 } {2004-10-31 01:00:00 -0500}
 test clock-30.20 {clock add minutes} {
     set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \
@@ -34632,16 +35177,20 @@ test clock-30.20 {clock add minutes} {
 test clock-30.21 {clock add minutes at DST conversion} {
     set t [clock scan {2004-04-04 01:00:00 -0500} \
 	       -format {%Y-%m-%d %H:%M:%S %z} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 60 minutes -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 60 minutes \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
 } {2004-04-04 03:00:00 -0400}
 test clock-30.22 {clock add minutes at DST conversion} {
     set t [clock scan {2004-10-31 01:00:00 -0400} \
 	       -format {%Y-%m-%d %H:%M:%S %z} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 60 minutes -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 60 minutes \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
 } {2004-10-31 01:00:00 -0500}
 test clock-30.23 {clock add seconds} {
     set t [clock scan {2000-01-01 12:34:56} -format {%Y-%m-%d %H:%M:%S} \
@@ -34655,16 +35204,19 @@ test clock-30.23 {clock add seconds} {
 test clock-30.24 {clock add seconds at DST conversion} {
     set t [clock scan {2004-04-04 01:00:00 -0500} \
 	       -format {%Y-%m-%d %H:%M:%S %z} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 3600 seconds -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 3600 seconds \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
 } {2004-04-04 03:00:00 -0400}
 test clock-30.25 {clock add seconds at DST conversion} {
     set t [clock scan {2004-10-31 01:00:00 -0400} \
 	       -format {%Y-%m-%d %H:%M:%S %z} \
-	       -timezone EST5EDT]
-    set f1 [clock add $t 3600 seconds -timezone EST5EDT]
-    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} -timezone EST5EDT]
+	       -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set f1 [clock add $t 3600 seconds -timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
+    set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
+		-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
 } {2004-10-31 01:00:00 -0500}
 
 test clock-31.1 {system locale} \
@@ -34673,6 +35225,8 @@ test clock-31.1 {system locale} \
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
 	}
+	set noreg [info exists ::tcl::clock::NoRegistry]
+	if {$noreg} {unset ::tcl::clock::NoRegistry}
 	::tcl::clock::ClearCaches
     } \
     -body {
@@ -34682,6 +35236,7 @@ test clock-31.1 {system locale} \
 	namespace eval ::tcl::clock {
 	    rename registry {}
 	}
+	if {$noreg} {set ::tcl::clock::NoRegistry {}}
 	::tcl::clock::ClearCaches
     } \
     -result [clock format 0 -timezone :UTC -locale current \
@@ -34693,6 +35248,8 @@ test clock-31.2 {system locale} \
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
 	}
+	set noreg [info exists ::tcl::clock::NoRegistry]
+	if {$noreg} {unset ::tcl::clock::NoRegistry}
 	::tcl::clock::ClearCaches
     } \
     -body {
@@ -34702,6 +35259,7 @@ test clock-31.2 {system locale} \
 	namespace eval ::tcl::clock {
 	    rename registry {}
 	}
+	if {$noreg} {set ::tcl::clock::NoRegistry {}}
 	::tcl::clock::ClearCaches
     } \
     -result [clock format 0 -timezone :UTC -locale current \
@@ -34713,6 +35271,8 @@ test clock-31.3 {system locale} \
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
 	}
+	set noreg [info exists ::tcl::clock::NoRegistry]
+	if {$noreg} {unset ::tcl::clock::NoRegistry}
 	::tcl::clock::ClearCaches
     } \
     -body {
@@ -34722,6 +35282,7 @@ test clock-31.3 {system locale} \
 	namespace eval ::tcl::clock {
 	    rename registry {}
 	}
+	if {$noreg} {set ::tcl::clock::NoRegistry {}}
 	::tcl::clock::ClearCaches
     } \
     -result [clock format 0 -timezone :UTC -locale current \
@@ -34733,6 +35294,8 @@ test clock-31.4 {system locale} \
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
 	}
+	set noreg [info exists ::tcl::clock::NoRegistry]
+	if {$noreg} {unset ::tcl::clock::NoRegistry}
 	if { [info exists env(TZ)] } {
 	    set oldTZ $env(TZ)
 	    unset env(TZ)
@@ -34756,6 +35319,7 @@ test clock-31.4 {system locale} \
 	if { [info exists oldTZ] } {
 	    set env(TZ) $oldTZ
 	}
+	if {$noreg} {set ::tcl::clock::NoRegistry {}}
 	::tcl::clock::ClearCaches
     } \
     -result [clock format 0 -locale current -timezone EST5 \
@@ -34767,6 +35331,8 @@ test clock-31.5 {system locale} \
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
 	}
+	set noreg [info exists ::tcl::clock::NoRegistry]
+	if {$noreg} {unset ::tcl::clock::NoRegistry}
 	if { [info exists env(TZ)] } {
 	    set oldTZ $env(TZ)
 	    unset env(TZ)
@@ -34784,6 +35350,7 @@ test clock-31.5 {system locale} \
 	namespace eval ::tcl::clock {
 	    rename registry {}
 	}
+	if {$noreg} {set ::tcl::clock::NoRegistry {}}
 	if { [info exists oldTclTZ] } {
 	    set env(TCL_TZ) $oldTclTZ
 	}
@@ -34801,6 +35368,8 @@ test clock-31.6 {system locale} \
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
 	}
+	set noreg [info exists ::tcl::clock::NoRegistry]
+	if {$noreg} {unset ::tcl::clock::NoRegistry}
 	if { [info exists env(TZ)] } {
 	    set oldTZ $env(TZ)
 	    unset env(TZ)
@@ -34818,6 +35387,7 @@ test clock-31.6 {system locale} \
 	namespace eval ::tcl::clock {
 	    rename registry {}
 	}
+	if {$noreg} {set ::tcl::clock::NoRegistry {}}
 	if { [info exists oldTclTZ] } {
 	    set env(TCL_TZ) $oldTclTZ
 	}
@@ -34880,7 +35450,7 @@ test clock-33.2 {clock clicks tests} {
 } {1}
 test clock-33.3 {clock clicks tests} {
     list [catch {clock clicks foo} msg] $msg
-} {1 {bad option "foo": must be -milliseconds or -microseconds}}
+} {1 {bad switch "foo": must be -milliseconds or -microseconds}}
 test clock-33.4 {clock clicks tests} {
     expr [clock clicks -milliseconds]+1
     concat {}
@@ -34890,6 +35460,8 @@ test clock-33.4a {clock milliseconds} {
     concat {}
 } {}
 test clock-33.5 {clock clicks tests, millisecond timing test} {
+    # This test can fail on a system that is so heavily loaded that
+    # the test takes >60 ms to run.
     set start [clock clicks -milli]
     after 10
     set end [clock clicks -milli]
@@ -34900,6 +35472,8 @@ test clock-33.5 {clock clicks tests, millisecond timing test} {
 	  "test should have taken 0-60 ms, actually took [expr $end - $start]"}
 } {ok}
 test clock-33.5a {clock tests, millisecond timing test} {
+    # This test can fail on a system that is so heavily loaded that
+    # the test takes >60 ms to run.
     set start [clock milliseconds]
     after 10
     set end [clock milliseconds]
@@ -34910,19 +35484,23 @@ test clock-33.5a {clock tests, millisecond timing test} {
 	  "test should have taken 0-60 ms, actually took [expr $end - $start]"}
 } {ok}
 test clock-33.6 {clock clicks, milli with too much abbreviation} {
-    list [catch { clock clicks {} } msg] $msg
-} {1 {bad option "": must be -milliseconds or -microseconds}}
+    list [catch { clock clicks ? } msg] $msg
+} {1 {bad switch "?": must be -milliseconds or -microseconds}}
 test clock-33.7 {clock clicks, milli with too much abbreviation} {
     list [catch { clock clicks - } msg] $msg
-} {1 {ambiguous option "-": must be -milliseconds or -microseconds}}
+} {1 {ambiguous switch "-": must be -milliseconds or -microseconds}}
 
 test clock-33.8 {clock clicks test, microsecond timing test} {
+    # This test can fail on a system that is so heavily loaded that
+    # the test takes >60 ms to run.
     set start [clock clicks -micro]
     after 10
     set end [clock clicks -micro]
     expr {($end > $start) && (($end - $start) <= 60000)}
 } {1}
 test clock-33.8a {clock test, microsecond timing test} {
+    # This test can fail on a system that is so heavily loaded that
+    # the test takes >60 ms to run.
     set start [clock microseconds]
     after 10
     set end [clock microseconds]
@@ -34995,10 +35573,13 @@ test clock-33.11a {clock test, millis align with micros} {
 # clock scan
 test clock-34.1 {clock scan tests} {
     list [catch {clock scan} msg] $msg
-} {1 {wrong # args: should be "::tcl::clock::scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"}}
-test clock-34.2 {clock scan tests} {
-    list [catch {clock scan "bad-string"} msg] $msg
-} {1 {unable to convert date-time string "bad-string"}}
+} {1 {wrong # args: should be "clock scan string ?-base seconds? ?-format string? ?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?"}}
+test clock-34.2 {clock scan tests} {*}{
+    -body {clock scan "bad-string"}
+    -returnCodes error
+    -match glob
+    -result {unable to convert date-time string "bad-string"*}
+}
 test clock-34.3 {clock scan tests} {
     clock format [clock scan "14 Feb 92" -gmt true] \
       -format {%m/%d/%y %I:%M:%S %p} -gmt true
@@ -35222,6 +35803,38 @@ test clock-34.47 {ago with multiple relative units} {
     expr {$base - $res}
 } 180000
 
+test clock-34.48 {more than one ToD} {*}{
+    -body {clock scan {10:00 11:00}} 
+    -returnCodes error
+    -result {unable to convert date-time string "10:00 11:00": more than one time of day in string}
+}
+
+test clock-34.49 {more than one date} {*}{
+    -body {clock scan {1/1/2001 2/2/2002}} 
+    -returnCodes error
+    -result {unable to convert date-time string "1/1/2001 2/2/2002": more than one date in string}
+}
+
+test clock-34.50 {more than one time zone} {*}{
+    -body {clock scan {10:00 EST CST}} 
+    -returnCodes error
+    -result {unable to convert date-time string "10:00 EST CST": more than one time zone in string}
+}
+
+test clock-34.51 {more than one weekday} {*}{
+    -body {clock scan {Monday Tuesday}} 
+    -returnCodes error
+    -result {unable to convert date-time string "Monday Tuesday": more than one weekday in string}
+}
+
+test clock-34.52 {more than one ordinal month} {*}{
+    -body {clock scan {next January next March}} 
+    -returnCodes error
+    -result {unable to convert date-time string "next January next March": more than one ordinal month in string}
+}
+
+
+
 # clock seconds
 test clock-35.1 {clock seconds tests} {
     expr [clock seconds]+1
@@ -35280,6 +35893,39 @@ test clock-38.1 {regression - convertUTCToLocalViaC - east of Greenwich} \
     } \
     -result {01:00:00}
 
+test clock-38.2 {make sure TZ is not cached after unset} \
+    -setup {
+	if { [info exists env(TZ)] } {
+	    set oldTZ $env(TZ)
+            unset env(TZ)
+	}
+	if { [info exists env(TCL_TZ)] } {
+	    set oldTCLTZ $env(TCL_TZ)
+            unset env(TCL_TZ)
+	}
+    } \
+    -body {
+        set t1 [clock format 0]
+        # a time zone that is unlikely to anywhere
+        set env(TZ) "+04:20"
+        set t2 [clock format 0]
+        unset env(TZ)
+        set t3 [clock format 0]
+        expr {$t1 eq $t3 && $t1 ne $t2}
+    } \
+    -cleanup {
+        if { [info exists oldTZ] } {
+            set env(TZ) $oldTZ
+            unset oldTZ
+        }
+        if { [info exists oldTclTZ] } {
+            set env(TCL_TZ) $oldTclTZ
+            unset oldTclTZ
+        }
+    } \
+    -result 1
+        
+
 test clock-39.1 {regression - synonym timezones} {
     clock format 0 -format {%H:%M:%S} -timezone :US/Eastern
 } {19:00:00}
@@ -35292,7 +35938,7 @@ test clock-40.1 {regression - bad month with -timezone :localtime} \
 	set env(TZ) UTC0
     } \
     -body {
-	clock scan 1970-01-01T00:00:00 -timezone :localtime \
+	clock scan 2000-01-01T00:00:00 -timezone :localtime \
 	    -format %Y-%m-%dT%H:%M:%S
     } \
     -cleanup {
@@ -35303,7 +35949,7 @@ test clock-40.1 {regression - bad month with -timezone :localtime} \
 	    unset env(TZ)
 	}
     } \
-    -result {0}
+    -result 946684800
 
 test clock-41.1 {regression test - format group %k when hour is 0 } {
     clock format 0 -format %k -gmt true
@@ -35329,26 +35975,8 @@ test clock-42.1 {regression test - %z in :localtime when west of Greenwich } \
     } \
     -result {-0500}
 
-test clock-43.1 {regression test - mktime returning -1} \
-    -setup {
-	if { [info exists env(TZ)] } {
-	    set oldTZ $env(TZ)
-	}
-	set env(TZ) UTC0
-    } \
-    -body {
-	clock scan 1969-12-31T23:59:59 -format %Y-%m-%dT%T -timezone :localtime
-    } \
-    -cleanup {
-	if { [info exists oldTZ] } {
-	    set env(TZ) $oldTZ
-	    unset oldTZ
-	} else {
-	    unset env(TZ)
-	}
-    } \
-    -result {-1}
-    
+# 43.1 was a bad test - mktime returning -1 is an error according to posix.
+
 test clock-44.1 {regression test - time zone name containing hyphen } \
     -setup {
 	if { [info exists env(TZ)] } {
@@ -35427,6 +36055,8 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
 	namespace eval ::tcl::clock {
 	    namespace import -force ::testClock::registry
 	}
+	set noreg [info exists ::tcl::clock::NoRegistry]
+	if {$noreg} {unset ::tcl::clock::NoRegistry}
 	if { [info exists env(TZ)] } {
 	    set oldTZ $env(TZ)
 	    unset env(TZ)
@@ -35437,13 +36067,13 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
 	}
 	# make it so New York time is a missing file
 	dict set ::tcl::clock::WinZoneInfo \
-	    {-18000 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} \
+	    {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \
 	    :No/Such/File
 	::tcl::clock::ClearCaches
     } \
     -body {
 	list [::tcl::clock::GuessWindowsTimeZone] \
-	    [clock format 0 -locale system -format "%X %Z"] \
+	    [clock format 0 -locale system -format "%H:%M:%S %Z"] \
 	    [clock format -86400 -format "%Y"]
     } \
     -cleanup {
@@ -35451,6 +36081,7 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
 	namespace eval ::tcl::clock {
 	    rename registry {}
 	}
+	if {$noreg} {set ::tcl::clock::NoRegistry {}}
 	if { [info exists oldTclTZ] } {
 	    set env(TCL_TZ) $oldTclTZ
 	}
@@ -35459,11 +36090,851 @@ test clock-49.2 {regression test - missing time zone file (Bug 1237907)} \
 	}
 	# put New York back on the map
 	dict set ::tcl::clock::WinZoneInfo \
-	    {-18000 0 3600 0 10 0 5 2 0 0 0 0 4 0 1 2 0 0 0} \
+	    {-18000 0 3600 0 11 0 1 2 0 0 0 0 3 0 2 2 0 0 0} \
 	    :America/New_York
 	::tcl::clock::ClearCaches
     } \
-    -result {<-0500>+05:00:00<-0400>+04:00:00,M4.1.0/02:00:00,M10.5.0/02:00:00 { 7:00:00 PM -0500} 1969}
+    -result {<-0500>+05:00:00<-0400>+04:00:00,M3.2.0/02:00:00,M11.1.0/02:00:00 {19:00:00 -0500} 1969}
+
+test clock-50.1 {format / scan -1 as a local time} {
+    if {[catch {
+	clock scan \
+	    [clock format -1 -format %Y%m%d%H%M%S -timezone :localtime] \
+	    -format %Y%m%d%H%M%S -timezone :localtime
+    } result]} {
+	if { [regexp " too large" $result] } {
+	    set result -1
+	}
+    }
+    set result
+} -1
+test clock-50.2 {format / scan -2 as a local time} {
+    if {[catch {
+	clock scan \
+	    [clock format -2 -format %Y%m%d%H%M%S -timezone :localtime] \
+	    -format %Y%m%d%H%M%S -timezone :localtime
+    } result]} {
+	if { [regexp " too large" $result] } {
+	    set result -2
+	}
+    }
+    set result
+} -2
+
+test clock-51.1 {correct conversion of times in Sydney} {
+    # Paul Mackerras reported a bug where DST rollover in New South Wales
+    # was miscalculated.  The problem was that tclZIC.tcl had a
+    # typo in the switch case where DST begins/ends at a given time
+    # Standard Time (that is, winter time).
+    set result {}
+    foreach t {1130601599 1130601600 1130637599 1130637600} {
+	lappend result [clock format $t -format %H:%M:%S \
+			    -timezone :Australia/Sydney]
+    }
+    set result
+} {01:59:59 03:00:00 12:59:59 13:00:00}
+
+test clock-52.1 {Posix timezone and conversion on last Sunday} {
+    # Martin Lemburg reported a bug where if tzdata is missing, then
+    # times are converted incorrectly in locales where DST conversion
+    # happens in the last (nominal 5th) week of a month.
+    set result {}
+    set timezone <MEZ>-01:00:00<MESZ>-02:00:00,M3.5.0/02:00:00,M10.5.0/01:00:00
+    foreach t {1143334799 1143334800} {
+	lappend result [clock format $t -format %H:%M:%S -timezone $timezone] \
+	    [clock format $t -format %H:%M:%S -timezone :Europe/Berlin]
+    }
+    set result
+} {01:59:59 01:59:59 03:00:00 03:00:00}
+
+test clock-52.2 {correct conversion of times in Europe} {
+   # [Bug 2207436]
+   set result {}
+   foreach t [list 1206838799 1206838800 1224982799 1224982800] {
+       lappend result [clock format $t -format %H:%M:%S \
+                           -timezone MET-1METDST]
+       lappend result [clock format $t -format %H:%M:%S \
+                           -timezone MET0METDST]
+   }
+   set result
+} {01:59:59 00:59:59 03:00:00 02:00:00 02:59:59 01:59:59 02:00:00 01:00:00}
+
+test clock-52.3 {correct conversion of times in Russia} {
+   # [Bug 2207436]
+   set result {}
+   foreach t [list 1206799199 1206799200 1224943199 1224943200] {
+       lappend result [clock format $t -format %H:%M:%S \
+                           -timezone WST-12WSTDST]
+   }
+   set result
+} {01:59:59 03:00:00 02:59:59 02:00:00}
+
+test clock-52.4 {correct conversion of times in USA} {
+   # [Bug 2207436]
+   set result {}
+   foreach t [list 1268549999 1268550000 1257055199 1257055200] {
+       lappend result [clock format $t -format %H:%M:%S \
+                           -timezone EST5EDT]
+   }
+   set result
+} {01:59:59 03:00:00 01:59:59 01:00:00}
+
+# Regression test for Bug # 1505383
+
+test clock-53.1 {%EC %Ey} {
+    clock format 0 -gmt true -locale en_US_roman -format %EC%Ey
+} mcmlxx
+
+# Test that glob-special characters can be handled in [clock]
+
+test clock-54.1 {glob specials in [clock format]} \
+    -setup {
+	clock format 0 -gmt 1 -format %Y
+    } \
+    -body {
+	clock format 0 -gmt 1 -format {*[%Y%m%d]*}
+    } \
+    -result {*[19700101]*}
+test clock-54.2 {glob specials in [clock scan]} \
+    -setup {
+	clock scan 1970 -gmt 1 -format %Y
+    } \
+    -body {
+	clock scan {*[19700101]*} -format {*[%Y%m%d]*} -gmt 1
+    } \
+    -result 0
+
+test clock-55.1 {Common Era} {
+    clock format -62135769600 -gmt 1 -format {%d %m %Y %EE}
+} {01 01 0001 C.E.}
+test clock-55.2 {Common Era} {
+    clock format -62135769600 -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} {01 01 0001 Anno Domini}
+test clock-55.3 {Before the Common Era} {
+    clock format -62135769601 -gmt 1 -format {%d %m %Y %EE}
+} {31 12 0001 B.C.E.}
+test clock-55.4 {Before the Common Era} {
+    clock format -62135769601 -gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} {31 12 0001 Before Christ}
+test clock-55.5 {Common Era} {
+    clock scan {01 01 0001 C.E.} \
+	-gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135769600
+test clock-55.6 {Common Era} {
+    clock scan {01 01 0001 A.D.} \
+	-gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135769600
+test clock-55.7 {Common Era} {
+    clock scan {01 01 0001 Anno Domini} \
+	-gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135769600
+test clock-55.8 {Before the Common Era} {
+    clock scan {31 12 0001 B.C.E.} \
+	-gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135856000
+test clock-55.9 {Common Era} {
+    clock scan {31 12 0001 B.C.} \
+	-gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135856000
+test clock-55.10 {Common Era} {
+    clock scan {31 12 0001 Before Christ} \
+	-gmt 1 -format {%d %m %Y %EE} -locale en_US_roman
+} -62135856000
+
+test clock-56.1 {use of zoneinfo, version 1} {*}{
+    -setup {
+	clock format [clock seconds]
+	set tzdir [makeDirectory zoneinfo]
+	set tzdir2 [makeDirectory Test $tzdir]
+	set tzfile [makeFile {} PhoenixOne $tzdir2]
+	set f [open $tzfile wb]
+	puts -nonewline $f [binary format c* {
+	    0x54 0x5a 0x69 0x66 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+	    0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x03
+	    0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a
+	    0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x0c 0x9e 0xa6 0x3a 0x90
+	    0x9f 0xbb 0x07 0x80 0xa0 0x86 0x1c 0x90 0xa1 0x9a 0xe9 0x80
+	    0xcb 0x89 0x0c 0x90 0xcf 0x17 0xdf 0x1c 0xcf 0x8f 0xe5 0xac
+	    0xd0 0x81 0x1a 0x1c 0xfa 0xf8 0x75 0x10 0xfb 0xe8 0x58 0x00
+	    0x00 0x01 0x00 0x01 0x02 0x01 0x02 0x01 0x00 0x01 0xff 0xff
+	    0xab 0xa0 0x01 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff
+	    0xab 0xa0 0x01 0x08 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00
+	    0x4d 0x57 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+	}]
+	close $f
+	set ::tcl::clock::ZoneinfoPaths \
+	    [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
+	::tcl::clock::ClearCaches
+    }
+    -cleanup {
+	set ::tcl::clock::ZoneinfoPaths \
+	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
+	::tcl::clock::ClearCaches
+	removeFile PhoenixOne $tzdir2
+	removeDirectory Test $tzdir
+	removeDirectory zoneinfo
+    }
+    -body {
+	clock format 1072940400 -timezone :Test/PhoenixOne \
+	    -format {%Y-%m-%d %H:%M:%S %Z}
+    }
+    -result {2004-01-01 00:00:00 MST}
+}
+	    
+test clock-56.2 {use of zoneinfo, version 2} {*}{
+    -setup {
+	clock format [clock seconds]
+	set tzdir [makeDirectory zoneinfo]
+	set tzdir2 [makeDirectory Test $tzdir]
+	set tzfile [makeFile {} PhoenixTwo $tzdir2]
+	set f [open $tzfile wb]
+	puts -nonewline $f [binary format c* {
+	    0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+	    0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x03
+	    0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a
+	    0x00 0x00 0x00 0x03 0x00 0x00 0x00 0x0c 0x9e 0xa6 0x3a 0x90
+	    0x9f 0xbb 0x07 0x80 0xa0 0x86 0x1c 0x90 0xa1 0x9a 0xe9 0x80
+	    0xcb 0x89 0x0c 0x90 0xcf 0x17 0xdf 0x1c 0xcf 0x8f 0xe5 0xac
+	    0xd0 0x81 0x1a 0x1c 0xfa 0xf8 0x75 0x10 0xfb 0xe8 0x58 0x00
+	    0x00 0x01 0x00 0x01 0x02 0x01 0x02 0x01 0x00 0x01 0xff 0xff
+	    0xab 0xa0 0x01 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff
+	    0xab 0xa0 0x01 0x08 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00
+	    0x4d 0x57 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x54 0x5a
+	    0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+	    0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x04 0x00 0x00
+	    0x00 0x04 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0b 0x00 0x00
+	    0x00 0x04 0x00 0x00 0x00 0x10 0xff 0xff 0xff 0xff 0x5e 0x04
+	    0x0c 0xb0 0xff 0xff 0xff 0xff 0x9e 0xa6 0x3a 0x90 0xff 0xff
+	    0xff 0xff 0x9f 0xbb 0x07 0x80 0xff 0xff 0xff 0xff 0xa0 0x86
+	    0x1c 0x90 0xff 0xff 0xff 0xff 0xa1 0x9a 0xe9 0x80 0xff 0xff
+	    0xff 0xff 0xcb 0x89 0x0c 0x90 0xff 0xff 0xff 0xff 0xcf 0x17
+	    0xdf 0x1c 0xff 0xff 0xff 0xff 0xcf 0x8f 0xe5 0xac 0xff 0xff
+	    0xff 0xff 0xd0 0x81 0x1a 0x1c 0xff 0xff 0xff 0xff 0xfa 0xf8
+	    0x75 0x10 0xff 0xff 0xff 0xff 0xfb 0xe8 0x58 0x00 0x02 0x01
+	    0x02 0x01 0x02 0x03 0x02 0x03 0x02 0x01 0x02 0xff 0xff 0x96
+	    0xee 0x00 0x00 0xff 0xff 0xab 0xa0 0x01 0x04 0xff 0xff 0x9d
+	    0x90 0x00 0x08 0xff 0xff 0xab 0xa0 0x01 0x0c 0x4c 0x4d 0x54
+	    0x00 0x4d 0x44 0x54 0x00 0x4d 0x53 0x54 0x00 0x4d 0x57 0x54
+	    0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x4d 0x53
+	    0x54 0x37 0x0a
+	}]
+	close $f
+	set ::tcl::clock::ZoneinfoPaths \
+	    [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
+	::tcl::clock::ClearCaches
+    }
+    -cleanup {
+	set ::tcl::clock::ZoneinfoPaths \
+	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
+	::tcl::clock::ClearCaches
+	removeFile PhoenixTwo $tzdir2
+	removeDirectory Test $tzdir
+	removeDirectory zoneinfo
+    } 
+    -body {
+	clock format 1072940400 -timezone :Test/PhoenixTwo \
+	    -format {%Y-%m-%d %H:%M:%S %Z}
+    }
+    -result {2004-01-01 00:00:00 MST}
+}
+
+test clock-56.3 {use of zoneinfo, version 2, Y2038 compliance} {*}{
+    -setup {
+	clock format [clock seconds]
+	set tzdir [makeDirectory zoneinfo]
+	set tzdir2 [makeDirectory Test $tzdir]
+	set tzfile [makeFile {} TijuanaTwo $tzdir2]
+	set f [open $tzfile wb]
+	puts -nonewline $f [binary format c* {
+            0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+            0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x06 0x00 0x00
+            0x00 0x06 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x95 0x00 0x00 0x00
+            0x06 0x00 0x00 0x00 0x18 0xa5 0xb6 0xf6 0x80 0xa9 0x79 0x4f 0x70
+            0xaf 0xf2 0x7c 0xf0 0xb6 0x66 0x64 0x70 0xb7 0x1b 0x10 0x00 0xb8
+            0x0a 0xf2 0xf0 0xcb 0xea 0x8d 0x80 0xd2 0x23 0xf4 0x70 0xd2 0x99
+            0xba 0x70 0xd7 0x1b 0x59 0x00 0xd8 0x91 0xb4 0xf0 0xe2 0x7e 0x59
+            0xa0 0xe3 0x49 0x52 0x90 0xe4 0x5e 0x3b 0xa0 0xe5 0x29 0x34 0x90
+            0xe6 0x47 0x58 0x20 0xe7 0x12 0x51 0x10 0xe8 0x27 0x3a 0x20 0xe8
+            0xf2 0x33 0x10 0xea 0x07 0x1c 0x20 0xea 0xd2 0x15 0x10 0xeb 0xe6
+            0xfe 0x20 0xec 0xb1 0xf7 0x10 0xed 0xc6 0xe0 0x20 0xee 0x91 0xd9
+            0x10 0x0b 0xe0 0xaf 0xa0 0x0c 0xd9 0xcd 0x10 0x0d 0xc0 0x91 0xa0
+            0x0e 0xb9 0xaf 0x10 0x0f 0xa9 0xae 0x20 0x10 0x99 0x91 0x10 0x11
+            0x89 0x90 0x20 0x12 0x79 0x73 0x10 0x13 0x69 0x72 0x20 0x14 0x59
+            0x55 0x10 0x15 0x49 0x54 0x20 0x16 0x39 0x37 0x10 0x17 0x29 0x36
+            0x20 0x18 0x22 0x53 0x90 0x19 0x09 0x18 0x20 0x1a 0x02 0x35 0x90
+            0x1a 0xf2 0x34 0xa0 0x1b 0xe2 0x17 0x90 0x1c 0xd2 0x16 0xa0 0x1d
+            0xc1 0xf9 0x90 0x1e 0xb1 0xf8 0xa0 0x1f 0xa1 0xdb 0x90 0x20 0x76
+            0x2b 0x20 0x21 0x81 0xbd 0x90 0x22 0x56 0x0d 0x20 0x23 0x6a 0xda
+            0x10 0x24 0x35 0xef 0x20 0x25 0x4a 0xbc 0x10 0x26 0x15 0xd1 0x20
+            0x27 0x2a 0x9e 0x10 0x27 0xfe 0xed 0xa0 0x29 0x0a 0x80 0x10 0x29
+            0xde 0xcf 0xa0 0x2a 0xea 0x62 0x10 0x2b 0xbe 0xb1 0xa0 0x2c 0xd3
+            0x7e 0x90 0x2d 0x9e 0x93 0xa0 0x2e 0xb3 0x60 0x90 0x2f 0x7e 0x75
+            0xa0 0x30 0x93 0x42 0x90 0x31 0x67 0x92 0x20 0x32 0x73 0x24 0x90
+            0x33 0x47 0x74 0x20 0x34 0x53 0x06 0x90 0x35 0x27 0x56 0x20 0x36
+            0x32 0xe8 0x90 0x37 0x07 0x38 0x20 0x38 0x1c 0x05 0x10 0x38 0xe7
+            0x1a 0x20 0x39 0xfb 0xe7 0x10 0x3a 0xc6 0xfc 0x20 0x3b 0xdb 0xc9
+            0x10 0x3c 0xb0 0x18 0xa0 0x3d 0xbb 0xab 0x10 0x3e 0x8f 0xfa 0xa0
+            0x3f 0x9b 0x8d 0x10 0x40 0x6f 0xdc 0xa0 0x41 0x84 0xa9 0x90 0x42
+            0x4f 0xbe 0xa0 0x43 0x64 0x8b 0x90 0x44 0x2f 0xa0 0xa0 0x45 0x44
+            0x6d 0x90 0x46 0x0f 0x82 0xa0 0x47 0x24 0x4f 0x90 0x47 0xf8 0x9f
+            0x20 0x49 0x04 0x31 0x90 0x49 0xd8 0x81 0x20 0x4a 0xe4 0x13 0x90
+            0x4b 0xb8 0x63 0x20 0x4c 0xcd 0x30 0x10 0x4d 0x98 0x45 0x20 0x4e
+            0xad 0x12 0x10 0x4f 0x78 0x27 0x20 0x50 0x8c 0xf4 0x10 0x51 0x61
+            0x43 0xa0 0x52 0x6c 0xd6 0x10 0x53 0x41 0x25 0xa0 0x54 0x4c 0xb8
+            0x10 0x55 0x21 0x07 0xa0 0x56 0x2c 0x9a 0x10 0x57 0x00 0xe9 0xa0
+            0x58 0x15 0xb6 0x90 0x58 0xe0 0xcb 0xa0 0x59 0xf5 0x98 0x90 0x5a
+            0xc0 0xad 0xa0 0x5b 0xd5 0x7a 0x90 0x5c 0xa9 0xca 0x20 0x5d 0xb5
+            0x5c 0x90 0x5e 0x89 0xac 0x20 0x5f 0x95 0x3e 0x90 0x60 0x69 0x8e
+            0x20 0x61 0x7e 0x5b 0x10 0x62 0x49 0x70 0x20 0x63 0x5e 0x3d 0x10
+            0x64 0x29 0x52 0x20 0x65 0x3e 0x1f 0x10 0x66 0x12 0x6e 0xa0 0x67
+            0x1e 0x01 0x10 0x67 0xf2 0x50 0xa0 0x68 0xfd 0xe3 0x10 0x69 0xd2
+            0x32 0xa0 0x6a 0xdd 0xc5 0x10 0x6b 0xb2 0x14 0xa0 0x6c 0xc6 0xe1
+            0x90 0x6d 0x91 0xf6 0xa0 0x6e 0xa6 0xc3 0x90 0x6f 0x71 0xd8 0xa0
+            0x70 0x86 0xa5 0x90 0x71 0x5a 0xf5 0x20 0x72 0x66 0x87 0x90 0x73
+            0x3a 0xd7 0x20 0x74 0x46 0x69 0x90 0x75 0x1a 0xb9 0x20 0x76 0x2f
+            0x86 0x10 0x76 0xfa 0x9b 0x20 0x78 0x0f 0x68 0x10 0x78 0xda 0x7d
+            0x20 0x79 0xef 0x4a 0x10 0x7a 0xba 0x5f 0x20 0x7b 0xcf 0x2c 0x10
+            0x7c 0xa3 0x7b 0xa0 0x7d 0xaf 0x0e 0x10 0x7e 0x83 0x5d 0xa0 0x7f
+            0x8e 0xf0 0x10 0x01 0x02 0x01 0x02 0x03 0x02 0x04 0x05 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0xff 0xff 0x92 0x4c
+            0x00 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff 0x8f 0x80 0x00
+            0x08 0xff 0xff 0x9d 0x90 0x01 0x0c 0xff 0xff 0x9d 0x90 0x01 0x10
+            0xff 0xff 0x9d 0x90 0x01 0x14 0x4c 0x4d 0x54 0x00 0x4d 0x53 0x54
+            0x00 0x50 0x53 0x54 0x00 0x50 0x44 0x54 0x00 0x50 0x57 0x54 0x00
+            0x50 0x50 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x01 0x00 0x00 0x00
+            0x00 0x00 0x01 0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00
+            0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+            0x06 0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x95
+            0x00 0x00 0x00 0x06 0x00 0x00 0x00 0x18 0xff 0xff 0xff 0xff 0xa5
+            0xb6 0xf6 0x80 0xff 0xff 0xff 0xff 0xa9 0x79 0x4f 0x70 0xff 0xff
+            0xff 0xff 0xaf 0xf2 0x7c 0xf0 0xff 0xff 0xff 0xff 0xb6 0x66 0x64
+            0x70 0xff 0xff 0xff 0xff 0xb7 0x1b 0x10 0x00 0xff 0xff 0xff 0xff
+            0xb8 0x0a 0xf2 0xf0 0xff 0xff 0xff 0xff 0xcb 0xea 0x8d 0x80 0xff
+            0xff 0xff 0xff 0xd2 0x23 0xf4 0x70 0xff 0xff 0xff 0xff 0xd2 0x99
+            0xba 0x70 0xff 0xff 0xff 0xff 0xd7 0x1b 0x59 0x00 0xff 0xff 0xff
+            0xff 0xd8 0x91 0xb4 0xf0 0xff 0xff 0xff 0xff 0xe2 0x7e 0x59 0xa0
+            0xff 0xff 0xff 0xff 0xe3 0x49 0x52 0x90 0xff 0xff 0xff 0xff 0xe4
+            0x5e 0x3b 0xa0 0xff 0xff 0xff 0xff 0xe5 0x29 0x34 0x90 0xff 0xff
+            0xff 0xff 0xe6 0x47 0x58 0x20 0xff 0xff 0xff 0xff 0xe7 0x12 0x51
+            0x10 0xff 0xff 0xff 0xff 0xe8 0x27 0x3a 0x20 0xff 0xff 0xff 0xff
+            0xe8 0xf2 0x33 0x10 0xff 0xff 0xff 0xff 0xea 0x07 0x1c 0x20 0xff
+            0xff 0xff 0xff 0xea 0xd2 0x15 0x10 0xff 0xff 0xff 0xff 0xeb 0xe6
+            0xfe 0x20 0xff 0xff 0xff 0xff 0xec 0xb1 0xf7 0x10 0xff 0xff 0xff
+            0xff 0xed 0xc6 0xe0 0x20 0xff 0xff 0xff 0xff 0xee 0x91 0xd9 0x10
+            0x00 0x00 0x00 0x00 0x0b 0xe0 0xaf 0xa0 0x00 0x00 0x00 0x00 0x0c
+            0xd9 0xcd 0x10 0x00 0x00 0x00 0x00 0x0d 0xc0 0x91 0xa0 0x00 0x00
+            0x00 0x00 0x0e 0xb9 0xaf 0x10 0x00 0x00 0x00 0x00 0x0f 0xa9 0xae
+            0x20 0x00 0x00 0x00 0x00 0x10 0x99 0x91 0x10 0x00 0x00 0x00 0x00
+            0x11 0x89 0x90 0x20 0x00 0x00 0x00 0x00 0x12 0x79 0x73 0x10 0x00
+            0x00 0x00 0x00 0x13 0x69 0x72 0x20 0x00 0x00 0x00 0x00 0x14 0x59
+            0x55 0x10 0x00 0x00 0x00 0x00 0x15 0x49 0x54 0x20 0x00 0x00 0x00
+            0x00 0x16 0x39 0x37 0x10 0x00 0x00 0x00 0x00 0x17 0x29 0x36 0x20
+            0x00 0x00 0x00 0x00 0x18 0x22 0x53 0x90 0x00 0x00 0x00 0x00 0x19
+            0x09 0x18 0x20 0x00 0x00 0x00 0x00 0x1a 0x02 0x35 0x90 0x00 0x00
+            0x00 0x00 0x1a 0xf2 0x34 0xa0 0x00 0x00 0x00 0x00 0x1b 0xe2 0x17
+            0x90 0x00 0x00 0x00 0x00 0x1c 0xd2 0x16 0xa0 0x00 0x00 0x00 0x00
+            0x1d 0xc1 0xf9 0x90 0x00 0x00 0x00 0x00 0x1e 0xb1 0xf8 0xa0 0x00
+            0x00 0x00 0x00 0x1f 0xa1 0xdb 0x90 0x00 0x00 0x00 0x00 0x20 0x76
+            0x2b 0x20 0x00 0x00 0x00 0x00 0x21 0x81 0xbd 0x90 0x00 0x00 0x00
+            0x00 0x22 0x56 0x0d 0x20 0x00 0x00 0x00 0x00 0x23 0x6a 0xda 0x10
+            0x00 0x00 0x00 0x00 0x24 0x35 0xef 0x20 0x00 0x00 0x00 0x00 0x25
+            0x4a 0xbc 0x10 0x00 0x00 0x00 0x00 0x26 0x15 0xd1 0x20 0x00 0x00
+            0x00 0x00 0x27 0x2a 0x9e 0x10 0x00 0x00 0x00 0x00 0x27 0xfe 0xed
+            0xa0 0x00 0x00 0x00 0x00 0x29 0x0a 0x80 0x10 0x00 0x00 0x00 0x00
+            0x29 0xde 0xcf 0xa0 0x00 0x00 0x00 0x00 0x2a 0xea 0x62 0x10 0x00
+            0x00 0x00 0x00 0x2b 0xbe 0xb1 0xa0 0x00 0x00 0x00 0x00 0x2c 0xd3
+            0x7e 0x90 0x00 0x00 0x00 0x00 0x2d 0x9e 0x93 0xa0 0x00 0x00 0x00
+            0x00 0x2e 0xb3 0x60 0x90 0x00 0x00 0x00 0x00 0x2f 0x7e 0x75 0xa0
+            0x00 0x00 0x00 0x00 0x30 0x93 0x42 0x90 0x00 0x00 0x00 0x00 0x31
+            0x67 0x92 0x20 0x00 0x00 0x00 0x00 0x32 0x73 0x24 0x90 0x00 0x00
+            0x00 0x00 0x33 0x47 0x74 0x20 0x00 0x00 0x00 0x00 0x34 0x53 0x06
+            0x90 0x00 0x00 0x00 0x00 0x35 0x27 0x56 0x20 0x00 0x00 0x00 0x00
+            0x36 0x32 0xe8 0x90 0x00 0x00 0x00 0x00 0x37 0x07 0x38 0x20 0x00
+            0x00 0x00 0x00 0x38 0x1c 0x05 0x10 0x00 0x00 0x00 0x00 0x38 0xe7
+            0x1a 0x20 0x00 0x00 0x00 0x00 0x39 0xfb 0xe7 0x10 0x00 0x00 0x00
+            0x00 0x3a 0xc6 0xfc 0x20 0x00 0x00 0x00 0x00 0x3b 0xdb 0xc9 0x10
+            0x00 0x00 0x00 0x00 0x3c 0xb0 0x18 0xa0 0x00 0x00 0x00 0x00 0x3d
+            0xbb 0xab 0x10 0x00 0x00 0x00 0x00 0x3e 0x8f 0xfa 0xa0 0x00 0x00
+            0x00 0x00 0x3f 0x9b 0x8d 0x10 0x00 0x00 0x00 0x00 0x40 0x6f 0xdc
+            0xa0 0x00 0x00 0x00 0x00 0x41 0x84 0xa9 0x90 0x00 0x00 0x00 0x00
+            0x42 0x4f 0xbe 0xa0 0x00 0x00 0x00 0x00 0x43 0x64 0x8b 0x90 0x00
+            0x00 0x00 0x00 0x44 0x2f 0xa0 0xa0 0x00 0x00 0x00 0x00 0x45 0x44
+            0x6d 0x90 0x00 0x00 0x00 0x00 0x46 0x0f 0x82 0xa0 0x00 0x00 0x00
+            0x00 0x47 0x24 0x4f 0x90 0x00 0x00 0x00 0x00 0x47 0xf8 0x9f 0x20
+            0x00 0x00 0x00 0x00 0x49 0x04 0x31 0x90 0x00 0x00 0x00 0x00 0x49
+            0xd8 0x81 0x20 0x00 0x00 0x00 0x00 0x4a 0xe4 0x13 0x90 0x00 0x00
+            0x00 0x00 0x4b 0xb8 0x63 0x20 0x00 0x00 0x00 0x00 0x4c 0xcd 0x30
+            0x10 0x00 0x00 0x00 0x00 0x4d 0x98 0x45 0x20 0x00 0x00 0x00 0x00
+            0x4e 0xad 0x12 0x10 0x00 0x00 0x00 0x00 0x4f 0x78 0x27 0x20 0x00
+            0x00 0x00 0x00 0x50 0x8c 0xf4 0x10 0x00 0x00 0x00 0x00 0x51 0x61
+            0x43 0xa0 0x00 0x00 0x00 0x00 0x52 0x6c 0xd6 0x10 0x00 0x00 0x00
+            0x00 0x53 0x41 0x25 0xa0 0x00 0x00 0x00 0x00 0x54 0x4c 0xb8 0x10
+            0x00 0x00 0x00 0x00 0x55 0x21 0x07 0xa0 0x00 0x00 0x00 0x00 0x56
+            0x2c 0x9a 0x10 0x00 0x00 0x00 0x00 0x57 0x00 0xe9 0xa0 0x00 0x00
+            0x00 0x00 0x58 0x15 0xb6 0x90 0x00 0x00 0x00 0x00 0x58 0xe0 0xcb
+            0xa0 0x00 0x00 0x00 0x00 0x59 0xf5 0x98 0x90 0x00 0x00 0x00 0x00
+            0x5a 0xc0 0xad 0xa0 0x00 0x00 0x00 0x00 0x5b 0xd5 0x7a 0x90 0x00
+            0x00 0x00 0x00 0x5c 0xa9 0xca 0x20 0x00 0x00 0x00 0x00 0x5d 0xb5
+            0x5c 0x90 0x00 0x00 0x00 0x00 0x5e 0x89 0xac 0x20 0x00 0x00 0x00
+            0x00 0x5f 0x95 0x3e 0x90 0x00 0x00 0x00 0x00 0x60 0x69 0x8e 0x20
+            0x00 0x00 0x00 0x00 0x61 0x7e 0x5b 0x10 0x00 0x00 0x00 0x00 0x62
+            0x49 0x70 0x20 0x00 0x00 0x00 0x00 0x63 0x5e 0x3d 0x10 0x00 0x00
+            0x00 0x00 0x64 0x29 0x52 0x20 0x00 0x00 0x00 0x00 0x65 0x3e 0x1f
+            0x10 0x00 0x00 0x00 0x00 0x66 0x12 0x6e 0xa0 0x00 0x00 0x00 0x00
+            0x67 0x1e 0x01 0x10 0x00 0x00 0x00 0x00 0x67 0xf2 0x50 0xa0 0x00
+            0x00 0x00 0x00 0x68 0xfd 0xe3 0x10 0x00 0x00 0x00 0x00 0x69 0xd2
+            0x32 0xa0 0x00 0x00 0x00 0x00 0x6a 0xdd 0xc5 0x10 0x00 0x00 0x00
+            0x00 0x6b 0xb2 0x14 0xa0 0x00 0x00 0x00 0x00 0x6c 0xc6 0xe1 0x90
+            0x00 0x00 0x00 0x00 0x6d 0x91 0xf6 0xa0 0x00 0x00 0x00 0x00 0x6e
+            0xa6 0xc3 0x90 0x00 0x00 0x00 0x00 0x6f 0x71 0xd8 0xa0 0x00 0x00
+            0x00 0x00 0x70 0x86 0xa5 0x90 0x00 0x00 0x00 0x00 0x71 0x5a 0xf5
+            0x20 0x00 0x00 0x00 0x00 0x72 0x66 0x87 0x90 0x00 0x00 0x00 0x00
+            0x73 0x3a 0xd7 0x20 0x00 0x00 0x00 0x00 0x74 0x46 0x69 0x90 0x00
+            0x00 0x00 0x00 0x75 0x1a 0xb9 0x20 0x00 0x00 0x00 0x00 0x76 0x2f
+            0x86 0x10 0x00 0x00 0x00 0x00 0x76 0xfa 0x9b 0x20 0x00 0x00 0x00
+            0x00 0x78 0x0f 0x68 0x10 0x00 0x00 0x00 0x00 0x78 0xda 0x7d 0x20
+            0x00 0x00 0x00 0x00 0x79 0xef 0x4a 0x10 0x00 0x00 0x00 0x00 0x7a
+            0xba 0x5f 0x20 0x00 0x00 0x00 0x00 0x7b 0xcf 0x2c 0x10 0x00 0x00
+            0x00 0x00 0x7c 0xa3 0x7b 0xa0 0x00 0x00 0x00 0x00 0x7d 0xaf 0x0e
+            0x10 0x00 0x00 0x00 0x00 0x7e 0x83 0x5d 0xa0 0x00 0x00 0x00 0x00
+            0x7f 0x8e 0xf0 0x10 0x01 0x02 0x01 0x02 0x03 0x02 0x04 0x05 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03
+            0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02
+            0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0x03 0x02 0xff 0xff 0x92
+            0x4c 0x00 0x00 0xff 0xff 0x9d 0x90 0x00 0x04 0xff 0xff 0x8f 0x80
+            0x00 0x08 0xff 0xff 0x9d 0x90 0x01 0x0c 0xff 0xff 0x9d 0x90 0x01
+            0x10 0xff 0xff 0x9d 0x90 0x01 0x14 0x4c 0x4d 0x54 0x00 0x4d 0x53
+            0x54 0x00 0x50 0x53 0x54 0x00 0x50 0x44 0x54 0x00 0x50 0x57 0x54
+            0x00 0x50 0x50 0x54 0x00 0x00 0x00 0x00 0x00 0x00 0x01 0x00 0x00
+            0x00 0x00 0x00 0x01 0x0a 0x50 0x53 0x54 0x38 0x50 0x44 0x54 0x2c
+            0x4d 0x34 0x2e 0x31 0x2e 0x30 0x2c 0x4d 0x31 0x30 0x2e 0x35 0x2e
+            0x30 0x0a
+	}]
+	close $f
+	set ::tcl::clock::ZoneinfoPaths \
+	    [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
+	::tcl::clock::ClearCaches
+    }
+    -cleanup {
+	set ::tcl::clock::ZoneinfoPaths \
+	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
+	::tcl::clock::ClearCaches
+	removeFile TijuanaTwo $tzdir2
+	removeDirectory Test $tzdir
+	removeDirectory zoneinfo
+    } 
+    -body {
+	clock format 2224738800 -timezone :Test/TijuanaTwo \
+	    -format {%Y-%m-%d %H:%M:%S %Z}
+    }
+    -result {2040-07-01 00:00:00 PDT}
+}
+
+test clock-56.4 {Bug 3470928} {*}{
+    -setup {
+	clock format [clock seconds]
+	set tzdir [makeDirectory zoneinfo]
+	set tzdir2 [makeDirectory Test $tzdir]
+	set tzfile [makeFile {} Windhoek $tzdir2]
+	set f [open $tzfile wb]
+	puts -nonewline $f [binary format c* {
+            0x54 0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+            0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x06 0x00 0x00
+            0x00 0x06 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x5c 0x00 0x00 0x00
+            0x06 0x00 0x00 0x00 0x13 0x82 0x46 0xcf 0x68 0xcc 0xae 0x8c 0x80
+            0xcd 0x9e 0x6f 0x70 0x26 0x06 0xa7 0xe0 0x2d 0x9d 0xea 0xe0 0x2e
+            0x69 0x1c 0x10 0x2f 0x7d 0xe9 0x00 0x30 0x48 0xfe 0x10 0x31 0x67
+            0x05 0x80 0x32 0x28 0xe0 0x10 0x33 0x46 0xe7 0x80 0x34 0x11 0xfc
+            0x90 0x35 0x26 0xc9 0x80 0x35 0xf1 0xde 0x90 0x37 0x06 0xab 0x80
+            0x37 0xd1 0xc0 0x90 0x38 0xe6 0x8d 0x80 0x39 0xb1 0xa2 0x90 0x3a
+            0xc6 0x6f 0x80 0x3b 0x91 0x84 0x90 0x3c 0xaf 0x8c 0x00 0x3d 0x71
+            0x66 0x90 0x3e 0x8f 0x6e 0x00 0x3f 0x5a 0x83 0x10 0x40 0x6f 0x50
+            0x00 0x41 0x3a 0x65 0x10 0x42 0x4f 0x32 0x00 0x43 0x1a 0x47 0x10
+            0x44 0x2f 0x14 0x00 0x44 0xfa 0x29 0x10 0x46 0x0e 0xf6 0x00 0x46
+            0xda 0x0b 0x10 0x47 0xf8 0x12 0x80 0x48 0xc3 0x27 0x90 0x49 0xd7
+            0xf4 0x80 0x4a 0xa3 0x09 0x90 0x4b 0xb7 0xd6 0x80 0x4c 0x82 0xeb
+            0x90 0x4d 0x97 0xb8 0x80 0x4e 0x62 0xcd 0x90 0x4f 0x77 0x9a 0x80
+            0x50 0x42 0xaf 0x90 0x51 0x60 0xb7 0x00 0x52 0x22 0x91 0x90 0x53
+            0x40 0x99 0x00 0x54 0x0b 0xae 0x10 0x55 0x20 0x7b 0x00 0x55 0xeb
+            0x90 0x10 0x57 0x00 0x5d 0x00 0x57 0xcb 0x72 0x10 0x58 0xe0 0x3f
+            0x00 0x59 0xab 0x54 0x10 0x5a 0xc0 0x21 0x00 0x5b 0x8b 0x36 0x10
+            0x5c 0xa9 0x3d 0x80 0x5d 0x6b 0x18 0x10 0x5e 0x89 0x1f 0x80 0x5f
+            0x54 0x34 0x90 0x60 0x69 0x01 0x80 0x61 0x34 0x16 0x90 0x62 0x48
+            0xe3 0x80 0x63 0x13 0xf8 0x90 0x64 0x28 0xc5 0x80 0x64 0xf3 0xda
+            0x90 0x66 0x11 0xe2 0x00 0x66 0xd3 0xbc 0x90 0x67 0xf1 0xc4 0x00
+            0x68 0xbc 0xd9 0x10 0x69 0xd1 0xa6 0x00 0x6a 0x9c 0xbb 0x10 0x6b
+            0xb1 0x88 0x00 0x6c 0x7c 0x9d 0x10 0x6d 0x91 0x6a 0x00 0x6e 0x5c
+            0x7f 0x10 0x6f 0x71 0x4c 0x00 0x70 0x3c 0x61 0x10 0x71 0x5a 0x68
+            0x80 0x72 0x1c 0x43 0x10 0x73 0x3a 0x4a 0x80 0x74 0x05 0x5f 0x90
+            0x75 0x1a 0x2c 0x80 0x75 0xe5 0x41 0x90 0x76 0xfa 0x0e 0x80 0x77
+            0xc5 0x23 0x90 0x78 0xd9 0xf0 0x80 0x79 0xa5 0x05 0x90 0x7a 0xb9
+            0xd2 0x80 0x7b 0x84 0xe7 0x90 0x7c 0xa2 0xef 0x00 0x7d 0x6e 0x04
+            0x10 0x7e 0x82 0xd1 0x00 0x7f 0x4d 0xe6 0x10 0x01 0x02 0x01 0x03
+            0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05
+            0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04
+            0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05
+            0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04
+            0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05
+            0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04
+            0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x05 0x04 0x00 0x00 0x15
+            0x18 0x00 0x00 0x00 0x00 0x1c 0x20 0x00 0x05 0x00 0x00 0x2a 0x30
+            0x01 0x05 0x00 0x00 0x1c 0x20 0x00 0x0a 0x00 0x00 0x1c 0x20 0x01
+            0x0e 0x00 0x00 0x0e 0x10 0x00 0x01 0x53 0x57 0x41 0x54 0x00 0x53
+            0x41 0x53 0x54 0x00 0x43 0x41 0x54 0x00 0x57 0x41 0x53 0x54 0x00
+            0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x54
+            0x5a 0x69 0x66 0x32 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00
+            0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x07 0x00 0x00 0x00
+            0x07 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x5d 0x00 0x00 0x00 0x07
+            0x00 0x00 0x00 0x17 0xff 0xff 0xff 0xff 0x6d 0x7b 0x4b 0x78 0xff
+            0xff 0xff 0xff 0x82 0x46 0xcf 0x68 0xff 0xff 0xff 0xff 0xcc 0xae
+            0x8c 0x80 0xff 0xff 0xff 0xff 0xcd 0x9e 0x6f 0x70 0x00 0x00 0x00
+            0x00 0x26 0x06 0xa7 0xe0 0x00 0x00 0x00 0x00 0x2d 0x9d 0xea 0xe0
+            0x00 0x00 0x00 0x00 0x2e 0x69 0x1c 0x10 0x00 0x00 0x00 0x00 0x2f
+            0x7d 0xe9 0x00 0x00 0x00 0x00 0x00 0x30 0x48 0xfe 0x10 0x00 0x00
+            0x00 0x00 0x31 0x67 0x05 0x80 0x00 0x00 0x00 0x00 0x32 0x28 0xe0
+            0x10 0x00 0x00 0x00 0x00 0x33 0x46 0xe7 0x80 0x00 0x00 0x00 0x00
+            0x34 0x11 0xfc 0x90 0x00 0x00 0x00 0x00 0x35 0x26 0xc9 0x80 0x00
+            0x00 0x00 0x00 0x35 0xf1 0xde 0x90 0x00 0x00 0x00 0x00 0x37 0x06
+            0xab 0x80 0x00 0x00 0x00 0x00 0x37 0xd1 0xc0 0x90 0x00 0x00 0x00
+            0x00 0x38 0xe6 0x8d 0x80 0x00 0x00 0x00 0x00 0x39 0xb1 0xa2 0x90
+            0x00 0x00 0x00 0x00 0x3a 0xc6 0x6f 0x80 0x00 0x00 0x00 0x00 0x3b
+            0x91 0x84 0x90 0x00 0x00 0x00 0x00 0x3c 0xaf 0x8c 0x00 0x00 0x00
+            0x00 0x00 0x3d 0x71 0x66 0x90 0x00 0x00 0x00 0x00 0x3e 0x8f 0x6e
+            0x00 0x00 0x00 0x00 0x00 0x3f 0x5a 0x83 0x10 0x00 0x00 0x00 0x00
+            0x40 0x6f 0x50 0x00 0x00 0x00 0x00 0x00 0x41 0x3a 0x65 0x10 0x00
+            0x00 0x00 0x00 0x42 0x4f 0x32 0x00 0x00 0x00 0x00 0x00 0x43 0x1a
+            0x47 0x10 0x00 0x00 0x00 0x00 0x44 0x2f 0x14 0x00 0x00 0x00 0x00
+            0x00 0x44 0xfa 0x29 0x10 0x00 0x00 0x00 0x00 0x46 0x0e 0xf6 0x00
+            0x00 0x00 0x00 0x00 0x46 0xda 0x0b 0x10 0x00 0x00 0x00 0x00 0x47
+            0xf8 0x12 0x80 0x00 0x00 0x00 0x00 0x48 0xc3 0x27 0x90 0x00 0x00
+            0x00 0x00 0x49 0xd7 0xf4 0x80 0x00 0x00 0x00 0x00 0x4a 0xa3 0x09
+            0x90 0x00 0x00 0x00 0x00 0x4b 0xb7 0xd6 0x80 0x00 0x00 0x00 0x00
+            0x4c 0x82 0xeb 0x90 0x00 0x00 0x00 0x00 0x4d 0x97 0xb8 0x80 0x00
+            0x00 0x00 0x00 0x4e 0x62 0xcd 0x90 0x00 0x00 0x00 0x00 0x4f 0x77
+            0x9a 0x80 0x00 0x00 0x00 0x00 0x50 0x42 0xaf 0x90 0x00 0x00 0x00
+            0x00 0x51 0x60 0xb7 0x00 0x00 0x00 0x00 0x00 0x52 0x22 0x91 0x90
+            0x00 0x00 0x00 0x00 0x53 0x40 0x99 0x00 0x00 0x00 0x00 0x00 0x54
+            0x0b 0xae 0x10 0x00 0x00 0x00 0x00 0x55 0x20 0x7b 0x00 0x00 0x00
+            0x00 0x00 0x55 0xeb 0x90 0x10 0x00 0x00 0x00 0x00 0x57 0x00 0x5d
+            0x00 0x00 0x00 0x00 0x00 0x57 0xcb 0x72 0x10 0x00 0x00 0x00 0x00
+            0x58 0xe0 0x3f 0x00 0x00 0x00 0x00 0x00 0x59 0xab 0x54 0x10 0x00
+            0x00 0x00 0x00 0x5a 0xc0 0x21 0x00 0x00 0x00 0x00 0x00 0x5b 0x8b
+            0x36 0x10 0x00 0x00 0x00 0x00 0x5c 0xa9 0x3d 0x80 0x00 0x00 0x00
+            0x00 0x5d 0x6b 0x18 0x10 0x00 0x00 0x00 0x00 0x5e 0x89 0x1f 0x80
+            0x00 0x00 0x00 0x00 0x5f 0x54 0x34 0x90 0x00 0x00 0x00 0x00 0x60
+            0x69 0x01 0x80 0x00 0x00 0x00 0x00 0x61 0x34 0x16 0x90 0x00 0x00
+            0x00 0x00 0x62 0x48 0xe3 0x80 0x00 0x00 0x00 0x00 0x63 0x13 0xf8
+            0x90 0x00 0x00 0x00 0x00 0x64 0x28 0xc5 0x80 0x00 0x00 0x00 0x00
+            0x64 0xf3 0xda 0x90 0x00 0x00 0x00 0x00 0x66 0x11 0xe2 0x00 0x00
+            0x00 0x00 0x00 0x66 0xd3 0xbc 0x90 0x00 0x00 0x00 0x00 0x67 0xf1
+            0xc4 0x00 0x00 0x00 0x00 0x00 0x68 0xbc 0xd9 0x10 0x00 0x00 0x00
+            0x00 0x69 0xd1 0xa6 0x00 0x00 0x00 0x00 0x00 0x6a 0x9c 0xbb 0x10
+            0x00 0x00 0x00 0x00 0x6b 0xb1 0x88 0x00 0x00 0x00 0x00 0x00 0x6c
+            0x7c 0x9d 0x10 0x00 0x00 0x00 0x00 0x6d 0x91 0x6a 0x00 0x00 0x00
+            0x00 0x00 0x6e 0x5c 0x7f 0x10 0x00 0x00 0x00 0x00 0x6f 0x71 0x4c
+            0x00 0x00 0x00 0x00 0x00 0x70 0x3c 0x61 0x10 0x00 0x00 0x00 0x00
+            0x71 0x5a 0x68 0x80 0x00 0x00 0x00 0x00 0x72 0x1c 0x43 0x10 0x00
+            0x00 0x00 0x00 0x73 0x3a 0x4a 0x80 0x00 0x00 0x00 0x00 0x74 0x05
+            0x5f 0x90 0x00 0x00 0x00 0x00 0x75 0x1a 0x2c 0x80 0x00 0x00 0x00
+            0x00 0x75 0xe5 0x41 0x90 0x00 0x00 0x00 0x00 0x76 0xfa 0x0e 0x80
+            0x00 0x00 0x00 0x00 0x77 0xc5 0x23 0x90 0x00 0x00 0x00 0x00 0x78
+            0xd9 0xf0 0x80 0x00 0x00 0x00 0x00 0x79 0xa5 0x05 0x90 0x00 0x00
+            0x00 0x00 0x7a 0xb9 0xd2 0x80 0x00 0x00 0x00 0x00 0x7b 0x84 0xe7
+            0x90 0x00 0x00 0x00 0x00 0x7c 0xa2 0xef 0x00 0x00 0x00 0x00 0x00
+            0x7d 0x6e 0x04 0x10 0x00 0x00 0x00 0x00 0x7e 0x82 0xd1 0x00 0x00
+            0x00 0x00 0x00 0x7f 0x4d 0xe6 0x10 0x01 0x02 0x03 0x02 0x04 0x06
+            0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05
+            0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06
+            0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05
+            0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06
+            0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05
+            0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06
+            0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x06 0x05 0x00 0x00 0x10 0x08
+            0x00 0x00 0x00 0x00 0x15 0x18 0x00 0x04 0x00 0x00 0x1c 0x20 0x00
+            0x09 0x00 0x00 0x2a 0x30 0x01 0x09 0x00 0x00 0x1c 0x20 0x00 0x0e
+            0x00 0x00 0x1c 0x20 0x01 0x12 0x00 0x00 0x0e 0x10 0x00 0x05 0x4c
+            0x4d 0x54 0x00 0x53 0x57 0x41 0x54 0x00 0x53 0x41 0x53 0x54 0x00
+            0x43 0x41 0x54 0x00 0x57 0x41 0x53 0x54 0x00 0x00 0x00 0x00 0x00
+            0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x00 0x0a 0x57 0x41
+            0x54 0x2d 0x31 0x57 0x41 0x53 0x54 0x2c 0x4d 0x39 0x2e 0x31 0x2e
+            0x30 0x2c 0x4d 0x34 0x2e 0x31 0x2e 0x30 0x0a
+	}]
+	close $f
+	set ::tcl::clock::ZoneinfoPaths \
+	    [linsert $::tcl::clock::ZoneinfoPaths 0 $tzdir]
+	::tcl::clock::ClearCaches
+    }
+    -body {
+	clock format 1326054606 -timezone :Test/Windhoek
+    }
+    -cleanup {
+	set ::tcl::clock::ZoneinfoPaths \
+	    [lrange $::tcl::clock::ZoneinfoPaths 1 end]
+	::tcl::clock::ClearCaches
+	removeFile Windhoek $tzdir2
+	removeDirectory Test $tzdir
+	removeDirectory zoneinfo
+    } 
+    -result {Sun Jan 08 22:30:06 WAST 2012}
+}
+
+test clock-57.1 {clock scan - abbreviated options} {
+    clock scan 1970-01-01 -f %Y-%m-%d -g true
+} 0
+
+test clock-58.1 {clock l10n - Japanese localisation} {*}{
+    -setup {
+	proc backslashify { string } {
+	    
+	    set retval {}
+	    foreach char [split $string {}] {
+		scan $char %c ccode
+		if { $ccode >= 0x0020 && $ccode < 0x007f
+		     && $char ne "\{" && $char ne "\}" && $char ne "\["
+		     && $char ne "\]" && $char ne "\\" && $char ne "\$" } {
+		    append retval $char
+		} else {
+		    append retval \\u [format %04x $ccode]
+		}
+	    }
+	    return $retval
+	}
+    }
+    -body {
+	set trouble {}
+	foreach {date jdate} [list \
+	    1872-12-31 \u897f\u66a61872\u5e7412\u670831\u65e5 \
+	    1873-01-01 \u660e\u6cbb06\u5e7401\u670801\u65e5 \
+	    1912-07-29 \u660e\u6cbb45\u5e7407\u670829\u65e5 \
+	    1912-07-30 \u5927\u6b6301\u5e7407\u670830\u65e5 \
+	    1926-12-24 \u5927\u6b6315\u5e7412\u670824\u65e5 \
+	    1926-12-25 \u662d\u548c01\u5e7412\u670825\u65e5 \
+	    1989-01-07 \u662d\u548c64\u5e7401\u670807\u65e5 \
+	    1989-01-08 \u5e73\u621001\u5e7401\u670808\u65e5 \
+	] {
+	    set status [catch {
+		set secs [clock scan $date \
+			      -timezone +0900 \
+			      -locale ja_JP \
+			      -format %Y-%m-%d]
+		set jda [clock format $secs \
+			     -timezone +0900 \
+			     -locale ja_JP \
+			     -format %Ex]
+	    } result]
+	    if {$status != 0} {
+		append trouble \n $date " gives error " $result
+	    } elseif {$jda ne $jdate} {
+		append trouble \n $date " converts to " \
+		    [backslashify $jda] " and should be " \
+		    [backslashify $jdate]
+	    }
+	    # There is no code for scanning dates on the locale's
+	    # alternative calendar.
+	    continue
+	    set status [catch {
+		set secs [clock scan $jdate \
+			      -timezone +0900 \
+			      -locale ja_JP \
+			      -format %Ex]
+		set da [clock format $secs \
+			    -timezone +0900 \
+			    -locale ja_JP \
+			    -format %Y-%m-%d]
+	    } result]
+	    if {$status != 0} {
+		append trouble \n [backslashify $jdate] " gives error " $result
+	    } elseif {$da ne $date} {
+		append trouble \n [backslashify $jdate] " converts to " \
+		    $da " and should be " $date
+	    }
+	}
+	set trouble
+    }
+    -cleanup {
+	rename backslashify {}
+    }
+    -result {}
+}
+
+test clock-59.1 {military time zones} {
+    set hour 0
+    set base [clock scan "20000101 000000" -format "%Y%m%d %H%M%S" -gmt 1]
+    set trouble {}
+    foreach {pzone mzone} {
+	Z Z  A N  B O  C P  D Q  E R  F S  G T  H U  I V  K W  L X  M Y
+    } {
+	catch {clock scan "20000101 000000 $pzone" \
+		   -format "%Y%m%d %H%M%S %Z"} ps1
+	catch {clock scan "20000101 000000 $pzone"} ps2
+	catch {clock scan "20000101 000000 $mzone" \
+		   -format "%Y%m%d %H%M%S %Z"} ms1
+	catch {clock scan "20000101 000000 $mzone"} ms2
+	if {$ps1 != $base - 3600 * $hour} {
+	    lappend trouble [list pzone $pzone hour $hour ps1 is $ps1]
+	}
+	if {$ps2 != $base - 3600 * $hour} {
+	    lappend trouble [list pzone $pzone ps2 is $ps2]
+	}
+	if {$ms1 != $base + 3600 * $hour} {
+	    lappend trouble [list mzone $mzone ms1 is $ms1]
+	}
+	if {$ms2 != $base + 3600 * $hour} {
+	    lappend trouble [list mzone $mzone ms2 is $ms2]
+	}
+	incr hour
+    }
+    join $trouble \n
+} {}
+
+# case-insensitive matching of weekday and month names [Bug 1781282]
+
+test clock-60.1 {case insensitive weekday names} {
+    clock scan "2000-W01 monday" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] 
+test clock-60.2 {case insensitive weekday names} {
+    clock scan "2000-W01 Monday" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] 
+test clock-60.3 {case insensitive weekday names} {
+    clock scan "2000-W01 MONDAY" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"] 
+test clock-60.4 {case insensitive weekday names} {
+    clock scan "2000-W01 friday" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] 
+test clock-60.5 {case insensitive weekday names} {
+    clock scan "2000-W01 Friday" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] 
+test clock-60.6 {case insensitive weekday names} {
+    clock scan "2000-W01 FRIDAY" -gmt true -format "%G-W%V %a"
+} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"] 
+test clock-60.7 {case insensitive month names} {
+    clock scan "1 january 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] 
+test clock-60.8 {case insensitive month names} {
+    clock scan "1 January 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] 
+test clock-60.9 {case insensitive month names} {
+    clock scan "1 JANUARY 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"] 
+test clock-60.10 {case insensitive month names} {
+    clock scan "1 december 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
+test clock-60.11 {case insensitive month names} {
+    clock scan "1 December 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
+test clock-60.12 {case insensitive month names} {
+    clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y"
+} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"] 
+
+test clock-61.1 {overflow of a wide integer on output} {*}{
+    -body {
+	clock format 0x8000000000000000 -format %s -gmt true
+    } 
+    -result {integer value too large to represent}
+    -returnCodes error
+}
+test clock-61.2 {overflow of a wide integer on output} {*}{
+    -body {
+	clock format -0x8000000000000001 -format %s -gmt true
+    } 
+    -result {integer value too large to represent}
+    -returnCodes error
+}
+test clock-61.3 {near-miss overflow of a wide integer on output} {
+    clock format 0x7fffffffffffffff -format %s -gmt true
+} [expr 0x7fffffffffffffff]
+test clock-61.4 {near-miss overflow of a wide integer on output} {
+    clock format -0x8000000000000000 -format %s -gmt true
+} [expr -0x8000000000000000]
+
+test clock-62.1 {Bug 1902423} {*}{
+    -setup {::tcl::clock::ClearCaches}
+    -body {
+	set s 1204049747
+	set f1 [clock format $s -format {%Y-%m-%d %T} -locale C]
+	set f2 [clock format $s -format {%Y-%m-%d %H:%M:%S} -locale C]
+	if {$f1 ne $f2} {
+	    subst "$f2 is not $f1"
+	} else {
+	    subst "ok"
+	}
+    }
+    -result ok
+}
+
+test clock-63.1 {Incorrect use of internal ConvertLocalToUTC command} {*}{
+    -body {
+	::tcl::clock::ConvertLocalToUTC {immaterial stuff} {} 12345
+    }
+    -returnCodes error
+    -result {key "localseconds" not found in dictionary}
+}
+
+test clock-64.1 {:: in format string [Bug 2362156]} {*}{
+    -body {
+	clock scan 2001-02-03::04:05:06 -gmt 1 -format %Y-%m-%d::%H:%M:%S
+    }
+    -result 981173106
+}
+test clock-64.2 {:: in format string [Bug 2362156]} {*}{
+    -body {
+	clock format 981173106 -gmt 1 -format %Y-%m-%d::%H:%M:%S
+    }
+    -result 2001-02-03::04:05:06
+}
+
+test clock-65.1 {clock add, bad option [Bug 2481670]} {*}{
+    -body {
+	clock add 0 1 year -foo bar
+    }
+    -match glob
+    -returnCodes error
+    -result {bad switch "-foo"*}
+}
+
+test clock-66.1 {clock scan, no date, never-before-seen timezone} {*}{
+    -setup {
+	::tcl::clock::ClearCaches
+    }
+    -body {
+	clock scan 1200 \
+	    -timezone {<EST>+05:00:00<EDT>+04:00:00,M3.2.0/02:00:00,M11.1.0/02:00:00} \
+	    -base 1256529600 \
+	    -format %H%M
+    }
+    -result 1256572800
+}
+
+test clock-67.1 {clock format, %% with a letter following [Bug 2819334]} {
+    clock format [clock seconds] -format %%r
+} %r
+
+test clock-67.2 {Bug d19a30db57} -body {
+    # error, not segfault
+    tcl::clock::GetJulianDayFromEraYearMonthDay {} 2361222
+} -returnCodes error -match glob -result *
+test clock-67.3 {Bug d19a30db57} -body {
+    # error, not segfault
+    tcl::clock::GetJulianDayFromEraYearWeekDay {} 2361222
+} -returnCodes error -match glob -result *
 
 # cleanup
 
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 25db252..04a86fa 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -1,107 +1,149 @@
 # The file tests the tclCmdAH.c file.
 #
-# 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) 1996-1998 by 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.
-#
-# RCS: @(#) $Id: cmdAH.test,v 1.50 2004/11/01 16:58:37 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2.1
     namespace import -force ::tcltest::*
 }
 
-tcltest::testConstraint testchmod \
-	[string equal testchmod [info commands testchmod]]
-tcltest::testConstraint testsetplatform \
-	[string equal testsetplatform [info commands testsetplatform]]
-tcltest::testConstraint testvolumetype \
-	[string equal testvolumetype [info commands testvolumetype]]
-tcltest::testConstraint linkDirectory [expr \
-	{$tcl_platform(platform) ne "windows" || \
-	([string index $tcl_platform(osVersion) 0] >= 5 \
-	&& ([lindex [file system [temporaryDirectory]] 1] == "NTFS"))}]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testchmod       [llength [info commands testchmod]]
+testConstraint testsetplatform [llength [info commands testsetplatform]]
+testConstraint testvolumetype  [llength [info commands testvolumetype]]
+testConstraint linkDirectory [expr {
+    ![testConstraint win] ||
+    ([string index $tcl_platform(osVersion) 0] >= 5
+     && [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
+}]
 
 global env
 set cmdAHwd [pwd]
 catch {set platform [testgetplatform]}
 
-test cmdAH-0.1 {Tcl_BreakObjCmd, errors} {
-    list [catch {break foo} msg] $msg
-} {1 {wrong # args: should be "break"}}
+proc waitForEvenSecondForFAT {} {
+    # Windows 9x uses filesystems (the FAT* family of FSes) without enough
+    # data in its timestamps for even per-second-accurate timings. :^(
+    # This procedure based on work by Helmut Giese
+    if {
+	[testConstraint win] &&
+	[lindex [file system [temporaryDirectory]] 1] ne "NTFS"
+    } then {
+	# Assume non-NTFS means FAT{12,16,32} and hence in need of special
+	# help...
+	set start [clock seconds]
+	while {1} {
+	    set now [clock seconds]
+	    if {$now!=$start && !($now & 1)} {
+		break
+	    }
+	    after 50
+	}
+    }
+}
+
+test cmdAH-0.1 {Tcl_BreakObjCmd, errors} -body {
+    break foo
+} -returnCodes error -result {wrong # args: should be "break"}
 test cmdAH-0.2 {Tcl_BreakObjCmd, success} {
     list [catch {break} msg] $msg
 } {3 {}}
 
 # Tcl_CaseObjCmd is tested in case.test
 
-test cmdAH-1.1 {Tcl_CatchObjCmd, errors} {
-    list [catch {catch} msg] $msg
-} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}}
+test cmdAH-1.1 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
+    catch
+} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
 test cmdAH-1.2 {Tcl_CatchObjCmd, errors} {
     list [catch {catch foo bar baz} msg] $msg
 } {0 1}
-test cmdAH-1.3 {Tcl_CatchObjCmd, errors} {
-    list [catch {catch foo bar baz spaz} msg] $msg
-} {1 {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}}
+test cmdAH-1.3 {Tcl_CatchObjCmd, errors} -returnCodes error -body {
+    catch foo bar baz spaz
+} -result {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
+test cmdAH-1.4 {Bug 3595576} {
+    catch {catch {} -> noSuchNs::var}
+} 1
+test cmdAH-1.5 {Bug 3595576} {
+    catch {catch error -> noSuchNs::var}
+} 1
 
-test cmdAH-2.1 {Tcl_CdObjCmd} {
-    list [catch {cd foo bar} msg] $msg
-} {1 {wrong # args: should be "cd ?dirName?"}}
+test cmdAH-2.1 {Tcl_CdObjCmd} -returnCodes error -body {
+    cd foo bar
+} -result {wrong # args: should be "cd ?dirName?"}
 set foodir [file join [temporaryDirectory] foo]
-test cmdAH-2.2 {Tcl_CdObjCmd} {
+test cmdAH-2.2 {Tcl_CdObjCmd} -setup {
     file delete -force $foodir
+    set oldpwd [pwd]
+} -body {
     file mkdir $foodir
     cd $foodir
-    set result [file tail [pwd]]
-    cd ..
+    file tail [pwd]
+} -cleanup {
+    cd $oldpwd
     file delete $foodir
-    set result
-} foo
-test cmdAH-2.3 {Tcl_CdObjCmd} {
+} -result foo
+test cmdAH-2.3 {Tcl_CdObjCmd} -setup {
     global env
     set oldpwd [pwd]
     set temp $env(HOME)
-    set env(HOME) $oldpwd
     file delete -force $foodir
+} -body {
+    set env(HOME) $oldpwd
     file mkdir $foodir
     cd $foodir
     cd ~
-    set result [string equal [pwd] $oldpwd]
+    string equal [pwd] $oldpwd
+} -cleanup {
+    cd $oldpwd
     file delete $foodir
     set env(HOME) $temp
-    set result
-} 1
-test cmdAH-2.4 {Tcl_CdObjCmd} {
+} -result 1
+test cmdAH-2.4 {Tcl_CdObjCmd} -setup {
     global env
     set oldpwd [pwd]
     set temp $env(HOME)
-    set env(HOME) $oldpwd
     file delete -force $foodir
+} -body {
+    set env(HOME) $oldpwd
     file mkdir $foodir
     cd $foodir
     cd
-    set result [string equal [pwd] $oldpwd]
+    string equal [pwd] $oldpwd
+} -cleanup {
+    cd $oldpwd
     file delete $foodir
     set env(HOME) $temp
-    set result
-} 1
-test cmdAH-2.5 {Tcl_CdObjCmd} {
-    list [catch {cd ~~} msg] $msg
-} {1 {user "~" doesn't exist}}
-test cmdAH-2.6 {Tcl_CdObjCmd} {
-    list [catch {cd _foobar} msg] $msg
-} {1 {couldn't change working directory to "_foobar": no such file or directory}}
-test cmdAH-2.6.1 {Tcl_CdObjCmd} {
-    list [catch {cd ""} msg] $msg
-} {1 {couldn't change working directory to "": no such file or directory}}
-
+} -result 1
+test cmdAH-2.5 {Tcl_CdObjCmd} -returnCodes error -body {
+    cd ~~
+} -result {user "~" doesn't exist}
+test cmdAH-2.6 {Tcl_CdObjCmd} -returnCodes error -body {
+    cd _foobar
+} -result {couldn't change working directory to "_foobar": no such file or directory}
+test cmdAH-2.6.1 {Tcl_CdObjCmd} -returnCodes error -body {
+    cd ""
+} -result {couldn't change working directory to "": no such file or directory}
+test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
+    set dir [pwd]
+} -body {
+    cd /
+    pwd
+} -cleanup {
+    cd $dir
+} -result {/}
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+    cd .\0
+} -result "couldn't change working directory to \".\0\": no such file or directory"
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
     concat
 } {}
@@ -112,134 +154,124 @@ test cmdAH-2.9 {Tcl_ConcatObjCmd} {
     concat a {b c}
 } {a b c}
 
-test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} {
-    list [catch {continue foo} msg] $msg
-} {1 {wrong # args: should be "continue"}}
+test cmdAH-3.1 {Tcl_ContinueObjCmd, errors} -returnCodes error -body {
+    continue foo
+} -result {wrong # args: should be "continue"}
 test cmdAH-3.2 {Tcl_ContinueObjCmd, success} {
     list [catch {continue} msg] $msg
 } {4 {}}
 
-test cmdAH-4.1 {Tcl_EncodingObjCmd} {
-    list [catch {encoding} msg] $msg
-} {1 {wrong # args: should be "encoding option ?arg ...?"}}
-test cmdAH-4.2 {Tcl_EncodingObjCmd} {
-    list [catch {encoding foo} msg] $msg
-} {1 {bad option "foo": must be convertfrom, convertto, names, or system}}
-test cmdAH-4.3 {Tcl_EncodingObjCmd} {
-    list [catch {encoding convertto} msg] $msg
-} {1 {wrong # args: should be "encoding convertto ?encoding? data"}}
-test cmdAH-4.4 {Tcl_EncodingObjCmd} {
-    list [catch {encoding convertto foo bar} msg] $msg
-} {1 {unknown encoding "foo"}}
-test cmdAH-4.5 {Tcl_EncodingObjCmd} {
+test cmdAH-4.1 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding
+} -result {wrong # args: should be "encoding option ?arg ...?"}
+test cmdAH-4.2 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding foo
+} -result {bad option "foo": must be convertfrom, convertto, dirs, names, or system}
+test cmdAH-4.3 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding convertto
+} -result {wrong # args: should be "encoding convertto ?encoding? data"}
+test cmdAH-4.4 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding convertto foo bar
+} -result {unknown encoding "foo"}
+test cmdAH-4.5 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system jis0208
-    set x [encoding convertto \u4e4e]
+    encoding convertto \u4e4e
+} -cleanup {
     encoding system $system
-    set x
-} 8C
-test cmdAH-4.6 {Tcl_EncodingObjCmd} {
+} -result 8C
+test cmdAH-4.6 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system identity
-    set x [encoding convertto jis0208 \u4e4e]
+    encoding convertto jis0208 \u4e4e
+} -cleanup {
     encoding system $system
-    set x
-} 8C
-test cmdAH-4.7 {Tcl_EncodingObjCmd} {
-    list [catch {encoding convertfrom} msg] $msg
-} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"}}
-test cmdAH-4.8 {Tcl_EncodingObjCmd} {
-    list [catch {encoding convertfrom foo bar} msg] $msg
-} {1 {unknown encoding "foo"}}
-test cmdAH-4.9 {Tcl_EncodingObjCmd} {
+} -result 8C
+test cmdAH-4.7 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding convertfrom
+} -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
+test cmdAH-4.8 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding convertfrom foo bar
+} -result {unknown encoding "foo"}
+test cmdAH-4.9 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system jis0208
-    set x [encoding convertfrom 8C]
+    encoding convertfrom 8C
+} -cleanup {
     encoding system $system
-    set x
-} \u4e4e
-test cmdAH-4.10 {Tcl_EncodingObjCmd} {
+} -result \u4e4e
+test cmdAH-4.10 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system identity
-    set x [encoding convertfrom jis0208 8C]
+    encoding convertfrom jis0208 8C
+} -cleanup {
     encoding system $system
-    set x
-} \u4e4e
-test cmdAH-4.11 {Tcl_EncodingObjCmd} {
-    list [catch {encoding names foo} msg] $msg
-} {1 {wrong # args: should be "encoding names"}}
-test cmdAH-4.12 {Tcl_EncodingObjCmd} {
-    list [catch {encoding system foo bar} msg] $msg
-} {1 {wrong # args: should be "encoding system ?encoding?"}}
-test cmdAH-4.13 {Tcl_EncodingObjCmd} {
+} -result \u4e4e
+test cmdAH-4.11 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding names foo
+} -result {wrong # args: should be "encoding names"}
+test cmdAH-4.12 {Tcl_EncodingObjCmd} -returnCodes error -body {
+    encoding system foo bar
+} -result {wrong # args: should be "encoding system ?encoding?"}
+test cmdAH-4.13 {Tcl_EncodingObjCmd} -setup {
     set system [encoding system]
+} -body {
     encoding system identity
-    set x [encoding system]
+    encoding system
+} -cleanup {
     encoding system $system
-    set x
-} identity
-
-test cmdAH-5.1 {Tcl_FileObjCmd} {
-    list [catch file msg] $msg
-} {1 {wrong # args: should be "file option ?arg ...?"}}
-test cmdAH-5.2 {Tcl_FileObjCmd} {
-    list [catch {file x} msg] $msg
-} {1 {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, type, volumes, or writable}}
-test cmdAH-5.3 {Tcl_FileObjCmd} {
-    list [catch {file exists} msg] $msg
-} {1 {wrong # args: should be "file exists name"}}
+} -result identity
+
+test cmdAH-5.1 {Tcl_FileObjCmd} -returnCodes error -body {
+    file
+} -result {wrong # args: should be "file subcommand ?arg ...?"}
+test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
+    file x
+} -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"}
 test cmdAH-5.4 {Tcl_FileObjCmd} {
-    list [catch {file exists ""} msg] $msg
-} {0 0}
-
-#volume
+    file exists ""
+} 0
 
-test cmdAH-6.1 {Tcl_FileObjCmd: volumes} {
-    list [catch {file volumes x} msg] $msg
-} {1 {wrong # args: should be "file volumes"}}
-test cmdAH-6.2 {Tcl_FileObjCmd: volumes} {
-	set volumeList [file volumes]
-	if { [llength $volumeList] == 0 } {
-		set result 0
-	} else {
-		set result 1
-	}
-} {1}
-test cmdAH-6.3 {Tcl_FileObjCmd: volumes} {unix} {
+# volume
+test cmdAH-6.1 {Tcl_FileObjCmd: volumes} -returnCodes error -body {
+    file volumes x
+} -result {wrong # args: should be "file volumes"}
+test cmdAH-6.2 {Tcl_FileObjCmd: volumes} -body {
+    lindex [file volumes] 0
+} -match glob -result ?*
+test cmdAH-6.3 {Tcl_FileObjCmd: volumes} -constraints unix -body {
     set volumeList [file volumes]
-    catch [list glob -nocomplain [lindex $volumeList 0]*]
-} {0}
-test cmdAH-6.4 {Tcl_FileObjCmd: volumes} win {
+    glob -nocomplain [lindex $volumeList 0]*
+} -match glob -result *
+test cmdAH-6.4 {Tcl_FileObjCmd: volumes} -constraints win -body {
     set volumeList [string tolower [file volumes]]
-    list [catch {lsearch $volumeList "c:/"} element] [expr $element != -1] [catch {list glob -nocomplain [lindex $volumeList $element]*}]
-} {0 1 0}
-
-test cmdAH-6.5 {cd} {unix nonPortable} {
-    set dir [pwd]
-    cd /
-    set res [pwd]
-    cd $dir
-    set res
-} {/}
+    set element [lsearch -exact $volumeList "c:/"]
+    list [expr {$element>-1}] [glob -nocomplain [lindex $volumeList $element]*]
+} -match glob -result {1 *}
 
 # attributes
-
-test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} {
+test cmdAH-7.1 {Tcl_FileObjCmd - file attrs} -setup {
     set foofile [makeFile abcde foo.file]
     catch {file delete -force $foofile}
+} -body {
     close [open $foofile w]
-    set res [catch {file attributes $foofile}]
+    file attributes $foofile
+} -cleanup {
     # We used [makeFile] so we undo with [removeFile]
     removeFile $foofile
-    set res
-} {0}
+} -match glob -result *
 
 # dirname
-
-test cmdAH-8.1 {Tcl_FileObjCmd: dirname} testsetplatform {
-    testsetplatform unix
-    list [catch {file dirname a b} msg] $msg
-} {1 {wrong # args: should be "file dirname name"}}
+test cmdAH-8.1 {Tcl_FileObjCmd: dirname} -returnCodes error -body {
+    file dirname a b
+} -result {wrong # args: should be "file dirname name"}
 test cmdAH-8.2 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
     file dirname /a/b
@@ -274,125 +306,116 @@ test cmdAH-8.11 {Tcl_FileObjCmd: dirname} testsetplatform {
 } /
 test cmdAH-8.12 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname /} msg] $msg
-} {0 /}
+    file dirname /
+} /
 test cmdAH-8.13 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname /foo} msg] $msg
-} {0 /}
+    file dirname /foo
+} /
 test cmdAH-8.14 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname //foo} msg] $msg
-} {0 /}
+    file dirname //foo
+} /
 test cmdAH-8.15 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname //foo/bar} msg] $msg
-} {0 /foo}
+    file dirname //foo/bar
+} /foo
 test cmdAH-8.16 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname {//foo\/bar/baz}} msg] $msg
-} {0 {/foo\/bar}}
+    file dirname {//foo\/bar/baz}
+} {/foo\/bar}
 test cmdAH-8.17 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname {//foo\/bar/baz/blat}} msg] $msg
-} {0 {/foo\/bar/baz}}
+    file dirname {//foo\/bar/baz/blat}
+} {/foo\/bar/baz}
 test cmdAH-8.18 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname /foo//} msg] $msg
-} {0 /}
+    file dirname /foo//
+} /
 test cmdAH-8.19 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname ./a} msg] $msg
-} {0 .}
+    file dirname ./a
+} .
 test cmdAH-8.20 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname a/.a} msg] $msg
-} {0 a}
+    file dirname a/.a
+} a
 test cmdAH-8.21 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform windows
-    list [catch {file dirname c:foo} msg] $msg
-} {0 c:}
+    file dirname c:foo
+} c:
 test cmdAH-8.22 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform windows
-    list [catch {file dirname c:} msg] $msg
-} {0 c:}
+    file dirname c:
+} c:
 test cmdAH-8.23 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform windows
-    list [catch {file dirname c:/} msg] $msg
-} {0 c:/}
+    file dirname c:/
+} c:/
 test cmdAH-8.24 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform windows
-    list [catch {file dirname {c:\foo}} msg] $msg
-} {0 c:/}
+    file dirname {c:\foo}
+} c:/
 test cmdAH-8.25 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform windows
-    list [catch {file dirname {//foo/bar/baz}} msg] $msg
-} {0 //foo/bar}
+    file dirname {//foo/bar/baz}
+} //foo/bar
 test cmdAH-8.26 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform windows
-    list [catch {file dirname {//foo/bar}} msg] $msg
-} {0 //foo/bar}
+    file dirname {//foo/bar}
+} //foo/bar
 test cmdAH-8.38 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname ~/foo} msg] $msg
-} {0 ~}
+    file dirname ~/foo
+} ~
 test cmdAH-8.39 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
-    list [catch {file dirname ~bar/foo} msg] $msg
-} {0 ~bar}
-test cmdAH-8.43 {Tcl_FileObjCmd: dirname} testsetplatform {
+    file dirname ~bar/foo
+} ~bar
+test cmdAH-8.43 {Tcl_FileObjCmd: dirname} -setup {
     global env
     set temp $env(HOME)
+} -constraints testsetplatform -body {
     set env(HOME) "/homewontexist/test"
     testsetplatform unix
-    set result [list [catch {file dirname ~} msg] $msg]
+    file dirname ~
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 /homewontexist}
-test cmdAH-8.44 {Tcl_FileObjCmd: dirname} testsetplatform {
+} -result /homewontexist
+test cmdAH-8.44 {Tcl_FileObjCmd: dirname} -setup {
     global env
     set temp $env(HOME)
+} -constraints testsetplatform -body {
     set env(HOME) "~"
     testsetplatform unix
-    set result [list [catch {file dirname ~} msg] $msg]
+    file dirname ~
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 ~}
-test cmdAH-8.45 {Tcl_FileObjCmd: dirname} {
-    -constraints {win testsetplatform}
-    -match regexp
-    -setup {
-	set temp $::env(HOME)
-    }	
-    -body {
-	set ::env(HOME) "/homewontexist/test"
-	testsetplatform windows
-	file dirname ~
-    }
-    -cleanup {
-	set ::env(HOME) $temp
-    }
-    -result {([a-zA-Z]:?)/homewontexist}
-}
+} -result ~
+test cmdAH-8.45 {Tcl_FileObjCmd: dirname} -setup {
+    set temp $::env(HOME)
+} -constraints {win testsetplatform} -match regexp -body {
+    set ::env(HOME) "/homewontexist/test"
+    testsetplatform windows
+    file dirname ~
+} -cleanup {
+    set ::env(HOME) $temp
+} -result {([a-zA-Z]:?)/homewontexist}
 test cmdAH-8.46 {Tcl_FileObjCmd: dirname} {
     set f [file normalize [info nameof]]
     file exists $f
     set res1 [file dirname [file join $f foo/bar]]
     set res2 [file dirname "${f}/foo/bar"]
     if {$res1 eq $res2} {
-	set res "ok"
-    } else {
-        set res "file dirname problem, $res1, $res2 not equal"
+	return "ok"
     }
-    set res
+    return "file dirname problem, $res1, $res2 not equal"
 } {ok}
 
 # tail
-
-test cmdAH-9.1 {Tcl_FileObjCmd: tail} testsetplatform {
-    testsetplatform unix
-    list [catch {file tail a b} msg] $msg
-} {1 {wrong # args: should be "file tail name"}}
+test cmdAH-9.1 {Tcl_FileObjCmd: tail} -returnCodes error -body {
+    file tail a b
+} -result {wrong # args: should be "file tail name"}
 test cmdAH-9.2 {Tcl_FileObjCmd: tail} testsetplatform {
     testsetplatform unix
     file tail /a/b
@@ -485,33 +508,36 @@ test cmdAH-9.26 {Tcl_FileObjCmd: tail} testsetplatform {
     testsetplatform windows
     file tail {//foo/bar}
 } {}
-test cmdAH-9.42 {Tcl_FileObjCmd: tail} testsetplatform {
+test cmdAH-9.42 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup {
     global env
     set temp $env(HOME)
+} -body {
     set env(HOME) "/home/test"
     testsetplatform unix
-    set result [file tail ~]
+    file tail ~
+} -cleanup {
     set env(HOME) $temp
-    set result
-} test
-test cmdAH-9.43 {Tcl_FileObjCmd: tail} testsetplatform {
+} -result test
+test cmdAH-9.43 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup {
     global env
     set temp $env(HOME)
+} -body {
     set env(HOME) "~"
     testsetplatform unix
-    set result [file tail ~]
+    file tail ~
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {}
-test cmdAH-9.44 {Tcl_FileObjCmd: tail} testsetplatform {
+} -result {}
+test cmdAH-9.44 {Tcl_FileObjCmd: tail} -constraints testsetplatform -setup {
     global env
     set temp $env(HOME)
+} -body {
     set env(HOME) "/home/test"
     testsetplatform windows
-    set result [file tail ~]
+    file tail ~
+} -cleanup {
     set env(HOME) $temp
-    set result
-} test
+} -result test
 test cmdAH-9.46 {Tcl_FileObjCmd: tail} testsetplatform {
     testsetplatform unix
     file tail {f.oo\bar/baz.bat}
@@ -538,11 +564,9 @@ test cmdAH-9.51 {Tcl_FileObjCmd: tail} testsetplatform {
 } bar
 
 # rootname
-
-test cmdAH-10.1 {Tcl_FileObjCmd: rootname} testsetplatform {
-    testsetplatform unix
-    list [catch {file rootname a b} msg] $msg
-} {1 {wrong # args: should be "file rootname name"}}
+test cmdAH-10.1 {Tcl_FileObjCmd: rootname} -returnCodes error -body {
+    file rootname a b
+} -result {wrong # args: should be "file rootname name"}
 test cmdAH-10.2 {Tcl_FileObjCmd: rootname} testsetplatform {
     testsetplatform unix
     file rootname {}
@@ -640,11 +664,9 @@ foreach outer { {} a .a a. a.a } {
 }
 
 # extension
-
-test cmdAH-11.1 {Tcl_FileObjCmd: extension} testsetplatform {
-    testsetplatform unix
-    list [catch {file extension a b} msg] $msg
-} {1 {wrong # args: should be "file extension name"}}
+test cmdAH-11.1 {Tcl_FileObjCmd: extension} -returnCodes error -body {
+    file extension a b
+} -result {wrong # args: should be "file extension name"}
 test cmdAH-11.2 {Tcl_FileObjCmd: extension} testsetplatform {
     testsetplatform unix
     file extension {}
@@ -729,23 +751,26 @@ test cmdAH-11.34 {Tcl_FileObjCmd: extension} testsetplatform {
     testsetplatform windows
     file extension a\\b.c\\
 } {}
-set num 35
-foreach value {a..b a...b a.c..b ..b} result {.b .b .b .b} {
-    foreach p {unix windows} {
-	;test cmdAH-11.$num {Tcl_FileObjCmd: extension} testsetplatform "
-	    testsetplatform $p
-	    file extension $value
-	" $result
-	incr num
-    }
+foreach {test onPlatform value result} {
+    cmdAH-11.35 unix    a..b   .b
+    cmdAH-11.36 windows a..b   .b
+    cmdAH-11.37 unix    a...b  .b
+    cmdAH-11.38 windows a...b  .b
+    cmdAH-11.39 unix    a.c..b .b
+    cmdAH-11.40 windows a.c..b .b
+    cmdAH-11.41 unix    ..b    .b
+    cmdAH-11.42 windows ..b    .b
+} {
+    test $test {Tcl_FileObjCmd: extension} testsetplatform "
+	testsetplatform $onPlatform
+	file extension $value
+    " $result
 }
 
 # pathtype
-
-test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} testsetplatform {
-    testsetplatform unix
-    list [catch {file pathtype a b} msg] $msg
-} {1 {wrong # args: should be "file pathtype name"}}
+test cmdAH-12.1 {Tcl_FileObjCmd: pathtype} -returnCodes error -body {
+    file pathtype a b
+} -result {wrong # args: should be "file pathtype name"}
 test cmdAH-12.2 {Tcl_FileObjCmd: pathtype} testsetplatform {
     testsetplatform unix
     file pathtype /a
@@ -760,11 +785,9 @@ test cmdAH-12.4 {Tcl_FileObjCmd: pathtype} testsetplatform {
 } volumerelative
 
 # split
-
-test cmdAH-13.1 {Tcl_FileObjCmd: split} testsetplatform {
-    testsetplatform unix
-    list [catch {file split a b} msg] $msg
-} {1 {wrong # args: should be "file split name"}}
+test cmdAH-13.1 {Tcl_FileObjCmd: split} -returnCodes error -body {
+    file split a b
+} -result {wrong # args: should be "file split name"}
 test cmdAH-13.2 {Tcl_FileObjCmd: split} testsetplatform {
     testsetplatform unix
     file split a
@@ -775,7 +798,6 @@ test cmdAH-13.3 {Tcl_FileObjCmd: split} testsetplatform {
 } {a b}
 
 # join
-
 test cmdAH-14.1 {Tcl_FileObjCmd: join} testsetplatform {
     testsetplatform unix
     file join a
@@ -790,22 +812,20 @@ test cmdAH-14.3 {Tcl_FileObjCmd: join} testsetplatform {
 } a/b/c/d
 
 # error handling of Tcl_TranslateFileName
-
-test cmdAH-15.1 {Tcl_FileObjCmd} testsetplatform {
+test cmdAH-15.1 {Tcl_FileObjCmd} -constraints testsetplatform -body {
     testsetplatform unix
-    list [catch {file atime ~_bad_user} msg] $msg
-} {1 {user "_bad_user" doesn't exist}}
+    file atime ~_bad_user
+} -returnCodes error -result {user "_bad_user" doesn't exist}
 
 catch {testsetplatform $platform}
 
 # readable
-
 set gorpfile [makeFile abcde gorp.file]
 set dirfile [makeDirectory dir.file]
-
 test cmdAH-16.1 {Tcl_FileObjCmd: readable} {
-    -body   {list [catch {file readable a b} msg] $msg}
-    -result {1 {wrong # args: should be "file readable name"}}
+    -returnCodes error
+    -body   {file readable a b}
+    -result {wrong # args: should be "file readable name"}
 }
 test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
     -constraints testchmod
@@ -816,15 +836,15 @@ test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
 test cmdAH-16.3 {Tcl_FileObjCmd: readable} {
     -constraints {unix notRoot testchmod}
     -setup  	 {testchmod 0333 $gorpfile}
-    -body   	 {file reada $gorpfile}
+    -body   	 {file readable $gorpfile}
     -result 	 0
 }
 
 # writable
-
 test cmdAH-17.1 {Tcl_FileObjCmd: writable} {
-    -body   {list [catch {file writable a b} msg] $msg}
-    -result {1 {wrong # args: should be "file writable name"}}
+    -returnCodes error
+    -body   {file writable a b}
+    -result {wrong # args: should be "file writable name"}
 }
 test cmdAH-17.2 {Tcl_FileObjCmd: writable} {
     -constraints {notRoot testchmod}
@@ -839,49 +859,41 @@ test cmdAH-17.3 {Tcl_FileObjCmd: writable} {
     -result 	 1
 }
 
-
 # executable
-
 removeFile $gorpfile
 removeDirectory $dirfile
 set dirfile [makeDirectory dir.file]
 set gorpfile [makeFile abcde gorp.file]
-
-test cmdAH-18.1 {Tcl_FileObjCmd: executable} {testchmod} {
-    list [catch {file executable a b} msg] $msg
-} {1 {wrong # args: should be "file executable name"}}
-test cmdAH-18.2 {Tcl_FileObjCmd: executable} {testchmod notRoot} {
+test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body {
+    file executable a b
+} -result {wrong # args: should be "file executable name"}
+test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot} {
     file executable $gorpfile
 } 0
 test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
-    # Only on unix will setting the execute bit on a regular file
-    # cause that file to be executable.
-
+    # Only on unix will setting the execute bit on a regular file cause that
+    # file to be executable.
     testchmod 0775 $gorpfile
     file exe $gorpfile
 } 1
-
-test cmdAH-18.5 {Tcl_FileObjCmd: executable} {win testchmod} {
+test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
     # On pc, must be a .exe, .com, etc.
-
     set x [file exe $gorpfile]
     set gorpexe [makeFile foo gorp.exe]
     lappend x [file exe $gorpexe]
+} -cleanup {
     removeFile $gorpexe
-    set x
-} {0 1}
-test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} {win testchmod} {
+} -result {0 1}
+test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} -constraints {win} -body {
     # On pc, must be a .exe, .com, etc.
-
     set x [file exe $gorpfile]
     set gorpexe [makeFile foo gorp.exe]
     lappend x [file exe [string toupper $gorpexe]]
+} -cleanup {
     removeFile $gorpexe
-    set x
-} {0 1}
-test cmdAH-18.6 {Tcl_FileObjCmd: executable} {testchmod} {
+} -result {0 1}
+test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} {
     # Directories are always executable.
-
     file exe $dirfile
 } 1
 
@@ -891,10 +903,9 @@ set linkfile [file join [temporaryDirectory] link.file]
 file delete $linkfile
 
 # exists
-
-test cmdAH-19.1 {Tcl_FileObjCmd: exists} {
-    list [catch {file exists a b} msg] $msg
-} {1 {wrong # args: should be "file exists name"}}
+test cmdAH-19.1 {Tcl_FileObjCmd: exists} -returnCodes error -body {
+    file exists a b
+} -result {wrong # args: should be "file exists name"}
 test cmdAH-19.2 {Tcl_FileObjCmd: exists} {file exists $gorpfile} 0
 test cmdAH-19.3 {Tcl_FileObjCmd: exists} {
     file exists [file join [temporaryDirectory] dir.file gorp.file]
@@ -910,43 +921,55 @@ test cmdAH-19.4 {Tcl_FileObjCmd: exists} {
 test cmdAH-19.5 {Tcl_FileObjCmd: exists} {
     file exists $subgorp
 } 1
-
 # nativename
-test cmdAH-19.6 {Tcl_FileObjCmd: nativename} testsetplatform {
+test cmdAH-19.6 {Tcl_FileObjCmd: nativename} -body {
     testsetplatform unix
-    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
-} {0 a/b {}}
-test cmdAH-19.7 {Tcl_FileObjCmd: nativename} testsetplatform {
+    file nativename a/b
+} -constraints testsetplatform -cleanup {
+    testsetplatform $platform
+} -result a/b
+test cmdAH-19.7 {Tcl_FileObjCmd: nativename} -body {
     testsetplatform windows
-    list [catch {file nativename a/b} msg] $msg [testsetplatform $platform]
-} {0 {a\b} {}}
-
+    file nativename a/b
+} -constraints testsetplatform -cleanup {
+    testsetplatform $platform
+} -result {a\b}
 test cmdAH-19.9 {Tcl_FileObjCmd: ~ : exists} {
     file exists ~nOsUcHuSeR
 } 0
-test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} {
-    # should probably be 0 in fact...
-    catch {file nativename ~nOsUcHuSeR}
-} 1
-
-# The test below has to be done in /tmp rather than the current
-# directory in order to guarantee (?) a local file system:  some
-# NFS file systems won't do the stuff below correctly.
-
-test cmdAH-19.11 {Tcl_FileObjCmd: exists} {unix notRoot} {
+test cmdAH-19.10 {Tcl_FileObjCmd: ~ : nativename} -body {
+    # should probably be a non-error in fact...
+    file nativename ~nOsUcHuSeR
+} -returnCodes error -match glob -result *
+# The test below has to be done in /tmp rather than the current directory in
+# order to guarantee (?) a local file system: some NFS file systems won't do
+# the stuff below correctly.
+test cmdAH-19.11 {Tcl_FileObjCmd: exists} -constraints {unix notRoot} -setup {
     file delete -force /tmp/tcl.foo.dir/file
     file delete -force /tmp/tcl.foo.dir
+} -body {
     makeDirectory /tmp/tcl.foo.dir
     makeFile 12345 /tmp/tcl.foo.dir/file
     file attributes /tmp/tcl.foo.dir -permissions 0000
-
-    set result [file exists /tmp/tcl.foo.dir/file]
-
+    file exists /tmp/tcl.foo.dir/file
+} -cleanup {
     file attributes /tmp/tcl.foo.dir -permissions 0775
     removeFile /tmp/tcl.foo.dir/file
     removeDirectory /tmp/tcl.foo.dir
-    set result
-} 0
+} -result 0
+test cmdAH-19.12 {Bug 3608360: [file exists] mustn't do globbing} -setup {
+    set newdirfile [makeDirectory newdir.file]
+    set cwd [pwd]
+    cd $newdirfile
+    # Content of file is totally unimportant; name is *not*
+    set innocentBystander [makeFile "abc" [file join $newdirfile foo.bar]]
+} -body {
+    list [file exists foo.bar] [file exists *.bar]
+} -cleanup {
+    cd $cwd
+    removeFile $innocentBystander
+    removeDirectory $newdirfile
+} -result {1 0}
 
 # Stat related commands
 
@@ -955,31 +978,30 @@ removeFile $gorpfile
 set gorpfile [makeFile "Test string" gorp.file]
 catch {file attributes $gorpfile -permissions 0765}
 
-# atime
-
 # avoid problems with non-local filesystems
-if {$::tcl_platform(platform) == "unix" && [file exists /tmp]} {
+if {[testConstraint unix] && [file exists /tmp]} {
     set file [makeFile "data" touch.me /tmp]
 } else {
     set file [makeFile "data" touch.me]
 }
 
-test cmdAH-20.1 {Tcl_FileObjCmd: atime} {
-    list [catch {file atime a b c} msg] $msg
-} {1 {wrong # args: should be "file atime name ?time?"}}
-test cmdAH-20.2 {Tcl_FileObjCmd: atime} {
-    catch {unset stat}
+# atime
+test cmdAH-20.1 {Tcl_FileObjCmd: atime} -returnCodes error -body {
+    file atime a b c
+} -result {wrong # args: should be "file atime name ?time?"}
+test cmdAH-20.2 {Tcl_FileObjCmd: atime} -setup {
+    unset -nocomplain stat
+} -body {
     file stat $gorpfile stat
     list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
 	    [expr {[file atime $gorpfile] == $stat(atime)}]
-} {1 1}
+} -result {1 1}
 test cmdAH-20.3 {Tcl_FileObjCmd: atime} {
-    string tolower [list [catch {file atime _bogus_} msg] \
-	    $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-20.4 {Tcl_FileObjCmd: atime} {
-    list [catch {file atime $file notint} msg] $msg
-} {1 {expected integer but got "notint"}}
+    list [catch {file atime _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-20.4 {Tcl_FileObjCmd: atime} -returnCodes error -body {
+    file atime $file notint
+} -result {expected integer but got "notint"}
 test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unix} {
     set atime [file atime $file]
     after 1100; # pause a sec to notice change in atime
@@ -987,13 +1009,15 @@ test cmdAH-20.5 {Tcl_FileObjCmd: atime touch} {unix} {
     set modatime [file atime $file $newatime]
     expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
 } 1
-test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {win testvolumetype} {
+test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} -setup {
     set old [pwd]
     cd $::tcltest::temporaryDirectory
-    if {![string equal "NTFS" [testvolumetype]]} {
-	# Windows FAT doesn't understand atime, but NTFS does
-	# May also fail for Windows on NFS mounted disks
-	cd $old
+    set volumetype [testvolumetype]
+    cd $old
+} -constraints {win testvolumetype} -body {
+    if {"NTFS" ne $volumetype} {
+	# Windows FAT doesn't understand atime, but NTFS does. May also fail
+	# for Windows on NFS mounted disks.
 	return 1
     }
     cd $old
@@ -1002,135 +1026,117 @@ test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} {win testvolumetype} {
     set newatime [clock seconds]
     set modatime [file atime $file $newatime]
     expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
-} 1
+} -result 1
 
-if {$::tcl_platform(platform) == "unix" && [file exists /tmp]} {
+if {[testConstraint unix] && [file exists /tmp]} {
     removeFile touch.me /tmp
 } else {
     removeFile touch.me
 }
 
 # isdirectory
-
-test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} {
-    list [catch {file isdirectory a b} msg] $msg
-} {1 {wrong # args: should be "file isdirectory name"}}
-test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {
-    file isdirectory $gorpfile
-} 0
-test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {
-    file isd $dirfile
-} 1
+test cmdAH-21.1 {Tcl_FileObjCmd: isdirectory} -returnCodes error -body {
+    file isdirectory a b
+} -result {wrong # args: should be "file isdirectory name"}
+test cmdAH-21.2 {Tcl_FileObjCmd: isdirectory} {file isdirectory $gorpfile} 0
+test cmdAH-21.3 {Tcl_FileObjCmd: isdirectory} {file isdirectory $dirfile} 1
 
 # isfile
-
-test cmdAH-22.1 {Tcl_FileObjCmd: isfile} {
-    list [catch {file isfile a b} msg] $msg
-} {1 {wrong # args: should be "file isfile name"}}
+test cmdAH-22.1 {Tcl_FileObjCmd: isfile} -returnCodes error -body {
+    file isfile a b
+} -result {wrong # args: should be "file isfile name"}
 test cmdAH-22.2 {Tcl_FileObjCmd: isfile} {file isfile $gorpfile} 1
 test cmdAH-22.3 {Tcl_FileObjCmd: isfile} {file isfile $dirfile} 0
 
-# lstat and readlink:  don't run these tests everywhere, since not all
-# sites will have symbolic links
-
+# lstat and readlink: don't run these tests everywhere, since not all sites
+# will have symbolic links
 catch {file link -symbolic $linkfile $gorpfile}
-test cmdAH-23.1 {Tcl_FileObjCmd: lstat} {
-    list [catch {file lstat a} msg] $msg
-} {1 {wrong # args: should be "file lstat name varName"}}
-test cmdAH-23.2 {Tcl_FileObjCmd: lstat} {
-    list [catch {file lstat a b c} msg] $msg
-} {1 {wrong # args: should be "file lstat name varName"}}
-test cmdAH-23.3 {Tcl_FileObjCmd: lstat} {unix nonPortable} {
-    catch {unset stat}
+test cmdAH-23.1 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
+    file lstat a
+} -result {wrong # args: should be "file lstat name varName"}
+test cmdAH-23.2 {Tcl_FileObjCmd: lstat} -returnCodes error -body {
+    file lstat a b c
+} -result {wrong # args: should be "file lstat name varName"}
+test cmdAH-23.3 {Tcl_FileObjCmd: lstat} -setup {
+    unset -nocomplain stat
+} -constraints {unix nonPortable} -body {
     file lstat $linkfile stat
     lsort [array names stat]
-} {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdAH-23.4 {Tcl_FileObjCmd: lstat} {unix nonPortable} {
-    catch {unset stat}
+} -result {atime ctime dev gid ino mode mtime nlink size type uid}
+test cmdAH-23.4 {Tcl_FileObjCmd: lstat} -setup {
+    unset -nocomplain stat
+} -constraints {unix nonPortable} -body {
     file lstat $linkfile stat
     list $stat(nlink) [expr $stat(mode)&0777] $stat(type)
-} {1 511 link}
+} -result {1 511 link}
 test cmdAH-23.5 {Tcl_FileObjCmd: lstat errors} {nonPortable} {
-    string tolower [list [catch {file lstat _bogus_ stat} msg] \
-	    $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} {
-    catch {unset x}
+    list [catch {file lstat _bogus_ stat} msg] [string tolower $msg] \
+	$errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-23.6 {Tcl_FileObjCmd: lstat errors} -setup {
+    unset -nocomplain x
+} -body {
     set x 44
     list [catch {file lstat $gorpfile x} msg] $msg $errorCode
-} {1 {can't set "x(dev)": variable isn't array} NONE}
-catch {unset stat}
-
+} -result {1 {can't set "x(dev)": variable isn't array} {TCL LOOKUP VARNAME x}}
+unset -nocomplain stat
 # mkdir
-
 set dirA [file join [temporaryDirectory] a]
 set dirB [file join [temporaryDirectory] a]
-test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} {
+test cmdAH-23.7 {Tcl_FileObjCmd: mkdir} -setup {
     catch {file delete -force $dirA}
+} -body {
     file mkdir $dirA
-    set res [file isdirectory $dirA]
+    file isdirectory $dirA
+} -cleanup {
     file delete $dirA
-    set res
-} {1}
-test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} {
+} -result {1}
+test cmdAH-23.8 {Tcl_FileObjCmd: mkdir} -setup {
     catch {file delete -force $dirA}
+} -body {
     file mkdir $dirA/b
-    set res [file isdirectory $dirA/b]
+    file isdirectory $dirA/b
+} -cleanup {
     file delete -force $dirA
-    set res
-} {1}
-test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} {
+} -result {1}
+test cmdAH-23.9 {Tcl_FileObjCmd: mkdir} -setup {
     catch {file delete -force $dirA}
+} -body {
     file mkdir $dirA/b/c
-    set res [file isdirectory $dirA/b/c]
+    file isdirectory $dirA/b/c
+} -cleanup {
     file delete -force $dirA
-    set res
-} {1}
-test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} {
+} -result {1}
+test cmdAH-23.10 {Tcl_FileObjCmd: mkdir} -setup {
     catch {file delete -force $dirA}
     catch {file delete -force $dirB}
+} -body {
     file mkdir $dirA/b $dirB/a/c
-    set res [list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c]]
+    list [file isdirectory $dirA/b] [file isdirectory $dirB/a/c]
+} -cleanup {
     file delete -force $dirA
     file delete -force $dirB
-    set res
-} {1 1}
-
-# mtime
-
-proc waitForEvenSecondForFAT {} {
-    # Windows 9x uses filesystems (the FAT* family of FSes) without
-    # enough data in its timestamps for even per-second-accurate
-    # timings.  :^(
-    # This procedure based on work by Helmut Giese
+} -result {1 1}
+test cmdAH-23.11 {Tcl_FileObjCmd: mkdir} {
+    # Allow zero arguments (TIP 323)
+    file mkdir
+} {}
 
-    global tcl_platform
-    if {$tcl_platform(platform) ne "windows"} {return}
-    if {[lindex [file system [temporaryDirectory]] 1] == "NTFS"} {return}
-    # Assume non-NTFS means FAT{12,16,32} and hence in need of special help
-    set start [clock seconds]
-    while {1} {
-	set now [clock seconds]
-	if {$now!=$start && !($now & 1)} {
-	    return
-	}
-	after 50
-    }
-}
 set file [makeFile "data" touch.me]
-
-test cmdAH-24.1 {Tcl_FileObjCmd: mtime} {
-    list [catch {file mtime a b c} msg] $msg
-} {1 {wrong # args: should be "file mtime name ?time?"}}
-# Check (allowing for clock-skew and OS interrupts as best we can)
-# that the change in mtime on a file being written is the time elapsed
-# between writes.  Note that this can still fail on very busy systems
-# if there are long preemptions between the writes and the reading of
-# the clock, but there's not much you can do about that other than the
-# completely horrible "keep on trying to write until you managed to do
-# it all in less than a second."  - DKF
-test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {
+# mtime
+test cmdAH-24.1 {Tcl_FileObjCmd: mtime} -returnCodes error -body {
+    file mtime a b c
+} -result {wrong # args: should be "file mtime name ?time?"}
+test cmdAH-24.2 {Tcl_FileObjCmd: mtime} -setup {
+    # Check (allowing for clock-skew and OS interrupts as best we can) that
+    # the change in mtime on a file being written is the time elapsed between
+    # writes. Note that this can still fail on very busy systems if there are
+    # long preemptions between the writes and the reading of the clock, but
+    # there's not much you can do about that other than the completely
+    # horrible "keep on trying to write until you managed to do it all in less
+    # than a second." - DKF
     waitForEvenSecondForFAT
+} -body {
     set f [open $gorpfile w]
     puts $f "More text"
     close $f
@@ -1147,39 +1153,37 @@ test cmdAH-24.2 {Tcl_FileObjCmd: mtime} {
 	(abs(($fileNew-$fileOld) - ($clockNew-$clockOld)) <= 1)) ? "1" :
 	"file:($fileOld=>$fileNew) clock:($clockOld=>$clockNew)"
     }
-} {1}
-test cmdAH-24.3 {Tcl_FileObjCmd: mtime} {
-    catch {unset stat}
+} -result {1}
+test cmdAH-24.3 {Tcl_FileObjCmd: mtime} -setup {
+    unset -nocomplain stat
+} -body {
     file stat $gorpfile stat
     list [expr {[file mtime $gorpfile] == $stat(mtime)}] \
 	    [expr {[file atime $gorpfile] == $stat(atime)}]
-} {1 1}
+} -result {1 1}
 test cmdAH-24.4 {Tcl_FileObjCmd: mtime} {
-    string tolower [list [catch {file mtime _bogus_} msg] $msg \
-	    $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-24.5 {Tcl_FileObjCmd: mtime} {
-    # Under Unix, use a file in /tmp to avoid clock skew due to NFS.
-    # On other platforms, just use a file in the local directory.
-
-    if {[string equal $tcl_platform(platform) "unix"]} {
+    list [catch {file mtime _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-24.5 {Tcl_FileObjCmd: mtime} -setup {
+    # Under Unix, use a file in /tmp to avoid clock skew due to NFS. On other
+    # platforms, just use a file in the local directory.
+    if {[testConstraint unix]} {
 	set name /tmp/tcl.test.[pid]
     } else {
 	set name [file join [temporaryDirectory] tf]
     }
-
-    # Make sure that a new file's time is correct.  10 seconds variance
-    # is allowed used due to slow networks or clock skew on a network drive.
-
+} -body {
+    # Make sure that a new file's time is correct. 10 seconds variance is
+    # allowed used due to slow networks or clock skew on a network drive.
     file delete -force $name
     close [open $name w]
-    set a [expr abs([clock seconds]-[file mtime $name])<10]
+    expr {abs([clock seconds]-[file mtime $name])<10}
+} -cleanup {
     file delete $name
-    set a
-} {1}
-test cmdAH-24.7 {Tcl_FileObjCmd: mtime} {
-    list [catch {file mtime $file notint} msg] $msg
-} {1 {expected integer but got "notint"}}
+} -result {1}
+test cmdAH-24.7 {Tcl_FileObjCmd: mtime} -returnCodes error -body {
+    file mtime $file notint
+} -result {expected integer but got "notint"}
 test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} unix {
     set mtime [file mtime $file]
     after 1100; # pause a sec to notice change in mtime
@@ -1187,8 +1191,9 @@ test cmdAH-24.8 {Tcl_FileObjCmd: mtime touch} unix {
     set modmtime [file mtime $file $newmtime]
     expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
 } 1
-test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} unix {
+test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
     set oldfile $file
+} -constraints unix -body {
     # introduce some non-ascii characters.
     append file \u2022
     file delete -force $file
@@ -1196,24 +1201,24 @@ test cmdAH-24.9 {Tcl_FileObjCmd: mtime touch with non-ascii chars} unix {
     set mtime [file mtime $file]
     after 1100; # pause a sec to notice change in mtime
     set newmtime [clock seconds]
-    set err [catch {file mtime $file $newmtime} modmtime]
-    file rename $file $oldfile
-    if {$err} {
-	error $modmtime
-    }
+    set modmtime [file mtime $file $newmtime]
     expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
-} 1
-test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} win {
+} -cleanup {
+    file rename $file $oldfile
+} -result 1
+test cmdAH-24.10 {Tcl_FileObjCmd: mtime touch} -constraints win -setup {
     waitForEvenSecondForFAT
+} -body {
     set mtime [file mtime $file]
     after 2100; # pause two secs to notice change in mtime on FAT fs'es
     set newmtime [clock seconds]
     set modmtime [file mtime $file $newmtime]
     expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
-} 1
-test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} win {
+} -result 1
+test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} -setup {
     waitForEvenSecondForFAT
     set oldfile $file
+} -constraints win -body {
     # introduce some non-ascii characters.
     append file \u2022
     file delete -force $file
@@ -1221,33 +1226,43 @@ test cmdAH-24.11 {Tcl_FileObjCmd: mtime touch with non-ascii chars} win {
     set mtime [file mtime $file]
     after 2100; # pause two secs to notice change in mtime on FAT fs'es
     set newmtime [clock seconds]
-    set err [catch {file mtime $file $newmtime} modmtime]
-    file rename $file $oldfile
-    if {$err} {
-	error $modmtime
-    }
+    set modmtime [file mtime $file $newmtime]
     expr {$newmtime == $modmtime ? 1 : "$newmtime != $modmtime"}
-} 1
+} -cleanup {
+    file rename $file $oldfile
+} -result 1
 removeFile touch.me
 rename waitForEvenSecondForFAT {}
-
-test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} {
+test cmdAH-24.12 {Tcl_FileObjCmd: mtime and daylight savings} -setup {
     set name [file join [temporaryDirectory] clockchange]
-
     file delete -force $name
     close [open $name w]
+} -body {
     set time [clock scan "21:00:00 October 30 2004 GMT"]
     file mtime $name $time
     set newmtime [file mtime $name]
-    file delete $name
     expr {$newmtime == $time ? 1 : "$newmtime != $time"}
-} {1}
+} -cleanup {
+    file delete $name
+} -result {1}
+# bug 1420432: setting mtime fails for directories on windows.
+test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup {
+    set dirname [file join [temporaryDirectory] tmp[pid]]
+    file delete -force $dirname
+} -constraints tempNotWin -body {
+    file mkdir $dirname
+    set old [file mtime $dirname]
+    file mtime $dirname 0
+    set new [file mtime $dirname]
+    list $new [expr {$old != $new}]
+} -cleanup {
+    file delete -force $dirname
+} -result {0 1}
 
 # owned
-
-test cmdAH-25.1 {Tcl_FileObjCmd: owned} {
-    list [catch {file owned a b} msg] $msg
-} {1 {wrong # args: should be "file owned name"}}
+test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
+    file owned a b
+} -result {wrong # args: should be "file owned name"}
 test cmdAH-25.2 {Tcl_FileObjCmd: owned} -constraints win -body {
     file owned $gorpfile
 } -result 1
@@ -1264,27 +1279,23 @@ test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
 } 0
 
 # readlink
-
-test cmdAH-26.1 {Tcl_FileObjCmd: readlink} {
-    list [catch {file readlink a b} msg] $msg
-} {1 {wrong # args: should be "file readlink name"}}
+test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body {
+    file readlink a b
+} -result {wrong # args: should be "file readlink name"}
 test cmdAH-26.2 {Tcl_FileObjCmd: readlink} {unix nonPortable} {
     file readlink $linkfile
 } $gorpfile
 test cmdAH-26.3 {Tcl_FileObjCmd: readlink errors} {unix nonPortable} {
-    list [catch {file readlink _bogus_} msg] [string tolower $msg] \
-	    [string tolower $errorCode]
-} {1 {could not readlink "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+    list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not readlink "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
 test cmdAH-26.5 {Tcl_FileObjCmd: readlink errors} {win nonPortable} {
-    list [catch {file readlink _bogus_} msg] [string tolower $msg] \
-	    [string tolower $errorCode]
-} {1 {could not readlink "_bogus_": invalid argument} {posix einval {invalid argument}}}
+    list [catch {file readlink _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not readlink "_bogus_": invalid argument} {POSIX EINVAL {invalid argument}}}
 
 # size
-
-test cmdAH-27.1 {Tcl_FileObjCmd: size} {
-    list [catch {file size a b} msg] $msg
-} {1 {wrong # args: should be "file size name"}}
+test cmdAH-27.1 {Tcl_FileObjCmd: size} -returnCodes error -body {
+    file size a b
+} -result {wrong # args: should be "file size name"}
 test cmdAH-27.2 {Tcl_FileObjCmd: size} {
     set oldsize [file size $gorpfile]
     set f [open $gorpfile a]
@@ -1294,106 +1305,105 @@ test cmdAH-27.2 {Tcl_FileObjCmd: size} {
     expr {[file size $gorpfile] - $oldsize}
 } {10}
 test cmdAH-27.3 {Tcl_FileObjCmd: size} {
-    string tolower [list [catch {file size _bogus_} msg] $msg \
-	    $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-
-# stat
+    list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
 
 catch {testsetplatform $platform}
 removeFile $gorpfile
 set gorpfile [makeFile "Test string" gorp.file]
 catch {file attributes $gorpfile -permissions 0765}
 
-test cmdAH-28.1 {Tcl_FileObjCmd: stat} {
-    list [catch {file stat _bogus_} msg] $msg $errorCode
-} {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdAH-28.2 {Tcl_FileObjCmd: stat} {
-    list [catch {file stat _bogus_ a b} msg] $msg $errorCode
-} {1 {wrong # args: should be "file stat name varName"} NONE}
-test cmdAH-28.3 {Tcl_FileObjCmd: stat} {
-    catch {unset stat}
+# stat
+test cmdAH-28.1 {Tcl_FileObjCmd: stat} -returnCodes error -body {
+    file stat _bogus_
+} -result {wrong # args: should be "file stat name varName"}
+test cmdAH-28.2 {Tcl_FileObjCmd: stat} -returnCodes error -body {
+    file stat _bogus_ a b
+} -result {wrong # args: should be "file stat name varName"}
+test cmdAH-28.3 {Tcl_FileObjCmd: stat} -setup {
+    unset -nocomplain stat
+    set stat(blocks) [set stat(blksize) {}]
+} -body {
     file stat $gorpfile stat
+    unset stat(blocks) stat(blksize); # Ignore these fields; not always set
     lsort [array names stat]
-} {atime ctime dev gid ino mode mtime nlink size type uid}
-test cmdAH-28.4 {Tcl_FileObjCmd: stat} {
-    catch {unset stat}
+} -result {atime ctime dev gid ino mode mtime nlink size type uid}
+test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup {
+    unset -nocomplain stat
+} -body {
     file stat $gorpfile stat
     list $stat(nlink) $stat(size) $stat(type)
-} {1 12 file}
-test cmdAH-28.5 {Tcl_FileObjCmd: stat} {unix} {
-    catch {unset stat}
+} -result {1 12 file}
+test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup {
+    unset -nocomplain stat
+} -body {
     file stat $gorpfile stat
-    expr $stat(mode)&0777
-} {501}
+    expr {$stat(mode) & 0o777}
+} -result {501}
 test cmdAH-28.6 {Tcl_FileObjCmd: stat} {
-    string tolower [list [catch {file stat _bogus_ stat} msg] \
-	    $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
-test cmdAH-28.7 {Tcl_FileObjCmd: stat} {
-    catch {unset x}
+    list [catch {file stat _bogus_ stat} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-28.7 {Tcl_FileObjCmd: stat} -setup {
+    unset -nocomplain x
+} -returnCodes error -body {
     set x 44
-    list [catch {file stat $gorpfile x} msg] $msg $errorCode
-} {1 {can't set "x(dev)": variable isn't array} NONE}
-test cmdAH-28.8 {Tcl_FileObjCmd: stat} {
-    # Sign extension of purported unsigned short to int.
-
+    file stat $gorpfile x
+} -result {can't set "x(dev)": variable isn't array}
+test cmdAH-28.8 {Tcl_FileObjCmd: stat} -setup {
     set filename [makeFile "" foo.text]
+} -body {
+    # Sign extension of purported unsigned short to int.
     file stat $filename stat
-    set x [expr {$stat(mode) > 0}]
+    expr {$stat(mode) > 0}
+} -cleanup {
     removeFile $filename
-    set x
-} 1
+} -result 1
 test cmdAH-28.9 {Tcl_FileObjCmd: stat} win {
-    # stat of root directory was failing.
-    # don't care about answer, just that test runs.
-
-    # relative paths that resolve to root
+    # stat of root directory was failing. Don't care about answer, just that
+    # test runs. Relative paths that resolve to root
     set old [pwd]
     cd c:/
     file stat c: stat
     file stat c:. stat
     file stat . stat
     cd $old
-
     file stat / stat
     file stat c:/ stat
     file stat c:/. stat
 } {}
 test cmdAH-28.10 {Tcl_FileObjCmd: stat} {win nonPortable} {
-    # stat of root directory was failing.
-    # don't care about answer, just that test runs.
-
+    # stat of root directory was failing. Don't care about answer, just that
+    # test runs.
     file stat //pop/$env(USERNAME) stat
     file stat //pop/$env(USERNAME)/ stat
     file stat //pop/$env(USERNAME)/. stat
 } {}
-test cmdAH-28.11 {Tcl_FileObjCmd: stat} {win nonPortable} {
-    # stat of network directory was returning id of current local drive.
-
+test cmdAH-28.11 {Tcl_FileObjCmd: stat} -setup {
     set old [pwd]
+} -constraints {win nonPortable} -body {
+    # stat of network directory was returning id of current local drive.
     cd c:/
-
     file stat //pop/$env(USERNAME) stat
-    cd $old
     expr {$stat(dev) == 2}
-} 0
-test cmdAH-28.12 {Tcl_FileObjCmd: stat} {
-    # stat(mode) with S_IFREG flag was returned as a negative number
-    # if mode_t was a short instead of an unsigned short.
-
+} -cleanup {
+    cd $old
+} -result 0
+test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup {
     set filename [makeFile "" foo.test]
+} -body {
+    # stat(mode) with S_IFREG flag was returned as a negative number if mode_t
+    # was a short instead of an unsigned short.
     file stat $filename stat
-    removeFile $filename
     expr {$stat(mode) > 0}
-} 1
-catch {unset stat}
+} -cleanup {
+    removeFile $filename
+} -result 1
+unset -nocomplain stat
 
 # type
-
-test cmdAH-29.1 {Tcl_FileObjCmd: type} {
-    list [catch {file size a b} msg] $msg
-} {1 {wrong # args: should be "file size name"}}
+test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
+    file size a b
+} -result {wrong # args: should be "file size name"}
 test cmdAH-29.2 {Tcl_FileObjCmd: type} {
     file type $dirfile
 } directory
@@ -1406,79 +1416,78 @@ test cmdAH-29.3.0 {Tcl_FileObjCmd: delete removes link not file} {unix nonPortab
 test cmdAH-29.3 {Tcl_FileObjCmd: type} {
     file type $gorpfile
 } file
-test cmdAH-29.4 {Tcl_FileObjCmd: type} {unix} {
+test cmdAH-29.4 {Tcl_FileObjCmd: type} -constraints {unix} -setup {
     catch {file delete $linkfile}
+} -body {
     # Unlike [exec ln -s], [file link] requires an existing target
     file link -symbolic $linkfile $gorpfile
-    set result [file type $linkfile]
+    file type $linkfile
+} -cleanup {
     file delete $linkfile
-    set result
-} link
-test cmdAH-29.4.1 {Tcl_FileObjCmd: type} {linkDirectory} {
+} -result link
+test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup {
     set tempdir [makeDirectory temp]
+} -body {
     set linkdir [file join [temporaryDirectory] link.dir]
     file link -symbolic $linkdir $tempdir
-    set result [file type $linkdir]
+    file type $linkdir
+} -cleanup {
     file delete $linkdir
     removeDirectory $tempdir
-    set result
-} link
+} -result link
 test cmdAH-29.5 {Tcl_FileObjCmd: type} {
-    string tolower [list [catch {file type _bogus_} msg] $msg $errorCode]
-} {1 {could not read "_bogus_": no such file or directory} {posix enoent {no such file or directory}}}
+    list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode
+} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
 
 # Error conditions
-
-test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} {
-    list [catch {file gorp x} msg] $msg
-} {1 {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, type, volumes, or writable}}
-test cmdAH-30.2 {Tcl_FileObjCmd: error conditions} {
-    list [catch {file ex x} msg] $msg
-} {1 {ambiguous option "ex": 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, type, volumes, or writable}}
-test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} {
-    list [catch {file is x} msg] $msg
-} {1 {ambiguous option "is": 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, type, volumes, or writable}}
-test cmdAH-30.4 {Tcl_FileObjCmd: error conditions} {
-    list [catch {file z x} msg] $msg
-} {1 {bad option "z": 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, type, volumes, or writable}}
-test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} {
-    list [catch {file read x} msg] $msg
-} {1 {ambiguous option "read": 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, type, volumes, or writable}}
-test cmdAH-30.6 {Tcl_FileObjCmd: error conditions} {
-    list [catch {file s x} msg] $msg
-} {1 {ambiguous option "s": 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, type, volumes, or writable}}
-test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} {
-    list [catch {file t x} msg] $msg
-} {1 {ambiguous option "t": 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, type, volumes, or writable}}
-test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
-    list [catch {file dirname ~woohgy} msg] $msg
-} {1 {user "woohgy" doesn't exist}}
+test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
+    file gorp x
+} -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 {unknown or ambiguous subcommand "ex": must be *}
+test cmdAH-30.3 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
+    file is x
+} -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 {unknown or ambiguous subcommand "z": must be *}
+test cmdAH-30.5 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
+    file read x
+} -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 {unknown or ambiguous subcommand "s": must be *}
+test cmdAH-30.7 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
+    file t x
+} -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}
 
 # channels
-# In testing 'file channels', we need to make sure that a channel
-# created in one interp isn't visible in another.
+# In testing 'file channels', we need to make sure that a channel created in
+# one interp isn't visible in another.
 
 interp create simpleInterp
 interp create -safe safeInterp
-interp c
-safeInterp expose file file
+interp create
+catch {safeInterp expose file file}
 
-test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {
-    list [catch {file channels a b} msg] $msg
-} {1 {wrong # args: should be "file channels ?pattern?"}}
+test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} -body {
+    file channels a b
+} -returnCodes error -result {wrong # args: should be "file channels ?pattern?"}
 test cmdAH-31.2 {Tcl_FileObjCmd: channels, too many args} {
     # Normal interps start out with only the standard channels
     lsort [simpleInterp eval [list file chan]]
-} [lsort {stderr stdout stdin}]
+} {stderr stdin stdout}
 test cmdAH-31.3 {Tcl_FileObjCmd: channels, globbing} {
     string equal [file channels] [file channels *]
 } {1}
 test cmdAH-31.4 {Tcl_FileObjCmd: channels, globbing} {
     lsort [file channels std*]
-} [lsort {stdout stderr stdin}]
-
+} {stderr stdin stdout}
 set newFileId [open $gorpfile w]
-
 test cmdAH-31.5 {Tcl_FileObjCmd: channels} {
     set res [file channels $newFileId]
     string equal $newFileId $res
@@ -1487,13 +1496,11 @@ test cmdAH-31.6 {Tcl_FileObjCmd: channels in other interp} {
     # Safe interps start out with no channels
     safeInterp eval [list file channels]
 } {}
-test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} {
-    list [catch {safeInterp eval [list puts $newFileId "hello"]} msg] $msg
-} [list 1 "can not find channel named \"$newFileId\""]
-
+test cmdAH-31.7 {Tcl_FileObjCmd: channels in other interp} -body {
+    safeInterp eval [list puts $newFileId "hello"]
+} -returnCodes error -result "can not find channel named \"$newFileId\""
 interp share {} $newFileId safeInterp
 interp share {} stdout safeInterp
-
 test cmdAH-31.8 {Tcl_FileObjCmd: channels in other interp} {
     # $newFileId should now be visible in both interps
     list [file channels $newFileId] \
@@ -1506,9 +1513,7 @@ test cmdAH-31.10 {Tcl_FileObjCmd: channels in other interp} {
     # we can now write to $newFileId from slave
     safeInterp eval [list puts $newFileId "hello"]
 } {}
-
 interp transfer {} $newFileId safeInterp
-
 test cmdAH-31.11 {Tcl_FileObjCmd: channels in other interp} {
     # $newFileId should now be visible only in safeInterp
     list [file channels $newFileId] \
@@ -1522,6 +1527,54 @@ test cmdAH-31.13 {Tcl_FileObjCmd: channels in other interp} {
     safeInterp eval [list file channels]
 } {stdout}
 
+# Temp files (TIP#210)
+test cmdAH-32.1 {file tempfile - usage} -returnCodes error -body {
+    file tempfile a b c
+} -result {wrong # args: should be "file tempfile ?nameVar? ?template?"}
+test cmdAH-32.2 {file tempfile - returns a read/write channel} -body {
+    set f [file tempfile]
+    puts $f ok
+    seek $f 0
+    gets $f
+} -cleanup {
+    catch {close $f}
+} -result ok
+test cmdAH-32.3 {file tempfile - makes filenames} -setup {
+    unset -nocomplain name
+} -body {
+    set result [info exists name]
+    set f [file tempfile name]
+    lappend result [info exists name] [file exists $name]
+    close $f
+    lappend result [file exists $name]
+} -cleanup {
+    catch {close $f}
+    catch {file delete $name}
+} -result {0 1 1 1}
+# We try to obey the template on Unix, but don't (currently) bother on Win
+test cmdAH-32.4 {file tempfile - templates} -constraints unix -body {
+    close [file tempfile name foo]
+    expr {[string match foo* [file tail $name]] ? "ok" : "foo produced $name"}
+} -cleanup {
+    catch {file delete $name}
+} -result ok
+test cmdAH-32.5 {file tempfile - templates} -constraints unix -body {
+    set template [file join $dirfile foo]
+    close [file tempfile name $template]
+    expr {[string match $template* $name] ? "ok" : "$template produced $name"}
+} -cleanup {
+    catch {file delete $name}
+} -result ok
+# Not portable; not all unix systems have mkstemps()
+test cmdAH-32.6 {file tempfile - templates} -body {
+    set template [file join $dirfile foo]
+    close [file tempfile name $template.bar]
+    expr {[string match $template*.bar $name] ? "ok" :
+	  "$template.bar produced $name"}
+} -constraints {unix nonPortable} -cleanup {
+    catch {file delete $name}
+} -result ok
+
 # This shouldn't work, but just in case a test above failed...
 catch {close $newFileId}
 
@@ -1530,7 +1583,7 @@ interp delete simpleInterp
 
 # cleanup
 catch {testsetplatform $platform}
-catch {unset platform}
+unset -nocomplain platform
 
 # Tcl_ForObjCmd is tested in for.test
 
@@ -1544,3 +1597,7 @@ cd $cmdAHwd
 
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index f1653b4..23a5f96 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -1,38 +1,40 @@
-# This file contains a collection of tests for the procedures in the
-# file tclCmdIL.c.  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 the procedures in the file
+# tclCmdIL.c. 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.
-#
-# RCS: @(#) $Id: cmdIL.test,v 1.26 2005/06/01 11:00:35 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 # Used for constraining memory leak tests
 testConstraint memory [llength [info commands memory]]
+testConstraint testobj [llength [info commands testobj]]
 
-test cmdIL-1.1 {Tcl_LsortObjCmd procedure} {
-    list [catch {lsort} msg] $msg
-} {1 {wrong # args: should be "lsort ?options? list"}}
-test cmdIL-1.2 {Tcl_LsortObjCmd procedure} {
-    list [catch {lsort -foo {1 3 2 5}} msg] $msg
-} {1 {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, or -unique}}
+test cmdIL-1.1 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
+    lsort
+} -result {wrong # args: should be "lsort ?-option value ...? list"}
+test cmdIL-1.2 {Tcl_LsortObjCmd procedure} -returnCodes error -body {
+    lsort -foo {1 3 2 5}
+} -result {bad option "-foo": must be -ascii, -command, -decreasing, -dictionary, -increasing, -index, -indices, -integer, -nocase, -real, -stride, or -unique}
 test cmdIL-1.3 {Tcl_LsortObjCmd procedure, default options} {
     lsort {d e c b a \{ d35 d300}
 } {a b c d d300 d35 e \{}
 test cmdIL-1.4 {Tcl_LsortObjCmd procedure, -ascii option} {
     lsort -integer -ascii {d e c b a d35 d300}
 } {a b c d d300 d35 e}
-test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} {
-    list [catch {lsort -command {1 3 2 5}} msg] $msg
-} {1 {"-command" option must be followed by comparison command}}
+test cmdIL-1.5 {Tcl_LsortObjCmd procedure, -command option} -body {
+    lsort -command {1 3 2 5}
+} -returnCodes error -result {"-command" option must be followed by comparison command}
 test cmdIL-1.6 {Tcl_LsortObjCmd procedure, -command option} -setup {
     proc cmp {a b} {
 	expr {[string match x* $b] - [string match x* $a]}
@@ -54,12 +56,12 @@ test cmdIL-1.9 {Tcl_LsortObjCmd procedure, -dictionary option} {
 test cmdIL-1.10 {Tcl_LsortObjCmd procedure, -increasing option} {
     lsort -decreasing -increasing {d e c b a d35 d300}
 } {a b c d d300 d35 e}
-test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} {
-    list [catch {lsort -index {1 3 2 5}} msg] $msg
-} {1 {"-index" option must be followed by list index}}
-test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} {
-    list [catch {lsort -index foo {1 3 2 5}} msg] $msg
-} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}}
+test cmdIL-1.11 {Tcl_LsortObjCmd procedure, -index option} -body {
+    lsort -index {1 3 2 5}
+} -returnCodes error -result {"-index" option must be followed by list index}
+test cmdIL-1.12 {Tcl_LsortObjCmd procedure, -index option} -body {
+    lsort -index foo {1 3 2 5}
+} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
 test cmdIL-1.13 {Tcl_LsortObjCmd procedure, -index option} {
     lsort -index end -integer {{2 25} {10 20 50 100} {3 16 42} 1}
 } {1 {2 25} {3 16 42} {10 20 50 100}}
@@ -69,15 +71,15 @@ test cmdIL-1.14 {Tcl_LsortObjCmd procedure, -index option} {
 test cmdIL-1.15 {Tcl_LsortObjCmd procedure, -integer option} {
     lsort -integer {24 6 300 18}
 } {6 18 24 300}
-test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} {
-    list [catch {lsort -integer {1 3 2.4}} msg] $msg
-} {1 {expected integer but got "2.4"}}
+test cmdIL-1.16 {Tcl_LsortObjCmd procedure, -integer option} -body {
+    lsort -integer {1 3 2.4}
+} -returnCodes error -result {expected integer but got "2.4"}
 test cmdIL-1.17 {Tcl_LsortObjCmd procedure, -real option} {
     lsort -real {24.2 6e3 150e-1}
 } {150e-1 24.2 6e3}
-test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} {
-    list [catch {lsort "1 2 3 \{ 4"} msg] $msg
-} {1 {unmatched open brace in list}}
+test cmdIL-1.18 {Tcl_LsortObjCmd procedure, bogus list} -body {
+    lsort "1 2 3 \{ 4"
+} -returnCodes error -result {unmatched open brace in list}
 test cmdIL-1.19 {Tcl_LsortObjCmd procedure, empty list} {
     lsort {}
 } {}
@@ -93,22 +95,21 @@ test cmdIL-1.24 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup
     proc testcmp {a b} {return [string compare $a $b]}
 } -body {
     set l [list [list a b] [list c d]]
-    list [catch {lsort -command testcmp -index 1 $l} msg] $msg
+    lsort -command testcmp -index 1 $l
 } -cleanup {
     rename testcmp ""
-} -result [list 0 [list [list a b] [list c d]]]
+} -result [list [list a b] [list c d]]
 test cmdIL-1.25 {Tcl_LsortObjCmd procedure, order of -index and -command} -setup {
     catch {rename 1 ""}
     proc testcmp {a b} {return [string compare $a $b]}
 } -body {
     set l [list [list a b] [list c d]]
-    list [catch {lsort -index 1 -command testcmp $l} msg] $msg
+    lsort -index 1 -command testcmp $l
 } -cleanup {
     rename testcmp ""
-} -result [list 0 [list [list a b] [list c d]]]
-# Note that the required order only exists in the end-1'th element;
-# indexing using the end element or any fixed offset from the start
-# will not work...
+} -result [list [list a b] [list c d]]
+# Note that the required order only exists in the end-1'th element; indexing
+# using the end element or any fixed offset from the start will not work...
 test cmdIL-1.26 {Tcl_LsortObjCmd procedure, offset indexing from end} {
     lsort -index end-1 {{a 1 e i} {b 2 3 f g} {c 4 5 6 d h}}
 } {{c 4 5 6 d h} {a 1 e i} {b 2 3 f g}}
@@ -118,9 +119,37 @@ test cmdIL-1.27 {Tcl_LsortObjCmd procedure, returning indices} {
 test cmdIL-1.28 {Tcl_LsortObjCmd procedure, returning indices} {
     lsort -indices -unique -decreasing -real {1.2 34.5 34.5 5.6}
 } {2 3 0}
+test cmdIL-1.29 {Tcl_LsortObjCmd procedure, loss of list rep during sorting} {
+    set l {1 2 3}
+    string length [lsort -command {apply {args {string length $::l}}} $l]
+} 5
+test cmdIL-1.30 {Tcl_LsortObjCmd procedure, -stride option} {
+    lsort -stride 2 {f e d c b a}
+} {b a d c f e}
+test cmdIL-1.31 {Tcl_LsortObjCmd procedure, -stride option} {
+    lsort -stride 3 {f e d c b a}
+} {c b a f e d}
+test cmdIL-1.32 {lsort -stride errors} -returnCodes error -body {
+    lsort -stride foo bar
+} -result {expected integer but got "foo"}
+test cmdIL-1.33 {lsort -stride errors} -returnCodes error -body {
+    lsort -stride 1 bar
+} -result {stride length must be at least 2}
+test cmdIL-1.34 {lsort -stride errors} -returnCodes error -body {
+    lsort -stride 2 {a b c}
+} -result {list size must be a multiple of the stride length}
+test cmdIL-1.35 {lsort -stride errors} -returnCodes error -body {
+    lsort -stride 2 -index 3 {a b c d}
+} -result {when used with "-stride", the leading "-index" value must be within the group}
+test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
+    lsort -stride 2 -index {0 1} {
+	{{c o d e} 54321} {{b l a h} 94729}
+	{{b i g} 12345} {{d e m o} 34512}
+    }
+} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
 
-# Can't think of any good tests for the MergeSort and MergeLists
-# procedures, except a bunch of random lists to sort.
+# Can't think of any good tests for the MergeSort and MergeLists procedures,
+# except a bunch of random lists to sort.
 
 test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
     set result {}
@@ -145,36 +174,35 @@ test cmdIL-2.1 {MergeSort and MergeLists procedures} -setup {
 	    set old $el
 	}
     }
-    set result
+    string trim $result
 } -cleanup {
     rename rand ""
 } -result {}
 
-test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} -setup {
-    proc cmp {a b} {
-	global x
-	incr x
-	error "error #$x"
-    }
-} -body {
-    set x 0
-    list [catch {lsort -integer -command cmp {48 6 28 190 16 2 3 6 1}} msg] \
-	    $msg $x
-} -cleanup {
-    rename cmp ""
+test cmdIL-3.1 {SortCompare procedure, skip comparisons after error} -body {
+    set ::x 0
+    list [catch {
+	lsort -integer -command {apply {{a b} {
+	    incr ::x
+	    error "error #$::x"
+	}}} {48 6 28 190 16 2 3 6 1}
+    } msg] $msg $::x
 } -result {1 {error #1} 1}
-test cmdIL-3.2 {SortCompare procedure, -index option} {
-    list [catch {lsort -integer -index 2 "\\\{ {30 40 50}"} msg] $msg
-} {1 {unmatched open brace in list}}
-test cmdIL-3.3 {SortCompare procedure, -index option} {
-    list [catch {lsort -integer -index 2 {{20 10} {15 30 40}}} msg] $msg
-} {1 {element 2 missing from sublist "20 10"}}
-test cmdIL-3.4 {SortCompare procedure, -index option} {
-    list [catch {lsort -integer -index 2 "{a b c} \\\{"} msg] $msg
-} {1 {unmatched open brace in list}}
-test cmdIL-3.5 {SortCompare procedure, -index option} {
-    list [catch {lsort -integer -index 2 {{20 10 13} {15}}} msg] $msg
-} {1 {element 2 missing from sublist "15"}}
+test cmdIL-3.2 {SortCompare procedure, -index option} -body {
+    lsort -integer -index 2 "\\\{ {30 40 50}"
+} -returnCodes error -result {unmatched open brace in list}
+test cmdIL-3.3 {SortCompare procedure, -index option} -body {
+    lsort -integer -index 2 {{20 10} {15 30 40}}
+} -returnCodes error -result {element 2 missing from sublist "20 10"}
+test cmdIL-3.4 {SortCompare procedure, -index option} -body {
+    lsort -integer -index 2 "{a b c} \\\{"
+} -returnCodes error -result {expected integer but got "c"}
+test cmdIL-3.4.1 {SortCompare procedure, -index option} -body {
+    lsort -integer -index 2 "{1 2 3} \\\{"
+} -returnCodes error -result {unmatched open brace in list}
+test cmdIL-3.5 {SortCompare procedure, -index option} -body {
+    lsort -integer -index 2 {{20 10 13} {15}}
+} -returnCodes error -result {element 2 missing from sublist "15"}
 test cmdIL-3.6 {SortCompare procedure, -index option} {
     lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}}
 } {{3 25 20} {2 5 25} {1 15 30}}
@@ -184,21 +212,21 @@ test cmdIL-3.7 {SortCompare procedure, -ascii option} {
 test cmdIL-3.8 {SortCompare procedure, -dictionary option} {
     lsort -dictionary {d e c b a d35 d300 100 20}
 } {20 100 a b c d d35 d300 e}
-test cmdIL-3.9 {SortCompare procedure, -integer option} {
-    list [catch {lsort -integer {x 3}} msg] $msg
-} {1 {expected integer but got "x"}}
-test cmdIL-3.10 {SortCompare procedure, -integer option} {
-    list [catch {lsort -integer {3 q}} msg] $msg
-} {1 {expected integer but got "q"}}
+test cmdIL-3.9 {SortCompare procedure, -integer option} -body {
+    lsort -integer {x 3}
+} -returnCodes error -result {expected integer but got "x"}
+test cmdIL-3.10 {SortCompare procedure, -integer option} -body {
+    lsort -integer {3 q}
+} -returnCodes error -result {expected integer but got "q"}
 test cmdIL-3.11 {SortCompare procedure, -integer option} {
-    lsort -integer {35 21 0x20 30 023 100 8}
-} {8 023 21 30 0x20 35 100}
-test cmdIL-3.12 {SortCompare procedure, -real option} {
-    list [catch {lsort -real {6...4 3}} msg] $msg
-} {1 {expected floating-point number but got "6...4"}}
-test cmdIL-3.13 {SortCompare procedure, -real option} {
-    list [catch {lsort -real {3 1x7}} msg] $msg
-} {1 {expected floating-point number but got "1x7"}}
+    lsort -integer {35 21 0x20 30 0o23 100 8}
+} {8 0o23 21 30 0x20 35 100}
+test cmdIL-3.12 {SortCompare procedure, -real option} -body {
+    lsort -real {6...4 3}
+} -returnCodes error -result {expected floating-point number but got "6...4"}
+test cmdIL-3.13 {SortCompare procedure, -real option} -body {
+    lsort -real {3 1x7}
+} -returnCodes error -result {expected floating-point number but got "1x7"}
 test cmdIL-3.14 {SortCompare procedure, -real option} {
     lsort -real {24 2.5e01 16.7 85e-1 10.004}
 } {85e-1 10.004 16.7 24 2.5e01}
@@ -206,7 +234,7 @@ test cmdIL-3.15 {SortCompare procedure, -command option} -body {
     proc cmp {a b} {
 	error "comparison error"
     }
-    list [catch {lsort -command cmp {48 6}} msg] $msg $errorInfo
+    list [catch {lsort -command cmp {48 6}} msg] $msg $::errorInfo
 } -cleanup {
     rename cmp ""
 } -result {1 {comparison error} {comparison error
@@ -230,10 +258,10 @@ test cmdIL-3.17 {SortCompare procedure, -command option, non-integer result} -bo
     proc cmp {a b} {
 	return foow
     }
-    list [catch {lsort -command cmp {48 6}} msg] $msg
-} -cleanup {
+    lsort -command cmp {48 6}
+} -returnCodes error -cleanup {
     rename cmp ""
-} -result {1 {-compare command returned non-integer result}}
+} -result {-compare command returned non-integer result}
 test cmdIL-3.18 {SortCompare procedure, -command option} -body {
     proc cmp {a b} {
 	expr {$b - $a}
@@ -243,8 +271,8 @@ test cmdIL-3.18 {SortCompare procedure, -command option} -body {
     rename cmp ""
 } -result {48 36 35 22 21 18 6}
 test cmdIL-3.19 {SortCompare procedure, -decreasing option} {
-    lsort -decreasing -integer {35 21 0x20 30 023 100 8}
-} {100 35 0x20 30 21 023 8}
+    lsort -decreasing -integer {35 21 0x20 30 0o23 100 8}
+} {100 35 0x20 30 21 0o23 8}
 
 test cmdIL-4.1 {DictionaryCompare procedure, numerics, leading zeros} {
     lsort -dictionary {a003b a03b}
@@ -389,6 +417,15 @@ test cmdIL-4.34 {SortCompare procedure, -ascii option with -nocase option} {
 test cmdIL-4.35 {SortCompare procedure, -ascii option with -nocase option} {
     lsort -ascii -nocase {d E c B a D35 d300 100 20}
 } {100 20 a B c d d300 D35 E}
+test cmdIL-4.36 {SortCompare procedure, UTF-8 with -nocase option} {
+    scan [lsort -ascii -nocase [list \u101 \u100]] %c%c%c
+} {257 32 256}
+test cmdIL-4.37 {SortCompare procedure, UTF-8 with -nocase option} {
+    scan [lsort -ascii -nocase [list a\u0000a a]] %c%c%c%c%c
+} {97 32 97 0 97}
+test cmdIL-4.38 {SortCompare procedure, UTF-8 with -nocase option} {
+    scan [lsort -ascii -nocase [list a a\u0000a]] %c%c%c%c%c
+} {97 32 97 0 97}
 
 test cmdIL-5.1 {lsort with list style index} {
     lsort -ascii -decreasing -index {0 1} {
@@ -431,110 +468,76 @@ test cmdIL-5.5 {lsort with list style index and sharing} -body {
 } -result 0 -cleanup {
     rename test_lsort ""
 }
+test cmdIL-5.6 {lsort with multiple list-style index options} {
+    lsort -index {1 2 3} -index 0 {{a b} {c d} {b e}}
+} {{a b} {b e} {c d}}
 
 # Compiled version
-test cmdIL-6.1 {lassign command syntax} -body {
-    proc testLassign {} {
-	lassign
-    }
-    testLassign
-} -returnCodes 1 -cleanup {
-    rename testLassign {}
-} -result {wrong # args: should be "lassign list varname ?varname ...?"}
-test cmdIL-6.2 {lassign command syntax} -body {
-    proc testLassign {} {
-	lassign x
-    }
-    testLassign
-} -returnCodes 1 -cleanup {
-    rename testLassign {}
-} -result {wrong # args: should be "lassign list varname ?varname ...?"}
+test cmdIL-6.1 {lassign command syntax} -returnCodes error -body {
+    apply {{} { lassign }}
+} -result {wrong # args: should be "lassign list ?varName ...?"}
+test cmdIL-6.2 {lassign command syntax} {
+    apply {{} { lassign x }}
+} x
 test cmdIL-6.3 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x FAIL
 	list [lassign a x] $x
-    }
-    testLassign
-} -result {{} a} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {{} a}
 test cmdIL-6.4 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x FAIL
 	set y FAIL
 	list [lassign a x y] $x $y
-    }
-    testLassign
-} -result {{} a {}} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {{} a {}}
 test cmdIL-6.5 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x FAIL
 	set y FAIL
 	list [lassign {a b} x y] $x $y
-    }
-    testLassign
-} -result {{} a b} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {{} a b}
 test cmdIL-6.6 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x FAIL
 	set y FAIL
 	list [lassign {a b c} x y] $x $y
-    }
-    testLassign
-} -result {c a b} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {c a b}
 test cmdIL-6.7 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x FAIL
 	set y FAIL
 	list [lassign {a b c d} x y] $x $y
-    }
-    testLassign
-} -result {{c d} a b} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {{c d} a b}
 test cmdIL-6.8 {lassign command - list format error} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x FAIL
 	set y FAIL
 	list [catch {lassign {a {b}c d} x y} msg] $msg $x $y
-    }
-    testLassign
-} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL}
 test cmdIL-6.9 {lassign command - assignment to arrays} -body {
-    proc testLassign {} {
+    apply {{} {
 	list [lassign {a b} x(x)] $x(x)
-    }
-    testLassign
-} -result {b a} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {b a}
 test cmdIL-6.10 {lassign command - variable update error} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x(x) {}
 	lassign a x
-    }
-    testLassign
-} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -returnCodes error -result {can't set "x": variable is array}
 test cmdIL-6.11 {lassign command - variable update error} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x(x) {}
 	set y FAIL
 	list [catch {lassign a y x} msg] $msg $y
-    }
-    testLassign
-} -result {1 {can't set "x": variable is array} a} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {1 {can't set "x": variable is array} a}
 test cmdIL-6.12 {lassign command - memory leak testing} -setup {
     unset -nocomplain x y
     set x(x) {}
@@ -563,119 +566,86 @@ test cmdIL-6.12 {lassign command - memory leak testing} -setup {
     rename stress {}
 }
 # Force non-compiled version
-test cmdIL-6.13 {lassign command syntax} -body {
-    proc testLassign {} {
+test cmdIL-6.13 {lassign command syntax} -returnCodes error -body {
+    apply {{} {
 	set lassign lassign
 	$lassign
-    }
-    testLassign
-} -returnCodes 1 -cleanup {
-    rename testLassign {}
-} -result {wrong # args: should be "lassign list varname ?varname ...?"}
-test cmdIL-6.14 {lassign command syntax} -body {
-    proc testLassign {} {
+    }}
+} -result {wrong # args: should be "lassign list ?varName ...?"}
+test cmdIL-6.14 {lassign command syntax} {
+    apply {{} {
 	set lassign lassign
 	$lassign x
-    }
-    testLassign
-} -returnCodes 1 -cleanup {
-    rename testLassign {}
-} -result {wrong # args: should be "lassign list varname ?varname ...?"}
+    }}
+} x
 test cmdIL-6.15 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set lassign lassign
 	set x FAIL
 	list [$lassign a x] $x
-    }
-    testLassign
-} -result {{} a} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {{} a}
 test cmdIL-6.16 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set lassign lassign
 	set x FAIL
 	set y FAIL
 	list [$lassign a x y] $x $y
-    }
-    testLassign
-} -result {{} a {}} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {{} a {}}
 test cmdIL-6.17 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set lassign lassign
 	set x FAIL
 	set y FAIL
 	list [$lassign {a b} x y] $x $y
-    }
-    testLassign
-} -result {{} a b} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {{} a b}
 test cmdIL-6.18 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set lassign lassign
 	set x FAIL
 	set y FAIL
 	list [$lassign {a b c} x y] $x $y
-    }
-    testLassign
-} -result {c a b} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {c a b}
 test cmdIL-6.19 {lassign command} -body {
-    proc testLassign {} {
+    apply {{} {
 	set lassign lassign
 	set x FAIL
 	set y FAIL
 	list [$lassign {a b c d} x y] $x $y
-    }
-    testLassign
-} -result {{c d} a b} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {{c d} a b}
 test cmdIL-6.20 {lassign command - list format error} -body {
-    proc testLassign {} {
+    apply {{} {
 	set lassign lassign
 	set x FAIL
 	set y FAIL
 	list [catch {$lassign {a {b}c d} x y} msg] $msg $x $y
-    }
-    testLassign
-} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {1 {list element in braces followed by "c" instead of space} FAIL FAIL}
 test cmdIL-6.21 {lassign command - assignment to arrays} -body {
-    proc testLassign {} {
+    apply {{} {
 	set lassign lassign
 	list [$lassign {a b} x(x)] $x(x)
-    }
-    testLassign
-} -result {b a} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {b a}
 test cmdIL-6.22 {lassign command - variable update error} -body {
-    proc testLassign {} {
+    apply {{} {
 	set lassign lassign
 	set x(x) {}
 	$lassign a x
-    }
-    testLassign
-} -returnCodes 1 -result {can't set "x": variable is array} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -returnCodes 1 -result {can't set "x": variable is array}
 test cmdIL-6.23 {lassign command - variable update error} -body {
-    proc testLassign {} {
+    apply {{} {
 	set lassign lassign
 	set x(x) {}
 	set y FAIL
 	list [catch {$lassign a y x} msg] $msg $y
-    }
-    testLassign
-} -result {1 {can't set "x": variable is array} a} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {1 {can't set "x": variable is array} a}
 test cmdIL-6.24 {lassign command - memory leak testing} -setup {
     set x(x) {}
     set y FAIL
@@ -705,24 +675,66 @@ test cmdIL-6.24 {lassign command - memory leak testing} -setup {
 }
 # Assorted shimmering problems
 test cmdIL-6.25 {lassign command - shimmering protection} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x {a b c}
 	list [lassign $x $x y] $x [set $x] $y
-    }
-    testLassign
-} -result {c {a b c} a b} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {c {a b c} a b}
 test cmdIL-6.26 {lassign command - shimmering protection} -body {
-    proc testLassign {} {
+    apply {{} {
 	set x {a b c}
 	set lassign lassign
 	list [$lassign $x $x y] $x [set $x] $y
-    }
-    testLassign
-} -result {c {a b c} a b} -cleanup {
-    rename testLassign {}
-}
+    }}
+} -result {c {a b c} a b}
+
+test cmdIL-7.1 {lreverse command} -body {
+    lreverse
+} -returnCodes error -result "wrong # args: should be \"lreverse list\""
+test cmdIL-7.2 {lreverse command} -body {
+    lreverse a b
+} -returnCodes error -result "wrong # args: should be \"lreverse list\""
+test cmdIL-7.3 {lreverse command} -body {
+    lreverse "not \{a list"
+} -returnCodes error -result {unmatched open brace in list}
+test cmdIL-7.4 {lreverse command - shared object} {
+    set x {a b {c d} e f}
+    lreverse $x
+} {f e {c d} b a}
+test cmdIL-7.5 {lreverse command - unshared object} {
+    lreverse [list a b {c d} e f]
+} {f e {c d} b a}
+test cmdIL-7.6 {lreverse command - unshared object [Bug 1672585]} {
+    lreverse [set x {1 2 3}][unset x]
+} {3 2 1}
+test cmdIL-7.7 {lreverse command - empty object [Bug 1876793]} {
+    lreverse [list]
+} {}
+test cmdIL-7.8 {lreverse command - shared intrep [Bug 1675044]} -setup {
+    teststringobj set 1 {1 2 3}
+    testobj convert 1 list
+    testobj duplicate 1 2
+    variable x [teststringobj get 1]
+    variable y [teststringobj get 2]
+    testobj freeallvars
+    proc K {a b} {return $a}
+} -constraints testobj -body {
+    lreverse [K $y [unset y]]
+    lindex $x 0
+} -cleanup {
+    unset -nocomplain x y
+    rename K {}
+} -result 1
+
+# This belongs in info test, but adding tests there breaks tests
+# that compute source file line numbers.
+test info-20.6 {Bug 3587651} -setup {
+    namespace eval my {namespace eval tcl {namespace eval mathfunc {
+        proc demo x {return 42}
+    }}}} -body {    namespace eval my {expr {"demo" in [info functions]}}} -cleanup {
+    namespace delete my
+} -result 1
+
 
 # cleanup
 ::tcltest::cleanupTests
diff --git a/tests/cmdInfo.test b/tests/cmdInfo.test
index b4022af..0a587e8 100644
--- a/tests/cmdInfo.test
+++ b/tests/cmdInfo.test
@@ -12,18 +12,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: cmdInfo.test,v 1.8 2003/11/14 20:44:46 dgp Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
-::tcltest::testConstraint testcmdinfo \
-	[llength [info commands testcmdinfo]]
-::tcltest::testConstraint testcmdtoken \
-	[llength [info commands testcmdtoken]]
+testConstraint testcmdinfo  [llength [info commands testcmdinfo]]
+testConstraint testcmdtoken [llength [info commands testcmdtoken]]
 
 test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
     testcmdinfo create x1
@@ -71,7 +68,7 @@ test cmdinfo-4.1 {Tcl_GetCommandName/Tcl_GetCommandFullName procedures} \
     rename x1 newName
     set y [testcmdtoken name $x]
     rename newName x1
-    lappend y {expand}[testcmdtoken name $x]
+    lappend y {*}[testcmdtoken name $x]
 } {newName ::newName x1 ::x1}
 
 catch {rename newTestCmd {}}
@@ -88,7 +85,7 @@ test cmdinfo-5.1 {Names for commands created when inside namespaces} \
     }]
     set y [testcmdtoken name $x]
     rename ::testCmd newTestCmd
-    lappend y {expand}[testcmdtoken name $x]
+    lappend y {*}[testcmdtoken name $x]
 } {testCmd ::testCmd newTestCmd ::newTestCmd}
 
 test cmdinfo-6.1 {Names for commands created when outside namespaces} \
@@ -96,11 +93,15 @@ test cmdinfo-6.1 {Names for commands created when outside namespaces} \
     set x [testcmdtoken create cmdInfoNs1::cmdInfoNs2::testCmd]
     set y [testcmdtoken name $x]
     rename cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2
-    lappend y {expand}[testcmdtoken name $x]
+    lappend y {*}[testcmdtoken name $x]
 } {testCmd ::cmdInfoNs1::cmdInfoNs2::testCmd newTestCmd2 ::newTestCmd2}
 
 # cleanup
 catch {namespace delete cmdInfoNs1::cmdInfoNs2 cmdInfoNs1}
 catch {rename x1 ""}
-::tcltest::cleanupTests
+cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 2eff71f..2d68138 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -1,17 +1,15 @@
 # The tests in this file cover the procedures in tclCmdMZ.c.
 #
-# 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.
-#
-# RCS: @(#) $Id: cmdMZ.test,v 1.24 2004/07/06 21:08:37 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[catch {package require tcltest 2.1}]} {
     puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -26,49 +24,64 @@ namespace eval ::tcl::test::cmdMZ {
     namespace import ::tcltest::temporaryDirectory
     namespace import ::tcltest::test
 
+    proc ListGlobMatch {expected actual} {
+	if {[llength $expected] != [llength $actual]} {
+	    return 0
+	}
+	foreach e $expected a $actual {
+	    if {![string match $e $a]} {
+		return 0
+	    }
+	}
+	return 1
+    }
+    customMatch listGlob [namespace which ListGlobMatch]
+
 # Tcl_PwdObjCmd
 
-test cmdMZ-1.1 {Tcl_PwdObjCmd} {
-    list [catch {pwd a} msg] $msg
-} {1 {wrong # args: should be "pwd"}}
+test cmdMZ-1.1 {Tcl_PwdObjCmd} -returnCodes error -body {
+    pwd a
+} -result {wrong # args: should be "pwd"}
 test cmdMZ-1.2 {Tcl_PwdObjCmd: simple pwd} {
     catch pwd
 } 0
-test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} {
-    expr [string length pwd]>0
-} 1
-test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} {unix nonPortable} {
-    # This test fails on various unix platforms (eg Linux) where
-    # permissions caching causes this to fail.  The caching is strictly
-    # incorrect, but we have no control over that.
+test cmdMZ-1.3 {Tcl_PwdObjCmd: simple pwd} -body {
+    pwd
+} -match glob -result {?*}
+test cmdMZ-1.4 {Tcl_PwdObjCmd: failure} -setup {
+    set cwd [pwd]
     set foodir [file join [temporaryDirectory] foo]
     file delete -force $foodir
     file mkdir $foodir
-    set cwd [pwd]
     cd $foodir
+} -constraints {unix nonPortable} -body {
+    # This test fails on various unix platforms (eg Linux) where permissions
+    # caching causes this to fail. The caching is strictly incorrect, but we
+    # have no control over that.
     file attr . -permissions 000
-    set result [list [catch {pwd} msg] $msg]
+    pwd
+} -returnCodes error -cleanup {
     cd $cwd
     file delete -force $foodir
-    set result
-} {1 {error getting working directory name: permission denied}}
+} -result {error getting working directory name: permission denied}
 
 # The tests for Tcl_RegexpObjCmd, Tcl_RegsubObjCmd are in regexp.test
 
 # Tcl_RenameObjCmd
 
-test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} {
-    list [catch {rename r1} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
-test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} {
-    list [catch {rename r1 r2 r3} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
-test cmdMZ-2.3 {Tcl_RenameObjCmd: success} {
+test cmdMZ-2.1 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body {
+    rename r1
+} -result {wrong # args: should be "rename oldName newName"}
+test cmdMZ-2.2 {Tcl_RenameObjCmd: error conditions} -returnCodes error -body {
+    rename r1 r2 r3
+} -result {wrong # args: should be "rename oldName newName"}
+test cmdMZ-2.3 {Tcl_RenameObjCmd: success} -setup {
     catch {rename r2 {}}
+} -body {
     proc r1 {} {return "r1"}
     rename r1 r2
     r2
-} {r1}
+} -result {r1}
 test cmdMZ-2.4 {Tcl_RenameObjCmd: success} {
     proc r1 {} {return "r1"}
     rename r1 {}
@@ -81,24 +94,25 @@ test cmdMZ-return-1.0 {return checks for bad option values} -body {
     return -options foo
 } -returnCodes error -match glob -result {bad -options value:*}
 test cmdMZ-return-1.1 {return checks for bad option values} -body {
-    return -code foo
-} -returnCodes error -match glob -result {bad completion code*}
+    return -code err
+} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
 test cmdMZ-return-1.2 {return checks for bad option values} -body {
     return -code 0x100000000
-} -returnCodes error -match glob -result {bad completion code*}
+} -returnCodes error -match glob -result {bad completion code "0x100000000": must be ok, error, return, break, continue*, or an integer}
 test cmdMZ-return-1.3 {return checks for bad option values} -body {
     return -level foo
-} -returnCodes error -match glob -result {bad -level value:*}
+} -returnCodes error -match glob -result {bad -level value: *}
 test cmdMZ-return-1.4 {return checks for bad option values} -body {
     return -level -1
-} -returnCodes error -match glob -result {bad -level value:*}
+} -returnCodes error -match glob -result {bad -level value: *}
 test cmdMZ-return-1.5 {return checks for bad option values} -body {
     return -level 3.1415926
-} -returnCodes error -match glob -result {bad -level value:*}
+} -returnCodes error -match glob -result {bad -level value: *}
 
 proc dictSort {d} {
+    set result {}
     foreach k [lsort [dict keys $d]] {
-	lappend result $k [dict get $d $k]
+	dict set result $k [dict get $d $k]
     }
     return $result
 }
@@ -133,11 +147,11 @@ test cmdMZ-return-2.8 {return option handling} -body {
 test cmdMZ-return-2.9 {return option handling} -body {
     return -level 0 -code 10
 } -returnCodes 10 -result {}
-test cmdMZ-return-2.10 {return option handling} {
+test cmdMZ-return-2.10 {return option handling} -body {
     list [catch {return -level 0 -code error} -> foo] [dictSort $foo]
-} {1 {-code 1 -errorcode NONE -errorinfo {
+} -match glob -result {1 {-code 1 -errorcode NONE -errorinfo {
     while executing
-"return -level 0 -code error"} -errorline 1 -level 0}}
+"return -level 0 -code error"} -errorline 1 -errorstack * -level 0}}
 test cmdMZ-return-2.11 {return option handling} {
     list [catch {return -level 0 -code break} -> foo] [dictSort $foo]
 } {3 {-code 3 -level 0}}
@@ -145,72 +159,66 @@ test cmdMZ-return-2.12 {return option handling} -body {
     return -level 0 -code error -options {-code ok}
 } -returnCodes ok -result {}
 test cmdMZ-return-2.13 {return option handling} -body {
-    return -level 0 -code error -options {-code foo}
-} -returnCodes error -match glob -result {bad completion code*}
+    return -level 0 -code error -options {-code err}
+} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
 test cmdMZ-return-2.14 {return option handling} -body {
     return -level 0 -code error -options {-code foo -options {-code break}}
 } -returnCodes break -result {}
-
-test cmdMZ-return-2.15 {return opton handling} -setup {
-        proc p {} {
-            return -code error -errorcode {a b} c
-        }
-    } -body {
-        list [catch p result] $result $::errorCode
-    } -cleanup {
-        rename p {}
-    } -result {1 c {a b}}
-   
-test cmdMZ-return-2.16 {return opton handling} -setup {
-        proc p {} {
-            return -code error -errorcode [list a b] c
-        }
-    } -body {
-        list [catch p result] $result $::errorCode
-    } -cleanup {
-        rename p {}
-    } -result {1 c {a b}}
-   
-test cmdMZ-return-2.17 {return opton handling} -setup {
-        proc p {} {
-            return -code error -errorcode a\ b c
-        }
-    } -body {
-        list [catch p result] $result $::errorCode
-    } -cleanup {
-        rename p {}
-    } -result {1 c {a b}}
-   
+test cmdMZ-return-2.15 {return opton handling} {
+    list [catch {
+	apply {{} {
+	    return -code error -errorcode {a b} c
+	}}
+    } result] $result $::errorCode
+} {1 c {a b}}
+test cmdMZ-return-2.16 {return opton handling} {
+    list [catch {
+	apply {{} {
+	    return -code error -errorcode [list a b] c
+	}}
+    } result] $result $::errorCode
+} {1 c {a b}}
+test cmdMZ-return-2.17 {return opton handling} {
+    list [catch {
+	apply {{} {
+	    return -code error -errorcode a\ b c
+	}}
+    } result] $result $::errorCode
+} {1 c {a b}}
+test cmdMZ-return-2.18 {return option handling} {
+    list [catch {
+	return -code error -errorstack [list CALL a CALL b] yo
+    } -> foo] [dictSort $foo] [info errorstack]
+} {2 {-code 1 -errorcode NONE -errorstack {CALL a CALL b} -level 1} {CALL a CALL b}}
 
 # Check that the result of a [return -options $opts $result] is
-# indistinguishable from that of the originally caught script, no
-# matter what the script is/does.  (TIP 90)
-set i 0
-foreach script {
-	{}
-	{format x}
-	{set}
-	{set a 1}
-	{error}
-	{error foo}
-	{error foo bar}
-	{error foo bar baz}
-	{return -level 0}
-	{return -code error}
-	{return -code error -errorinfo foo}
-	{return -code error -errorinfo foo -errorcode bar}
-	{return -code error -errorinfo foo -errorcode bar -errorline 10}
-	{return -options {x y z 2}}
-	{return -level 3 -code break sdf}
+# indistinguishable from that of the originally caught script, no matter what
+# the script is/does. (TIP 90)
+foreach {testid script} {
+    cmdMZ-return-3.0 {}
+    cmdMZ-return-3.1 {format x}
+    cmdMZ-return-3.2 {set}
+    cmdMZ-return-3.3 {set a 1}
+    cmdMZ-return-3.4 {error}
+    cmdMZ-return-3.5 {error foo}
+    cmdMZ-return-3.6 {error foo bar}
+    cmdMZ-return-3.7 {error foo bar baz}
+    cmdMZ-return-3.8 {return -level 0}
+    cmdMZ-return-3.9 {return -code error}
+    cmdMZ-return-3.10 {return -code error -errorinfo foo}
+    cmdMZ-return-3.11 {return -code error -errorinfo foo -errorcode bar}
+    cmdMZ-return-3.12 {return -code error -errorinfo foo -errorcode bar -errorline 10}
+    cmdMZ-return-3.12.1 {return -code error -errorinfo foo -errorcode bar -errorline 10 -errorstack baz}
+    cmdMZ-return-3.13 {return -options {x y z 2}}
+    cmdMZ-return-3.14 {return -level 3 -code break sdf}
 } {
-    test cmdMZ-return-3.$i "check that return after a catch is same:\n$script" {
+    test $testid "check that return after a catch is same:\n$script" {
 	set one [list [catch $script foo bar] $foo [dictSort $bar] \
 		$::errorCode $::errorInfo]
 	set two [list [catch {return -options $bar $foo} foo2 bar2] \
 		$foo2 [dictSort $bar2] $::errorCode $::errorInfo]
 	string equal $one $two
     } 1
-    incr i
 }
 
 # The tests for Tcl_ScanObjCmd are in scan.test
@@ -220,58 +228,44 @@ foreach script {
 
 test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints {
     unixOrPc
-} -body {
-    list [catch {source} msg] $msg
-} -match glob -result {1 {wrong # args: should be "source*fileName"}}
+} -returnCodes error -body {
+    source
+} -match glob -result {wrong # args: should be "source*fileName"}
 test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints {
     unixOrPc
-} -body {
-    list [catch {source a b} msg] $msg
-} -match glob -result {1 {wrong # args: should be "source*fileName"}}
-
-proc ListGlobMatch {expected actual} {
-    if {[llength $expected] != [llength $actual]} {
-        return 0
-    }
-    foreach e $expected a $actual {
-        if {![string match $e $a]} {
-            return 0
-        }
-    }
-    return 1
-}
-customMatch listGlob [namespace which ListGlobMatch]
-
+} -returnCodes error -body {
+    source a b
+} -match glob -result {wrong # args: should be "source*fileName"}
 test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
     set file [makeFile {
 	set x 146
 	error "error in sourced file"
 	set y $x
     } source.file]
-    set result [list [catch {source $file} msg] $msg $errorInfo]
+    list [catch {source $file} msg] $msg $::errorInfo
+} -cleanup {
     removeFile source.file
-    set result
 } -match listGlob -result {1 {error in sourced file} {error in sourced file
     while executing
 "error "error in sourced file""
     (file "*" line 3)
     invoked from within
 "source $file"}}
-test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} {
-    set file [makeFile {list result} source.file]
-    set result [source $file]
+test cmdMZ-3.6 {Tcl_SourceObjCmd: simple script} -body {
+    set file [makeFile {list ok} source.file]
+    source $file
+} -cleanup {
     removeFile source.file
-    set result
-} result
+} -result ok
 
 # Tcl_SplitObjCmd
 
-test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} {
-    list [catch split msg] $msg $errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
-test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} {
-    list [catch {split a b c} msg] $msg $errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+test cmdMZ-4.1 {Tcl_SplitObjCmd: split errors} -returnCodes error -body {
+    split
+} -result {wrong # args: should be "split string ?splitChars?"}
+test cmdMZ-4.2 {Tcl_SplitObjCmd: split errors} -returnCodes error -body {
+    split a b c
+} -result {wrong # args: should be "split string ?splitChars?"}
 test cmdMZ-4.3 {Tcl_SplitObjCmd: basic split commands} {
     split "a\n b\t\r c\n "
 } {a {} b {} {} c {} {}}
@@ -294,23 +288,22 @@ test cmdMZ-4.9 {Tcl_SplitObjCmd: basic split commands} {
     split {   }
 } {{} {} {} {}}
 test cmdMZ-4.10 {Tcl_SplitObjCmd: basic split commands} {
-    proc foo {} {
+    apply {{} {
         set x {}
         foreach f [split {]\n} {}] {
             append x $f
         }
-        return $x	
-    }
-    foo
+        return $x
+    }}
 } {]\n}
 test cmdMZ-4.11 {Tcl_SplitObjCmd: basic split commands} {
-    proc foo {} {
+    apply {{} {
         set x ab\000c
         set y [split $x {}]
-        return $y
-    }
-    foo
-} "a b \000 c"
+	binary scan $y c* z
+        return $z
+    }}
+} {97 32 98 32 0 32 99}
 test cmdMZ-4.12 {Tcl_SplitObjCmd: basic split commands} {
     split "a0ab1b2bbb3\000c4" ab\000c
 } {{} 0 {} 1 2 {} {} 3 {} 4}
@@ -323,21 +316,21 @@ test cmdMZ-4.13 {Tcl_SplitObjCmd: basic split commands} {
 # The tests for Tcl_SubstObjCmd are in subst.test
 # The tests for Tcl_SwitchObjCmd are in switch.test
 
-test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} {
-    list [catch {time} msg] $msg
-} {1 {wrong # args: should be "time command ?count?"}}
-test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} {
-    list [catch {time a b c} msg] $msg
-} {1 {wrong # args: should be "time command ?count?"}}
-test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} {
-    list [catch {time a b} msg] $msg
-} {1 {expected integer but got "b"}}
+test cmdMZ-5.1 {Tcl_TimeObjCmd: basic format of command} -body {
+    time
+} -returnCodes error -result {wrong # args: should be "time command ?count?"}
+test cmdMZ-5.2 {Tcl_TimeObjCmd: basic format of command} -body {
+    time a b c
+} -returnCodes error -result {wrong # args: should be "time command ?count?"}
+test cmdMZ-5.3 {Tcl_TimeObjCmd: basic format of command} -body {
+    time a b
+} -returnCodes error -result {expected integer but got "b"}
 test cmdMZ-5.4 {Tcl_TimeObjCmd: nothing happens with negative iteration counts} {
     time bogusCmd -12456
 } {0 microseconds per iteration}
-test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} {
-    regexp {^\d+ microseconds per iteration} [time {format 1}]
-} 1
+test cmdMZ-5.5 {Tcl_TimeObjCmd: result format} -body {
+    time {format 1}
+} -match regexp -result {^\d+ microseconds per iteration}
 test cmdMZ-5.6 {Tcl_TimeObjCmd: slower commands take longer} {
     expr {[lindex [time {after 2}] 0] < [lindex [time {after 1000}] 0]}
 } 1
@@ -350,9 +343,13 @@ test cmdMZ-5.7 {Tcl_TimeObjCmd: errors generate right trace} {
 "time {error foo}"}}
 
 # The tests for Tcl_WhileObjCmd are in while.test
-
+
 # cleanup
 cleanupTests
 }
 namespace delete ::tcl::test::cmdMZ
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index f13e0e9..bae26a0 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -11,15 +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: compExpr-old.test,v 1.13 2005/07/28 18:42:28 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
     testConstraint testmathfunctions 0
 } else {
     testConstraint testmathfunctions 1
@@ -81,7 +82,10 @@ proc testIEEE {} {
 	}
     }
 }
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
+
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
 
 # procedures used below
 
@@ -190,57 +194,49 @@ test compExpr-old-1.14 {TclCompileExprCmd: second level of substitutions in expr
 test compExpr-old-2.1 {TclCompileExpr: are builtin functions registered?} {
     expr double(5*[llength "6 2"])
 } 10.0
-test compExpr-old-2.2 {TclCompileExpr: error in expr} {
-    catch {expr 2***3} msg
-    set msg
-} {syntax error in expression "2***3": unexpected operator *}
-test compExpr-old-2.3 {TclCompileExpr: junk after legal expr} {
-    catch {expr 7*[llength "a b"]foo} msg
-    set msg
-} {syntax error in expression "7*2foo": extra tokens at end of expression}
+test compExpr-old-2.2 {TclCompileExpr: error in expr} -body {
+    expr 2***3
+} -returnCodes error -match glob -result *
+test compExpr-old-2.3 {TclCompileExpr: junk after legal expr} -body {
+    expr 7*[llength "a b"]foo
+} -returnCodes error -match glob -result *
 test compExpr-old-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} {
     expr {0001}
 } 1
 
 test compExpr-old-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1
 test compExpr-old-3.2 {CompileCondExpr: error in lor expr} -body {
-    catch {expr x||3} msg
-    set msg
-} -match glob \
-	-result {syntax error in expression "x||3": * preceding $*}
+    expr x||3
+} -returnCodes error -match glob -result *
 test compExpr-old-3.3 {CompileCondExpr: test true arm} {expr 3>2?44:66} 44
-test compExpr-old-3.4 {CompileCondExpr: error compiling true arm} {
-    catch {expr 3>2?2***3:66} msg
-    set msg
-} {syntax error in expression "3>2?2***3:66": unexpected operator *}
+test compExpr-old-3.4 {CompileCondExpr: error compiling true arm} -body {
+    expr 3>2?2***3:66
+} -returnCodes error -match glob -result *
 test compExpr-old-3.5 {CompileCondExpr: test false arm} {expr 2>3?44:66} 66
-test compExpr-old-3.6 {CompileCondExpr: error compiling false arm} {
-    catch {expr 2>3?44:2***3} msg
-    set msg
-} {syntax error in expression "2>3?44:2***3": unexpected operator *}
+test compExpr-old-3.6 {CompileCondExpr: error compiling false arm} -body {
+    expr 2>3?44:2***3
+} -returnCodes error -match glob -result *
 test compExpr-old-3.7 {CompileCondExpr: long arms & nested cond exprs} {
     hello_world
 } {Hello world}
-test compExpr-old-3.8 {CompileCondExpr: long arms & nested cond exprs} {
+test compExpr-old-3.8 {CompileCondExpr: long arms & nested cond exprs} unix {
+    # Fails with a stack overflow on threaded Windows builds
     do_twelve_days
 } 2358
 
 test compExpr-old-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1
 test compExpr-old-4.2 {CompileLorExpr: error in land expr} -body {
-    catch {expr x&&3} msg
-    set msg
-} -match glob -result {syntax error in expression "x&&3": * preceding $*} 
+    expr x&&3
+} -returnCodes error -match glob -result *
 test compExpr-old-4.3 {CompileLorExpr: simple lor exprs} {expr 0||1.0} 1
 test compExpr-old-4.4 {CompileLorExpr: simple lor exprs} {expr 3.0||0.0} 1
 test compExpr-old-4.5 {CompileLorExpr: simple lor exprs} {expr 0||0||1} 1
-test compExpr-old-4.6 {CompileLorExpr: error compiling lor arm} {
-    catch {expr 2***3||4.0} msg
-    set msg
-} {syntax error in expression "2***3||4.0": unexpected operator *}
-test compExpr-old-4.7 {CompileLorExpr: error compiling lor arm} {
-    catch {expr 1.3||2***3} msg
-    set msg
-} {syntax error in expression "1.3||2***3": unexpected operator *}
+test compExpr-old-4.6 {CompileLorExpr: error compiling lor arm} -body {
+    expr 2***3||4.0
+} -returnCodes error -match glob -result *
+test compExpr-old-4.7 {CompileLorExpr: error compiling lor arm} -body {
+    expr 1.3||2***3
+} -returnCodes error -match glob -result *
 test compExpr-old-4.8 {CompileLorExpr: error compiling lor arms} {
     list [catch {expr {"a"||"b"}} msg] $msg
 } {1 {expected boolean value but got "a"}}
@@ -252,21 +248,18 @@ test compExpr-old-4.9 {CompileLorExpr: long lor arm} {
 
 test compExpr-old-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
 test compExpr-old-5.2 {CompileLandExpr: error in bitor expr} -body {
-    catch {expr x|3} msg
-    set msg
-} -match glob -result {syntax error in expression "x|3": * preceding $*} 
+    expr x|3
+} -returnCodes error -match glob -result *
 test compExpr-old-5.3 {CompileLandExpr: simple land exprs} {expr 0&&1.0} 0
 test compExpr-old-5.4 {CompileLandExpr: simple land exprs} {expr 0&&0} 0
 test compExpr-old-5.5 {CompileLandExpr: simple land exprs} {expr 3.0&&1.2} 1
 test compExpr-old-5.6 {CompileLandExpr: simple land exprs} {expr 1&&1&&2} 1
-test compExpr-old-5.7 {CompileLandExpr: error compiling land arm} {
-    catch {expr 2***3&&4.0} msg
-    set msg
-} {syntax error in expression "2***3&&4.0": unexpected operator *}
-test compExpr-old-5.8 {CompileLandExpr: error compiling land arm} {
-    catch {expr 1.3&&2***3} msg
-    set msg
-} {syntax error in expression "1.3&&2***3": unexpected operator *}
+test compExpr-old-5.7 {CompileLandExpr: error compiling land arm} -body {
+    expr 2***3&&4.0
+} -returnCodes error -match glob -result *
+test compExpr-old-5.8 {CompileLandExpr: error compiling land arm} -body {
+    expr 1.3&&2***3
+} -returnCodes error -match glob -result *
 test compExpr-old-5.9 {CompileLandExpr: error compiling land arm} {
     list [catch {expr {"a"&&"b"}} msg] $msg
 } {1 {expected boolean value but got "a"}}
@@ -278,21 +271,18 @@ test compExpr-old-5.10 {CompileLandExpr: long land arms} {
 
 test compExpr-old-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3
 test compExpr-old-6.2 {CompileBitXorExpr: error in bitand expr} -body {
-    catch {expr x|3} msg
-    set msg
-} -match glob -result {syntax error in expression "x|3": * preceding $*} 
+    expr x|3
+} -returnCodes error -match glob -result *
 test compExpr-old-6.3 {CompileBitXorExpr: simple bitxor exprs} {expr 7^0x13} 20
 test compExpr-old-6.4 {CompileBitXorExpr: simple bitxor exprs} {expr 3^0x10} 19
 test compExpr-old-6.5 {CompileBitXorExpr: simple bitxor exprs} {expr 0^7} 7
 test compExpr-old-6.6 {CompileBitXorExpr: simple bitxor exprs} {expr -1^7} -8
-test compExpr-old-6.7 {CompileBitXorExpr: error compiling bitxor arm} {
-    catch {expr 2***3|6} msg
-    set msg
-} {syntax error in expression "2***3|6": unexpected operator *}
+test compExpr-old-6.7 {CompileBitXorExpr: error compiling bitxor arm} -body {
+    expr 2***3|6
+} -returnCodes error -match glob -result *
 test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
-    catch {expr 2^x} msg
-    set msg
-} -match glob -result {syntax error in expression "2^x": * preceding $*}
+    expr 2^x
+} -returnCodes error -match glob -result *
 test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
     list [catch {expr {24.0^3}} msg] $msg
 } {1 {can't use floating-point value as operand of "^"}}
@@ -305,21 +295,18 @@ test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
 test compExpr-old-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
 test compExpr-old-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
 test compExpr-old-7.5 {CompileBitAndExpr: error in equality expr} -body {
-    catch {expr x==3} msg
-    set msg
-} -match glob -result {syntax error in expression "x==3": * preceding $*} 
+    expr x==3
+} -returnCodes error -match glob -result *
 test compExpr-old-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
 test compExpr-old-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
 test compExpr-old-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
 test compExpr-old-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
-test compExpr-old-7.10 {CompileBitAndExpr: error compiling bitand arm} {
-    catch {expr 2***3&6} msg
-    set msg
-} {syntax error in expression "2***3&6": unexpected operator *}
+test compExpr-old-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
+    expr 2***3&6
+} -returnCodes error -match glob -result *
 test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
-    catch {expr 2&x} msg
-    set msg
-} -match glob -result {syntax error in expression "2&x": * preceding $*}
+    expr 2&x
+} -returnCodes error -match glob -result *
 test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
     list [catch {expr {24.0&3}} msg] $msg
 } {1 {can't use floating-point value as operand of "&"}}
@@ -332,21 +319,18 @@ test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1}
 test compExpr-old-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1
 test compExpr-old-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
 test compExpr-old-8.5 {CompileEqualityExpr: error in relational expr} -body {
-    catch {expr x>3} msg
-    set msg
-} -match glob -result {syntax error in expression "x>3": * preceding $*} 
+    expr x>3
+} -returnCodes error -match glob -result *
 test compExpr-old-8.6 {CompileEqualityExpr: simple equality exprs} {expr 7==0x13} 0
 test compExpr-old-8.7 {CompileEqualityExpr: simple equality exprs} {expr -0xf2!=0x53} 1
 test compExpr-old-8.8 {CompileEqualityExpr: simple equality exprs} {expr {"12398712938788234-1298379" != ""}} 1
 test compExpr-old-8.9 {CompileEqualityExpr: simple equality exprs} {expr -1!="abc"} 1
-test compExpr-old-8.10 {CompileEqualityExpr: error compiling equality arm} {
-    catch {expr 2***3==6} msg
-    set msg
-} {syntax error in expression "2***3==6": unexpected operator *}
+test compExpr-old-8.10 {CompileEqualityExpr: error compiling equality arm} -body {
+    expr 2***3==6
+} -returnCodes error -match glob -result *
 test compExpr-old-8.11 {CompileEqualityExpr: error compiling equality arm} -body {
-    catch {expr 2!=x} msg
-    set msg
-} -match glob -result {syntax error in expression "2!=x": * preceding $*}
+    expr 2!=x
+} -returnCodes error -match glob -result *
 
 
 test compExpr-old-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
@@ -357,50 +341,40 @@ test compExpr-old-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
 # The following test is different for 32-bit versus 64-bit
 # architectures because LONG_MIN is different
 
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-
 test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
-    expr {1<<63}
+    expr {int(1<<63)}
 } -9223372036854775808
-
 test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
-    expr {1<<31}
+    expr {int(1<<31)}
 } -2147483648
 
 test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
-    catch {expr x>>3} msg
-    set msg
-} -match glob -result {syntax error in expression "x>>3": * preceding $*} 
+    expr x>>3
+} -returnCodes error -match glob -result *
 test compExpr-old-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
 test compExpr-old-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
-test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} {
-    catch {expr 2***3>6} msg
-    set msg
-} {syntax error in expression "2***3>6": unexpected operator *}
+test compExpr-old-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
+    expr 2***3>6
+} -returnCodes error -match glob -result *
 test compExpr-old-9.10 {CompileRelationalExpr: error compiling relational arm} -body {
-    catch {expr 2<x} msg
-    set msg
-} -match glob -result {syntax error in expression "2<x": * preceding $*}
+    expr 2<x
+} -returnCodes error -match glob -result *
 
 test compExpr-old-10.1 {CompileShiftExpr: just add expr} {expr 4+-2} 2
 test compExpr-old-10.2 {CompileShiftExpr: just add expr} {expr 0xff-2} 253
 test compExpr-old-10.3 {CompileShiftExpr: just add expr} {expr -1--2} 1
-test compExpr-old-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -82
+test compExpr-old-10.4 {CompileShiftExpr: just add expr} {expr 1-0o123} -82
 test compExpr-old-10.5 {CompileShiftExpr: error in add expr} -body {
-    catch {expr x+3} msg
-    set msg
-} -match glob -result {syntax error in expression "x+3": * preceding $*}
+    expr x+3
+} -returnCodes error -match glob -result *
 test compExpr-old-10.6 {CompileShiftExpr: simple shift exprs} {expr 0xff>>0x3} 31
 test compExpr-old-10.7 {CompileShiftExpr: simple shift exprs} {expr -0xf2<<0x3} -1936
-test compExpr-old-10.8 {CompileShiftExpr: error compiling shift arm} {
-    catch {expr 2***3>>6} msg
-    set msg
-} {syntax error in expression "2***3>>6": unexpected operator *}
+test compExpr-old-10.8 {CompileShiftExpr: error compiling shift arm} -body {
+    expr 2***3>>6
+} -returnCodes error -match glob -result *
 test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body {
-    catch {expr 2<<x} msg
-    set msg
-} -match glob -result {syntax error in expression "2<<x": * preceding $*}
+    expr 2<<x
+} -returnCodes error -match glob -result *
 test compExpr-old-10.10 {CompileShiftExpr: runtime error} {
     list [catch {expr {24.0>>43}} msg] $msg
 } {1 {can't use floating-point value as operand of ">>"}}
@@ -411,21 +385,18 @@ test compExpr-old-10.11 {CompileShiftExpr: runtime error} {
 test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
 test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
 test compExpr-old-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
-test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 6
+test compExpr-old-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
 test compExpr-old-11.5 {CompileAddExpr: error in multiply expr} -body {
-    catch {expr x*3} msg
-    set msg
-} -match glob -result {syntax error in expression "x*3": * preceding $*}
+    expr x*3
+} -returnCodes error -match glob -result *
 test compExpr-old-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
 test compExpr-old-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
-test compExpr-old-11.8 {CompileAddExpr: error compiling add arm} {
-    catch {expr 2***3+6} msg
-    set msg
-} {syntax error in expression "2***3+6": unexpected operator *}
+test compExpr-old-11.8 {CompileAddExpr: error compiling add arm} -body {
+    expr 2***3+6
+} -returnCodes error -match glob -result *
 test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body {
-    catch {expr 2-x} msg
-    set msg
-} -match glob -result {syntax error in expression "2-x": * preceding $*}
+    expr 2-x
+} -returnCodes error -match glob -result *
 test compExpr-old-11.10 {CompileAddExpr: runtime error} {
     list [catch {expr {24.0+"xx"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "+"}}
@@ -447,19 +418,16 @@ test compExpr-old-12.2 {CompileMultiplyExpr: just unary expr} {expr --5} 5
 test compExpr-old-12.3 {CompileMultiplyExpr: just unary expr} {expr !27} 0
 test compExpr-old-12.4 {CompileMultiplyExpr: just unary expr} {expr ~0xff00ff} -16711936
 test compExpr-old-12.5 {CompileMultiplyExpr: error in unary expr} -body {
-    catch {expr ~x} msg
-    set msg
-} -match glob -result {syntax error in expression "~x": * preceding $*}
+    expr ~x
+} -returnCodes error -match glob -result *
 test compExpr-old-12.6 {CompileMultiplyExpr: simple multiply exprs} {expr 0xff*0x3} 765
 test compExpr-old-12.7 {CompileMultiplyExpr: simple multiply exprs} {expr -0xf2%-0x3} -2
-test compExpr-old-12.8 {CompileMultiplyExpr: error compiling multiply arm} {
-    catch {expr 2*3%%6} msg
-    set msg
-} {syntax error in expression "2*3%%6": unexpected operator %}
+test compExpr-old-12.8 {CompileMultiplyExpr: error compiling multiply arm} -body {
+    expr 2*3%%6
+} -returnCodes error -match glob -result *
 test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
-    catch {expr 2*x} msg
-    set msg
-} -match glob -result {syntax error in expression "2*x": * preceding $*}
+    expr 2*x
+} -returnCodes error -match glob -result *
 test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} {
     list [catch {expr {24.0*"xx"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "*"}}
@@ -468,20 +436,19 @@ test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} {
 } {1 {can't use non-numeric string as operand of "/"}}
 
 test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
-test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +000123} 83
+test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
 test compExpr-old-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
 test compExpr-old-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
 test compExpr-old-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
 test compExpr-old-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
 test compExpr-old-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
 test compExpr-old-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
-    catch {expr ~x} msg
-    set msg
-} -match glob -result {syntax error in expression "~x": * preceding $*}
-test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} {
-    catch {expr !1.x} msg
+    expr ~x
+} -returnCodes error -match glob -result *
+test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
+    expr !1.x
     set msg
-} {syntax error in expression "!1.x": extra tokens at end of expression}
+} -returnCodes error -match glob -result *
 test compExpr-old-13.10 {CompileUnaryExpr: runtime error} {
     list [catch {expr {~"xx"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "~"}}
@@ -504,7 +471,7 @@ test compExpr-old-13.16 {CompileUnaryExpr: error in primary expr} {
 test compExpr-old-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1
 test compExpr-old-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123
 test compExpr-old-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255
-test compExpr-old-14.4 {CompilePrimaryExpr: literal primary} {expr 00010} 8
+test compExpr-old-14.4 {CompilePrimaryExpr: literal primary} {expr 0o0010} 8
 test compExpr-old-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
 test compExpr-old-14.6 {CompilePrimaryExpr: literal primary} {
     expr 3.1400000
@@ -542,14 +509,11 @@ test compExpr-old-14.15 {CompilePrimaryExpr: var reference primary} {
     set msg
 } 123.2
 test compExpr-old-14.16 {CompilePrimaryExpr: error compiling var reference primary} -body {
-    catch {expr {$a(foo}} msg
-    set errorInfo
-} -match glob -result {missing )
-    while *ing
-"expr {$a(foo}"}
-test compExpr-old-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
+    expr {$a(foo}
+} -returnCodes error -match glob -result *
+test compExpr-old-14.17 {CompilePrimaryExpr: string primary that looks like var ref} -body {
     expr $
-} $
+} -returnCodes error -match glob -result *
 test compExpr-old-14.18 {CompilePrimaryExpr: quoted string primary} {
     expr "21"
 } 21
@@ -572,16 +536,13 @@ test compExpr-old-14.22 {CompilePrimaryExpr: subcommand primary} {
 } 123
 test compExpr-old-14.23 {CompilePrimaryExpr: error in subcommand primary} -body {
     catch {expr {[set]}} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
 test compExpr-old-14.24 {CompilePrimaryExpr: error in subcommand primary} -body {
-    catch {expr {[set i}} msg
-    set errorInfo
-} -match glob -result {missing close-bracket
-    while *ing
-"expr {\[set i}"}
+    expr {[set i}
+} -returnCodes error -match glob -result *
 test compExpr-old-14.25 {CompilePrimaryExpr: math function primary} {
     format %.6g [expr exp(1.0)]
 } 2.71828
@@ -589,73 +550,58 @@ test compExpr-old-14.26 {CompilePrimaryExpr: math function primary} {
     format %.6g [expr pow(2.0+0.1,3.0+0.1)]
 } 9.97424
 test compExpr-old-14.27 {CompilePrimaryExpr: error in math function primary} -body {
-    catch {expr sinh::(2.0)} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "sinh::(2.0)": * function arguments*
-    while *ing
-"expr sinh::(2.0)"}
+    expr sinh::(2.0)
+} -returnCodes error -match glob -result *
 test compExpr-old-14.28 {CompilePrimaryExpr: subexpression primary} {
     expr 2+(3*4)
 } 14
 test compExpr-old-14.29 {CompilePrimaryExpr: error in subexpression primary} -body {
     catch {expr 2+(3*[set])} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
 test compExpr-old-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} -body {
-    catch {expr 2+(3*(4+5)} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
-    while *ing
-"expr 2+(3*(4+5)"}
+    expr 2+(3*(4+5)
+} -returnCodes error -match glob -result *
 test compExpr-old-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
     set i "5+10"
     list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15"
 } {{15 == 15} {15 == 15} {15 == 15}}
 test compExpr-old-14.32 {CompilePrimaryExpr: unexpected token} -body {
-    catch {expr @} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "@": character not legal in expressions
-    while *ing
-"expr @"}
+    expr @
+} -returnCodes error -match glob -result *
 
 test compExpr-old-15.1 {CompileMathFuncCall: missing parenthesis} -body {
-    catch {expr sinh2.0)} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "sinh2.0)": * preceding $*
-    while *ing
-"expr sinh2.0)"}
+    expr sinh2.0)
+} -returnCodes error -match glob -result *
 test compExpr-old-15.2 {CompileMathFuncCall: unknown math function} -body {
     catch {expr whazzathuh(1)} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {* "*whazzathuh"
     while *ing
 "expr whazzathuh(1)"}
 test compExpr-old-15.3 {CompileMathFuncCall: too many arguments} -body {
     catch {expr sin(1,2,3)} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {too many arguments for math function*
     while *ing
 "expr sin(1,2,3)"}
 test compExpr-old-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
     catch {expr sin()} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {too few arguments for math function*
     while *ing
 "expr sin()"}
 test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body {
     catch {expr pow(1)} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {too few arguments for math function*
     while *ing
 "expr pow(1)"}
 test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
-    catch {expr sin(1} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "sin(1": missing close parenthesis at end of function call
-    while *ing
-"expr sin(1"}
+    expr sin(1
+} -returnCodes error -match glob -result *
 test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions {
     expr 2*T1()
 } 246
diff --git a/tests/compExpr.test b/tests/compExpr.test
index 42e5cd5..14c875d 100644
--- a/tests/compExpr.test
+++ b/tests/compExpr.test
@@ -1,51 +1,55 @@
-# This file contains a collection of tests for the procedures in the
-# file tclCompExpr.c.  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 the procedures in the file
+# tclCompExpr.c.  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.
-#
-# RCS: @(#) $Id: compExpr.test,v 1.9 2005/05/10 18:35:17 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
     testConstraint testmathfunctions 0
 } else {
     testConstraint testmathfunctions 1
 }
 
-catch {unset a}
+# Constrain memory leak tests
+testConstraint memory [llength [info commands memory]]
 
+catch {unset a}
+
 test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
     expr 1+2
 } 3
-test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} {
-    list [catch {expr 1+2+} msg] $msg
-} {1 {syntax error in expression "1+2+": premature end of expression}}
+test compExpr-1.2 {TclCompileExpr procedure, error parsing expr} -body {
+    expr 1+2+
+} -returnCodes error -match glob -result *
 test compExpr-1.3 {TclCompileExpr procedure, error compiling expr} -body {
     list [catch {expr "foo(123)"} msg] $msg
 } -match glob -result {1 {* "*foo"}}
-
 test compExpr-1.4 {TclCompileExpr procedure, expr has no operators} {
-    set a {000123}
+    set a {0o00123}
     expr {$a}
 } 83
 
-test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} {
-    catch {unset a}
+test compExpr-2.1 {CompileSubExpr procedure, TCL_TOKEN_WORD parse token} -setup {
+    unset -nocomplain a
+} -body {
     set a 27
     expr {"foo$a" < "bar"}
-} 0
-test compExpr-2.2 {CompileSubExpr procedure, error compiling TCL_TOKEN_WORD parse token} {
-    list [catch {expr {"00[expr 1+]" + 17}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
+} -result 0
+test compExpr-2.2 {CompileSubExpr procedure, error compiling TCL_TOKEN_WORD parse token} -body {
+    expr {"00[expr 1+]" + 17}
+} -returnCodes error -match glob -result *
 test compExpr-2.3 {CompileSubExpr procedure, TCL_TOKEN_TEXT parse token} {
     expr {{12345}}
 } 12345
@@ -62,33 +66,36 @@ test compExpr-2.6 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} {
 test compExpr-2.7 {CompileSubExpr procedure, TCL_TOKEN_COMMAND parse token} {
     expr {[]}
 } {}
-test compExpr-2.8 {CompileSubExpr procedure, error in TCL_TOKEN_COMMAND parse token} {
-    list [catch {expr {[foo "bar"xxx] + 17}} msg] $msg
-} {1 {extra characters after close-quote}}
-test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} {
-    catch {unset a}
+test compExpr-2.8 {CompileSubExpr procedure, error in TCL_TOKEN_COMMAND parse token} -body {
+    expr {[foo "bar"xxx] + 17}
+} -returnCodes error -match glob -result *
+test compExpr-2.9 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup {
+    unset -nocomplain a
+} -body {
     set a 123
     expr {$a*2}
-} 246
-test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} {
-    catch {unset a}
-    catch {unset b}
+} -result 246
+test compExpr-2.10 {CompileSubExpr procedure, TCL_TOKEN_VARIABLE parse token} -setup {
+    unset -nocomplain a
+    unset -nocomplain b
+} -body {
     set a(george) martha
     set b geo
     expr {$a(${b}rge)}
-} martha
-test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} {
-    catch {unset a}
-    list [catch {expr {$a + 17}} msg] $msg
-} {1 {can't read "a": no such variable}}
+} -result martha
+test compExpr-2.11 {CompileSubExpr procedure, error in TCL_TOKEN_VARIABLE parse token} -body {
+    unset -nocomplain a
+    expr {$a + 17}
+} -returnCodes error -result {can't read "a": no such variable}
 test compExpr-2.12 {CompileSubExpr procedure, TCL_TOKEN_SUB_EXPR parse token} {
     expr {27||3? 3<<(1+4) : 4&&9}
 } 96
-test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
-    catch {unset a}
+test compExpr-2.13 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
+    unset -nocomplain a
+} -body {
     set a 15
     list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
-} {0 1}
+} -result {0 1}
 test compExpr-2.14 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, op found} {
     expr {5*6}
 } 30
@@ -146,143 +153,162 @@ test compExpr-2.31 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal o
 test compExpr-2.32 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, 1 operand} {
     expr {~4}
 } -5
-test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} {
-    catch {unset a}
+test compExpr-2.33 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, normal operator, comparison} -setup {
+    unset -nocomplain a
+} -body {
     set a 15
     expr {$a==15}  ;# compiled out-of-line to runtime call on Tcl_ExprObjCmd
-} 1
+} -result 1
 test compExpr-2.34 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
     expr {+2}
 } 2
-test compExpr-2.35 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} {
-    list [catch {expr {+[expr 1+]}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
+test compExpr-2.35 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body {
+    expr {+[expr 1+]}
+} -returnCodes error -match glob -result *
 test compExpr-2.36 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
     expr {4+2}
 } 6
-test compExpr-2.37 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} {
-    list [catch {expr {[expr 1+]+5}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
-test compExpr-2.38 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} {
-    list [catch {expr {5+[expr 1+]}} msg] $msg
-} {1 {syntax error in expression "1+": premature end of expression}}
+test compExpr-2.37 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body {
+    expr {[expr 1+]+5}
+} -returnCodes error -match glob -result *
+test compExpr-2.38 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, error in special operator} -body {
+    expr {5+[expr 1+]}
+} -returnCodes error -match glob -result *
 test compExpr-2.39 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
     expr {-2}
 } -2
 test compExpr-2.40 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
     expr {4-2}
 } 2
-test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
-    catch {unset a}
+test compExpr-2.41 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup {
+    unset -nocomplain a
+} -body {
     set a true
     expr {0||$a}
-} 1
-test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
-    catch {unset a}
+} -result 1
+test compExpr-2.42 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
+    unset -nocomplain a
+} -body {
     set a 15
     list [catch {expr {27 || "$a[expr 1+]00"}} msg] $msg
-} {0 1}
-test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
-    catch {unset a}
+} -result {0 1}
+test compExpr-2.43 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup {
+    unset -nocomplain a
+} -body {
     set a false
     expr {3&&$a}
-} 0
-test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} {
-    catch {unset a}
+} -result 0
+test compExpr-2.44 {CompileSubExpr procedure, TCL_TOKEN_OPERATOR token, special operator} -setup {
+    unset -nocomplain a
+} -body {
     set a false
     expr {$a||1? 1 : 0}
-} 1
-test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} {
-    catch {unset a}
+} -result 1
+test compExpr-2.45 {CompileSubExpr procedure, error in TCL_TOKEN_SUB_EXPR parse token} -setup {
+    unset -nocomplain a
+} -body {
     set a 15
     list [catch {expr {1? 54 : "$a[expr 1+]00"}} msg] $msg
-} {0 54}
+} -result {0 54}
 
-test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} {
-    catch {unset a}
+test compExpr-3.1 {CompileLandOrLorExpr procedure, numeric 1st operand} -setup {
+    unset -nocomplain a
+} -body {
     set a 2
     expr {[set a]||0}
-} 1
-test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} {
-    catch {unset a}
+} -result 1
+test compExpr-3.2 {CompileLandOrLorExpr procedure, nonnumeric 1st operand} -setup {
+    unset -nocomplain a
+} -body {
     set a no
     expr {$a&&1}
-} 0
-test compExpr-3.3 {CompileSubExpr procedure, error in 1st operand} {
-    list [catch {expr {[expr *2]||0}} msg] $msg
-} {1 {syntax error in expression "*2": unexpected operator *}}
-test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} {
-    catch {unset a}
-    catch {unset b}
+} -result 0
+test compExpr-3.3 {CompileSubExpr procedure, error in 1st operand} -body {
+    expr {[expr *2]||0}
+} -returnCodes error -match glob -result *
+test compExpr-3.4 {CompileLandOrLorExpr procedure, result is 1 or 0} -setup {
+    unset -nocomplain a
+    unset -nocomplain b
+} -body {
     set a no
     set b true
     expr {$a || $b}
-} 1
-test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} {
-    catch {unset a}
+} -result 1
+test compExpr-3.5 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup {
+    unset -nocomplain a
+} -body {
     set a yes
     expr {$a || [exit]}
-} 1
-test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} {
-    catch {unset a}
+} -result 1
+test compExpr-3.6 {CompileLandOrLorExpr procedure, short-circuit semantics} -setup {
+    unset -nocomplain a
+} -body {
     set a no
     expr {$a && [exit]}
-} 0
-test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} {
-    catch {unset a}
+} -result 0
+test compExpr-3.7 {CompileLandOrLorExpr procedure, numeric 2nd operand} -setup {
+    unset -nocomplain a
+} -body {
     set a 2
     expr {0||[set a]}
-} 1
-test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} {
-    catch {unset a}
+} -result 1
+test compExpr-3.8 {CompileLandOrLorExpr procedure, nonnumeric 2nd operand} -setup {
+    unset -nocomplain a
+} -body {
     set a no
     expr {1&&$a}
-} 0
-test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} {
-    list [catch {expr {0||[expr %2]}} msg] $msg
-} {1 {syntax error in expression "%2": unexpected operator %}}
+} -result 0
+test compExpr-3.9 {CompileLandOrLorExpr procedure, error in 2nd operand} -body {
+    expr {0||[expr %2]}
+} -returnCodes error -match glob -result *
 test compExpr-3.10 {CompileLandOrLorExpr procedure, long lor/land arm} {
     set a "abcdefghijkl"
     set i 7
     expr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]] || [string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]}
 } 1
 
-test compExpr-4.1 {CompileCondExpr procedure, simple test} {
-    catch {unset a}
+test compExpr-4.1 {CompileCondExpr procedure, simple test} -setup {
+    unset -nocomplain a
+} -body {
     set a 2
     expr {($a > 1)? "ok" : "nope"}
-} ok
-test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} {
-    catch {unset a}
+} -result ok
+test compExpr-4.2 {CompileCondExpr procedure, complex test, convert to numeric} -setup {
+    unset -nocomplain a
+} -body {
     set a no
     expr {[set a]? 27 : -54}
-} -54
-test compExpr-4.3 {CompileCondExpr procedure, error in test} {
-    list [catch {expr {[expr *2]? +1 : -1}} msg] $msg
-} {1 {syntax error in expression "*2": unexpected operator *}}
-test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} {
-    catch {unset a}
+} -result -54
+test compExpr-4.3 {CompileCondExpr procedure, error in test} -body {
+    expr {[expr *2]? +1 : -1}
+} -returnCodes error -match glob -result *
+test compExpr-4.4 {CompileCondExpr procedure, simple "true" clause} -setup {
+    unset -nocomplain a
+} -body {
     set a no
     expr {1? (27-2) : -54}
-} 25
-test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} {
-    catch {unset a}
+} -result 25
+test compExpr-4.5 {CompileCondExpr procedure, convert "true" clause to numeric} -setup {
+    unset -nocomplain a
+} -body {
     set a no
     expr {1? $a : -54}
-} no
-test compExpr-4.6 {CompileCondExpr procedure, error in "true" clause} {
-    list [catch {expr {1? [expr *2] : -127}} msg] $msg
-} {1 {syntax error in expression "*2": unexpected operator *}}
-test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} {
-    catch {unset a}
+} -result no
+test compExpr-4.6 {CompileCondExpr procedure, error in "true" clause} -body {
+    expr {1? [expr *2] : -127}
+} -returnCodes error -match glob -result *
+test compExpr-4.7 {CompileCondExpr procedure, simple "false" clause} -setup {
+    unset -nocomplain a
+} -body {
     set a no
     expr {(2-2)? -3.14159 : "nope"}
-} nope
-test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} {
-    catch {unset a}
-    set a 00123
+} -result nope
+test compExpr-4.8 {CompileCondExpr procedure, convert "false" clause to numeric} -setup {
+    unset -nocomplain a
+} -body {
+    set a 0o0123
     expr {0? 42 : $a}
-} 83
+} -result 83
 test compExpr-4.9 {CompileCondExpr procedure, error in "false" clause} {
     list [catch {expr {1? 15 : [expr *2]}} msg] $msg
 } {0 15}
@@ -291,8 +317,8 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
     format %.6g [expr atan2(1.0, 2.0)]
 } 0.463648
 test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
-    list [catch {expr {do_it()}} msg] $msg
-} -match glob -result {1 {* "*do_it"}}
+    expr {do_it()}
+} -returnCodes error -match glob -result {* "*do_it"}
 test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions {
     expr 3*T1()-1
 } 368
@@ -300,27 +326,71 @@ test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathf
     expr T2()*3
 } 1035
 test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body {
-    list [catch {expr {atan2(1.0)}} msg] $msg
-} -match glob -result {1 {too few arguments for math function*}}
+    expr {atan2(1.0)}
+} -returnCodes error -match glob -result {too few arguments for math function*}
 test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
     format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))]
 } 9.97424
-test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} {
-    list [catch {expr {sinh(2.*)}} msg] $msg
-} {1 {syntax error in expression "sinh(2.*)": unexpected close parenthesis}}
+test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body {
+    expr {sinh(2.*)}
+} -returnCodes error -match glob -result *
 test compExpr-5.8 {CompileMathFuncCall procedure, too many arguments} -body {
-    list [catch {expr {sinh(2.0, 3.0)}} msg] $msg
-} -match glob -result {1 {too many arguments for math function*}}
+    expr {sinh(2.0, 3.0)}
+} -returnCodes error -match glob -result {too many arguments for math function*}
 test compExpr-5.9 {CompileMathFuncCall procedure, too many arguments} -body {
-    list [catch {expr {0 <= rand(5.2)}} msg] $msg
-} -match glob -result {1 {too many arguments for math function*}}
+    expr {0 <= rand(5.2)}
+} -returnCodes error -match glob -result {too many arguments for math function*}
 
-test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} {
-    list [catch {expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3} msg] $msg
-} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012...": extra tokens at end of expression}}
+test compExpr-6.1 {LogSyntaxError procedure, error in expr longer than 60 chars} -body {
+    expr {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1 foo 3
+} -returnCodes error -match glob -result *
 
+test compExpr-7.1 {Memory Leak} -constraints memory -setup {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	lindex $lines 3 3
+    }
+} -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	interp create slave
+	slave eval expr 1+2+3+4+5+6+7+8+9+10+11+12+13
+	interp delete slave
+	set tmp $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    unset end i tmp
+    rename getbytes {}
+} -result 0
+
+test compExpr-7.2 {[Bug 1869989]: expr parser memleak} -constraints memory -setup {
+    proc getbytes {} {
+        set lines [split [memory info] \n]
+        lindex $lines 3 3
+    }
+} -body {
+    set i 5
+    set end [getbytes]
+    while {[incr i -1]} {
+        expr ${i}000
+        set tmp $end
+        set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    unset end i tmp
+    rename getbytes {}
+} -result 0
+
 # cleanup
 catch {unset a}
 catch {unset b}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/compile.test b/tests/compile.test
index 1c774c4..2852bf2 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -1,21 +1,22 @@
-# This file contains tests for the files tclCompile.c, tclCompCmds.c
-# and tclLiteral.c
+# This file contains tests for the files tclCompile.c, tclCompCmds.c and
+# tclLiteral.c
 #
-# 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) 1997 by 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.
-#
-# RCS: @(#) $Id: compile.test,v 1.38 2005/05/10 18:35:18 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 package require tcltest 2
 namespace import -force ::tcltest::*
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint exec       [llength [info commands exec]]
 testConstraint memory     [llength [info commands memory]]
 testConstraint testevalex [llength [info commands testevalex]]
@@ -28,10 +29,11 @@ catch {namespace delete test_ns_compile}
 catch {unset x}
 catch {unset y}
 catch {unset a}
-
-test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} {
+
+test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} -setup {
     catch {namespace delete test_ns_compile}
     catch {unset x}
+} -body {
     set x 123
     namespace eval test_ns_compile {
         proc set {args} {
@@ -43,63 +45,70 @@ test compile-1.1 {TclCompileString: look up cmds in proc ns, not current ns} {
         }
     }
     list [test_ns_compile::p] [set x]
-} {{123 test_ns_compile::set} {123 test_ns_compile::set}}
+} -result {{123 test_ns_compile::set} {123 test_ns_compile::set}}
 test compile-1.2 {TclCompileString, error result is reset if TclGetLong determines word isn't an integer} {
     proc p {x} {info commands 3m}
     list [catch {p} msg] $msg
 } {1 {wrong # args: should be "p x"}}
-test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} {
+
+test compile-2.1 {TclCompileDollarVar: global scalar name with ::s} -setup {
     catch {unset x}
+} -body {
     set x 123
-    list $::x [expr {[lsearch -exact [info globals] x] != 0}]
-} {123 1}
-test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} {
+    list $::x [expr {"x" in [info globals]}]
+} -result {123 1}
+test compile-2.2 {TclCompileDollarVar: global scalar name with ::s} -setup {
     catch {unset y}
+} -body {
     proc p {} {
         set ::y 789
         return $::y
     }
-    list [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
-} {789 789 1}
-test compile-2.3 {TclCompileDollarVar: global array name with ::s} {
+    list [p] $::y [expr {"y" in [info globals]}]
+} -result {789 789 1}
+test compile-2.3 {TclCompileDollarVar: global array name with ::s} -setup {
     catch {unset a}
+} -body {
     set ::a(1) 2
-    list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {[lsearch -exact [info globals] a] != 0}]
-} {2 3 3 1}
-test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} {
+    list $::a(1) [set ::a($::a(1)) 3] $::a(2) [expr {"a" in [info globals]}]
+} -result {2 3 3 1}
+test compile-2.4 {TclCompileDollarVar: global scalar name with ::s} -setup {
     catch {unset a}
+} -body {
     proc p {} {
         set ::a(1) 1
         return $::a($::a(1))
     }
-    list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
-} {1 1 1}
-test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} {
+    list [p] $::a(1) [expr {"a" in [info globals]}]
+} -result {1 1 1}
+test compile-2.5 {TclCompileDollarVar: global array, called as ${arrName(0)}} -setup {
     catch {unset a}
+} -body {
     proc p {} {
 	global a
         set a(1) 1
         return ${a(1)}$::a(1)$a(1)
     }
-    list [p] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
-} {111 1 1}
+    list [p] $::a(1) [expr {"a" in [info globals]}]
+} -result {111 1 1}
 
-test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} {
+test compile-3.1 {TclCompileCatchCmd: only catch cmds with scalar vars are compiled inline} -setup {
     catch {unset a}
+} -body {
     set a(1) xyzzyx
     proc p {} {
         global a
         catch {set x 123} a(1)
     }
     list [p] $a(1)
-} {0 123}
+} -result {0 123}
 test compile-3.2 {TclCompileCatchCmd: non-local variables} {
     set ::foo 1
     proc catch-test {} {
 	catch {set x 3} ::foo
     }
     catch-test
-    set ::foo
+    return $::foo
 } 3
 test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} {
     proc catch-test {str} {
@@ -107,7 +116,7 @@ test compile-3.3 {TclCompileCatchCmd: overagressive compiling [bug 219184]} {
 	error BAD
     }
     catch {catch-test error} ::foo
-    set ::foo
+    return $::foo
 } {GOOD}
 test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} {
     proc foo {} {
@@ -128,6 +137,65 @@ test compile-3.5 {TclCompileCatchCmd: recover from error, [Bug 705406]} {
     }
     list [catch foo msg] $msg
 } {0 1}
+test compile-3.6 {TclCompileCatchCmd: error in storing result [Bug 3098302]} {*}{
+     -setup {
+	 namespace eval catchtest {
+	     variable result1 {}
+	 }
+	 trace add variable catchtest::result1 write catchtest::failtrace
+	 proc catchtest::failtrace {n1 n2 op} {
+	     return -code error "trace on $n1 fails by request"
+	 }
+     }
+    -body {
+	proc catchtest::x {} {
+	    variable result1
+	    set count 0
+	    for {set i 0} {$i < 10} {incr i} {
+		set status2 [catch {
+		    set status1 [catch {
+			return -code error -level 0 "original failure"
+		    } result1 options1]
+		} result2 options2]
+		incr count
+	    }
+	    list $count $result2
+	}
+	catchtest::x
+    }
+    -result {10 {can't set "result1": trace on result1 fails by request}}
+    -cleanup {namespace delete catchtest}
+}
+
+test compile-3.7 {TclCompileCatchCmd: error in storing options [Bug 3098302]} {*}{
+     -setup {
+	 namespace eval catchtest {
+	     variable options1 {}
+	 }
+	 trace add variable catchtest::options1 write catchtest::failtrace
+	 proc catchtest::failtrace {n1 n2 op} {
+	     return -code error "trace on $n1 fails by request"
+	 }
+     }
+    -body {
+	proc catchtest::x {} {
+	    variable options1
+	    set count 0
+	    for {set i 0} {$i < 10} {incr i} {
+		set status2 [catch {
+		    set status1 [catch {
+			return -code error -level 0 "original failure"
+		    } result1 options1]
+		} result2 options2]
+		incr count
+	    }
+	    list $count $result2
+	}
+	catchtest::x
+    }
+    -result {10 {can't set "options1": trace on options1 fails by request}}
+    -cleanup {namespace delete catchtest}
+}
 
 test compile-4.1 {TclCompileForCmd: command substituted test expression} {
     set i 0
@@ -157,29 +225,32 @@ test compile-5.2 {TclCompileForeachCmd: non-local variables} {
     set ::foo
 } 3
 
-test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} {
+test compile-6.1 {TclCompileSetCmd: global scalar names with ::s} -setup {
     catch {unset x}
     catch {unset y}
+} -body {
     set x 123
     proc p {} {
         set ::y 789
         return $::y
     }
-    list $::x [expr {[lsearch -exact [info globals] x] != 0}] \
-         [p] $::y [expr {[lsearch -exact [info globals] y] != 0}]
-} {123 1 789 789 1}
-test compile-6.2 {TclCompileSetCmd: global array names with ::s} {
+    list $::x [expr {"x" in [info globals]}] \
+         [p] $::y [expr {"y" in [info globals]}]
+} -result {123 1 789 789 1}
+test compile-6.2 {TclCompileSetCmd: global array names with ::s} -setup {
     catch {unset a}
+} -body {
     set ::a(1) 2
     proc p {} {
         set ::a(1) 1
         return $::a($::a(1))
     }
-    list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {[lsearch -exact [info globals] a] != 0}]
-} {2 1 3 3 1}
-test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} {
+    list $::a(1) [p] [set ::a($::a(1)) 3] $::a(1) [expr {"a" in [info globals]}]
+} -result {2 1 3 3 1}
+test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} -setup {
     catch {namespace delete test_ns_compile}
     catch {unset x}
+} -body {
     namespace eval test_ns_compile {
         variable v hello
         variable arr
@@ -187,7 +258,7 @@ test compile-6.3 {TclCompileSetCmd: namespace var names with ::s} {
 	set ::test_ns_compile::arr(1) 123
     }
     list $::x $::test_ns_compile::arr(1)
-} {hello 123}
+} -result {hello 123}
 
 test compile-7.1 {TclCompileWhileCmd: command substituted test expression} {
     set i 0
@@ -228,53 +299,45 @@ test compile-10.1 {BLACKBOX: exception stack overflow} {
     }
 } {}
 
-test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
-    proc p {} {
+test compile-11.1 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+    apply {{} {
 	# shared object - Interp result && Var 'r'
 	set r [list foobar]
 	# command that will add error to result
 	lindex a bogus
-    }
-    list [catch {p} msg] $msg
-} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
-test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
-    proc p {} { set r [list foobar] ; string index a bogus }
-    list [catch {p} msg] $msg
-} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
-test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
-    proc p {} { set r [list foobar] ; string index a 09 }
-    list [catch {p} msg] $msg
-} {1 {bad index "09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
-    proc p {} { set r [list foobar] ; array set var {one two many} }
-    list [catch {p} msg] $msg
-} {1 {list must have an even number of elements}}
-test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
-    proc p {} { set r [list foobar] ; incr foo }
-    list [catch {p} msg] $msg
-} {1 {can't read "foo": no such variable}}
-test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
-    proc p {} { set r [list foobar] ; incr foo bogus }
-    list [catch {p} msg] $msg
-} {1 {expected integer but got "bogus"}}
+    }}
+} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
+test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+    apply {{} { set r [list foobar] ; string index a bogus }}
+} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
+test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+    apply {{} { set r [list foobar] ; string index a 0o9 }}
+} -returnCodes error -match glob -result {*invalid octal number*}
+test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+    apply {{} { set r [list foobar] ; array set var {one two many} }}
+} -returnCodes error -result {list must have an even number of elements}
+test compile-11.5 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+    apply {{} { set r [list foobar] ; incr foo bar baz}}
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
+test compile-11.6 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+    apply {{} { set r [list foobar] ; incr}}
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
 test compile-11.7 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
-    proc p {} { set r [list foobar] ; expr !a }
-    list [catch {p} msg] $msg
-} -match glob -result {1 {syntax error in expression "!a": * preceding $*}}
+    apply {{} { set r [list foobar] ; expr !a }}
+} -returnCodes error -match glob -result *
 test compile-11.8 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
-    proc p {} { set r [list foobar] ; expr {!a} }
-    list [catch {p} msg] $msg
-} -match glob -result {1 {syntax error in expression "!a": * preceding $*}}
-test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} {
-    proc p {} { set r [list foobar] ; llength "\{" }
+    apply {{} { set r [list foobar] ; expr {!a} }}
+} -returnCodes error -match glob -result *
+test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
+    apply {{} { set r [list foobar] ; llength "\{" }}
     list [catch {p} msg] $msg
-} {1 {unmatched open brace in list}}
+} -returnCodes error -result {unmatched open brace in list}
 
 # 
 # Special section for tests of tclLiteral.c
 # The following tests check for incorrect memory handling in
-# TclReleaseLiteral. They are only effective when tcl is compiled 
-# with TCL_MEM_DEBUG
+# TclReleaseLiteral. They are only effective when tcl is compiled with
+# TCL_MEM_DEBUG
 #
 # Special test for leak on interp delete [Bug 467523]. 
 test compile-12.1 {testing literal leak on interp delete} -setup {
@@ -296,10 +359,11 @@ test compile-12.1 {testing literal leak on interp delete} -setup {
     set leakedBytes [expr {$end - $tmp}]
 } -cleanup {
     rename getbytes {}
+    unset -nocomplain end i tmp leakedBytes
 } -result 0
-# Special test for a memory error in a preliminary fix of [Bug 467523]. 
-# It requires executing a helpfile.  Presumably the child process is
-# used because when this test fails, it crashes.
+# Special test for a memory error in a preliminary fix of [Bug 467523].  It
+# requires executing a helpfile.  Presumably the child process is used because
+# when this test fails, it crashes.
 test compile-12.2 {testing error on literal deletion} -constraints {memory exec} -body {
     set sourceFile [makeFile {
 	for {set i 0} {$i < 5} {incr i} {
@@ -320,33 +384,32 @@ test compile-12.3 {check for a buffer overrun} -body {
     crash
 } -returnCodes error -cleanup {
     rename crash {}
-} -match glob -result {syntax error in expression "a+2": * preceding $*}
+} -match glob -result *
 test compile-12.4 {TclCleanupLiteralTable segfault} -body {
     # Tcl Bug 1001997
     # Here, we're trying to test a case that causes a crash in
-    # TclCleanupLiteralTable.  The conditions that we're trying to
-    # establish are:
-    # - TclCleanupLiteralTable is attempting to clean up a bytecode
-    #   object in the literal table.
-    # - The bytecode object in question contains the only reference
-    #   to another literal.
+    # TclCleanupLiteralTable.  The conditions that we're trying to establish
+    # are:
+    # - TclCleanupLiteralTable is attempting to clean up a bytecode object in
+    #   the literal table.
+    # - The bytecode object in question contains the only reference to another
+    #   literal.
     # - The literal in question is in the same hash bucket as the bytecode
     #   object, and immediately follows it in the chain.
-    # Since newly registered literals are added at the FRONT of the
-    # bucket chains, and since the bytecode object is registered before
-    # its literals, this is difficult to achieve.  What we do is:
-    #  (a) do a [namespace eval] of a string that's calculated to
-    #      hash into the same bucket as a literal that it contains.
-    #      In this case, the script and the variable 'bugbug' 
-    #      land in the same bucket.
-    #  (b) do a [namespace eval] of a string that contains enough
-    #      literals to force TclRegisterLiteral to rebuild the global
-    #      literal table.  The newly created hash buckets will contain
-    #      the literals, IN REVERSE ORDER, thus putting the bytecode
-    #      immediately ahead of 'bugbug' and 'bug4345bug'.  The bytecode
-    #      object will contain the only references to those two literals.
-    #  (c) Delete the interpreter to invoke TclCleanupLiteralTable
-    #      and tickle the bug.
+    # Since newly registered literals are added at the FRONT of the bucket
+    # chains, and since the bytecode object is registered before its literals,
+    # this is difficult to achieve.  What we do is:
+    #  (a) do a [namespace eval] of a string that's calculated to hash into
+    #      the same bucket as a literal that it contains.  In this case, the
+    #      script and the variable 'bugbug' land in the same bucket.
+    #  (b) do a [namespace eval] of a string that contains enough literals to
+    #      force TclRegisterLiteral to rebuild the global literal table.  The
+    #      newly created hash buckets will contain the literals, IN REVERSE
+    #      ORDER, thus putting the bytecode immediately ahead of 'bugbug' and
+    #      'bug4345bug'.  The bytecode object will contain the only references
+    #      to those two literals.
+    #  (c) Delete the interpreter to invoke TclCleanupLiteralTable and tickle
+    #      the bug.
     proc foo {} {
 	set i [interp create]
 	$i eval {
@@ -380,9 +443,8 @@ test compile-12.4 {TclCleanupLiteralTable segfault} -body {
     rename foo {}
 } -result ok
 
-# Special test for underestimating the maxStackSize required for a
-# compiled command. A failure will cause a segfault in the child 
-# process.
+# Special test for underestimating the maxStackSize required for a compiled
+# command. A failure will cause a segfault in the child process.
 test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} {
     set body {set x [list}
     for {set i 0} {$i < 3000} {incr i} {
@@ -393,8 +455,8 @@ test compile-13.1 {testing underestimate of maxStackSize in list cmd} {exec} {
     list [catch {exec [interpreter] << $script} msg] $msg
 } {0 OK}
 
-# Special test for compiling tokens from a copy of the source
-# string [Bug #599788]
+# Special test for compiling tokens from a copy of the source string. [Bug
+# 599788]
 test compile-14.1 {testing errors in element name; segfault?} {} {
      catch {set a([error])} msg1
      catch {set bubba([join $abba $jubba]) $vol} msg2
@@ -403,34 +465,19 @@ test compile-14.1 {testing errors in element name; segfault?} {} {
 
 # Tests compile-15.* cover Tcl Bug 633204
 test compile-15.1 {proper TCL_RETURN code from [return]} {
-    proc p {} {catch return}
-    set result [p]
-    rename p {}
-    set result
+    apply {{} {catch return}}
 } 2
 test compile-15.2 {proper TCL_RETURN code from [return]} {
-    proc p {} {catch {return foo}}
-    set result [p]
-    rename p {}
-    set result
+    apply {{} {catch {return foo}}}
 } 2
 test compile-15.3 {proper TCL_RETURN code from [return]} {
-    proc p {} {catch {return $::tcl_library}}
-    set result [p]
-    rename p {}
-    set result
+    apply {{} {catch {return $::tcl_library}}}
 } 2
 test compile-15.4 {proper TCL_RETURN code from [return]} {
-    proc p {} {catch {return [info library]}}
-    set result [p]
-    rename p {}
-    set result
+    apply {{} {catch {return [info library]}}}
 } 2
 test compile-15.5 {proper TCL_RETURN code from [return]} {
-    proc p {} {catch {set a 1}; return}
-    set result [p]
-    rename p {}
-    set result
+    apply {{} {catch {set a 1}; return}}
 } ""
 
 for {set noComp 0} {$noComp <= 1} {incr noComp} {
@@ -444,124 +491,103 @@ if $noComp {
 }
 
 test compile-16.1.$noComp {TclCompileScript: word expansion} $constraints {
-    run "list [string repeat {{expand}a } 255]"
+    run "list [string repeat {{*}a } 255]"
 } [lrepeat 255 a]
-
 test compile-16.2.$noComp {TclCompileScript: word expansion} $constraints {
-    run "list [string repeat {{expand}a } 256]"
+    run "list [string repeat {{*}a } 256]"
 } [lrepeat 256 a]
-
 test compile-16.3.$noComp {TclCompileScript: word expansion} $constraints {
-    run "list [string repeat {{expand}a } 257]"
+    run "list [string repeat {{*}a } 257]"
 } [lrepeat 257 a]
-
 test compile-16.4.$noComp {TclCompileScript: word expansion} $constraints {
-    run {{expand}list}
+    run {{*}list}
 } {}
-
 test compile-16.5.$noComp {TclCompileScript: word expansion} $constraints {
-    run {{expand}list {expand}{x y z}}
+    run {{*}list {*}{x y z}}
 } {x y z}
-
 test compile-16.6.$noComp {TclCompileScript: word expansion} $constraints {
-    run {{expand}list {expand}[list x y z]}
+    run {{*}list {*}[list x y z]}
 } {x y z}
-
 test compile-16.7.$noComp {TclCompileScript: word expansion} $constraints {
-    run {{expand}list {expand}[list x y z][list x y z]}
+    run {{*}list {*}[list x y z][list x y z]}
 } {x y zx y z}
-
 test compile-16.8.$noComp {TclCompileScript: word expansion} -body {
     set l {x y z}
-    run {{expand}list {expand}$l}
+    run {{*}list {*}$l}
 } -constraints $constraints -cleanup {
     unset l
 } -result {x y z}
-
 test compile-16.9.$noComp {TclCompileScript: word expansion} -body {
     set l {x y z}
-    run {{expand}list {expand}$l$l}
+    run {{*}list {*}$l$l}
 } -constraints $constraints -cleanup {
     unset l
 } -result {x y zx y z}
-
 test compile-16.10.$noComp {TclCompileScript: word expansion} -body {
-    run {{expand}\{}
+    run {{*}\{}
 } -constraints $constraints -returnCodes error \
 -result {unmatched open brace in list}
-
 test compile-16.11.$noComp {TclCompileScript: word expansion} -body {
     proc badList {} {return \{}
-    run {{expand}[badList]}
+    run {{*}[badList]}
 } -constraints $constraints -cleanup {
     rename badList {}
 } -returnCodes error  -result {unmatched open brace in list}
-
 test compile-16.12.$noComp {TclCompileScript: word expansion} $constraints {
-    run {{expand}list x y z}
+    run {{*}list x y z}
 } {x y z}
-
 test compile-16.13.$noComp {TclCompileScript: word expansion} $constraints {
-    run {{expand}list x y {expand}z}
+    run {{*}list x y {*}z}
 } {x y z}
-
 test compile-16.14.$noComp {TclCompileScript: word expansion} $constraints {
-    run {{expand}list x {expand}y z}
+    run {{*}list x {*}y z}
 } {x y z}
-
 test compile-16.15.$noComp {TclCompileScript: word expansion} $constraints {
-    run {list x y {expand}z}
+    run {list x y {*}z}
 } {x y z}
-
 test compile-16.16.$noComp {TclCompileScript: word expansion} $constraints {
-    run {list x {expand}y z}
+    run {list x {*}y z}
 } {x y z}
-
 test compile-16.17.$noComp {TclCompileScript: word expansion} $constraints {
-    run {list {expand}x y z}
+    run {list {*}x y z}
 } {x y z}
 
-# These tests note that expansion can in theory cause the number of
-# arguments to a command to exceed INT_MAX, which is as big as objc
-# is allowed to get.
+# These tests note that expansion can in theory cause the number of arguments
+# to a command to exceed INT_MAX, which is as big as objc is allowed to get.
 #
-# In practice, it seems we will run out of memory before we confront
-# this issue.  Note that compiled operations run out of memory at
-# smaller objc values than direct string evaluation.
+# In practice, it seems we will run out of memory before we confront this
+# issue. Note that compiled operations run out of memory at smaller objc
+# values than direct string evaluation.
 #
-# These tests are constrained as knownBug because they are likely
-# to cause memory allocation panics somewhere, and we don't want
-# panics in the test suite.
+# These tests are constrained as knownBug because they are likely to cause
+# memory allocation panics somewhere, and we don't want panics in the test
+# suite.
 #
 test compile-16.18.$noComp {TclCompileScript: word expansion} -body {
     proc LongList {} {return [lrepeat [expr {1<<10}] x]}
-    llength [run "list [string repeat {{expand}[LongList] } [expr {1<<10}]]"]
+    llength [run "list [string repeat {{*}[LongList] } [expr {1<<10}]]"]
 } -constraints [linsert $constraints 0 knownBug] -cleanup {
     rename LongList {}
 } -returnCodes ok  -result [expr {1<<20}]
-
 test compile-16.19.$noComp {TclCompileScript: word expansion} -body {
     proc LongList {} {return [lrepeat [expr {1<<11}] x]}
-    llength [run "list [string repeat {{expand}[LongList] } [expr {1<<11}]]"]
+    llength [run "list [string repeat {{*}[LongList] } [expr {1<<11}]]"]
 } -constraints [linsert $constraints 0 knownBug] -cleanup {
     rename LongList {}
 } -returnCodes ok  -result [expr {1<<22}]
-
 test compile-16.20.$noComp {TclCompileScript: word expansion} -body {
     proc LongList {} {return [lrepeat [expr {1<<12}] x]}
-    llength [run "list [string repeat {{expand}[LongList] } [expr {1<<12}]]"]
+    llength [run "list [string repeat {{*}[LongList] } [expr {1<<12}]]"]
 } -constraints [linsert $constraints 0 knownBug] -cleanup {
     rename LongList {}
 } -returnCodes ok  -result [expr {1<<24}]
-
 # This is the one that should cause overflow
 test compile-16.21.$noComp {TclCompileScript: word expansion} -body {
     proc LongList {} {return [lrepeat [expr {1<<16}] x]}
-    llength [run "list [string repeat {{expand}[LongList] } [expr {1<<16}]]"]
+    llength [run "list [string repeat {{*}[LongList] } [expr {1<<16}]]"]
 } -constraints [linsert $constraints 0 knownBug] -cleanup {
     rename LongList {}
 } -returnCodes ok  -result [expr {wide(1)<<32}]
-
 test compile-16.22.$noComp {
     Bug 845412: TclCompileScript: word expansion not mandatory
 } -body {
@@ -571,7 +597,6 @@ test compile-16.22.$noComp {
 } -constraints $constraints -cleanup {
     rename ReturnResults {}
 } -returnCodes ok -result [string trim [string repeat {x } 260]]
-
 test compile-16.23.$noComp {
     Bug 1032805: defer parse error until run time
 } -constraints $constraints -body {
@@ -584,11 +609,22 @@ test compile-16.23.$noComp {
 } -cleanup {
     namespace delete x
 } -returnCodes ok -result {syntax {}{}}
-
+test compile-16.24.$noComp {
+    Bug 1638414: bad list constant as first expanded term
+} -constraints $constraints -body {
+    run "{*}\"\{foo bar\""
+} -returnCodes error -result {unmatched open brace in list}
+test compile-16.25.$noComp {TclCompileScript: word expansion, naked backslashes} $constraints {
+    run {list {*}{a \n b}}
+} {a {
+} b}
+test compile-16.26.$noComp {TclCompileScript: word expansion, protected backslashes} $constraints {
+    run {list {*}{a {\n} b}}
+} {a {\n} b}
 }	;# End of noComp loop
 
-# These tests are messy because it wrecks the interpreter it runs in!
-# They demonstrate issues arising from [FRQ 1101710]
+# These tests are messy because it wrecks the interpreter it runs in!  They
+# demonstrate issues arising from [FRQ 1101710]
 test compile-17.1 {Command interpretation binding for compiled code} -constraints knownBug -setup {
     set i [interp create]
 } -body {
@@ -618,6 +654,161 @@ test compile-17.2 {Command interpretation binding for non-compiled code} -setup
     interp delete $i
 } -result substituted
 
+# This tests the supported parts of the unsupported [disassemble] command. It
+# does not check the format of disassembled bytecode though; that's liable to
+# change without warning.
+
+test compile-18.1 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble
+} -match glob -result {wrong # args: should be "*"}
+test compile-18.2 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble ?
+} -match glob -result {bad type "?": must be *}
+test compile-18.3 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble lambda
+} -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
+test compile-18.4 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble lambda \{
+} -result "can't interpret \"\{\" as a lambda expression"
+test compile-18.5 {disassembler - basics} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble lambda {{} {}}
+} -match glob -result *
+test compile-18.6 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble proc
+} -match glob -result {wrong # args: should be "* proc procName"}
+test compile-18.7 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble proc nosuchproc
+} -result {"nosuchproc" isn't a procedure}
+test compile-18.8 {disassembler - basics} -setup {
+    proc chewonthis {} {}
+} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble proc chewonthis
+} -cleanup {
+    rename chewonthis {}
+} -match glob -result *
+test compile-18.9 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble script
+} -match glob -result {wrong # args: should be "* script script"}
+test compile-18.10 {disassembler - basics} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble script {}
+} -match glob -result *
+test compile-18.11 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble method
+} -match glob -result {wrong # args: should be "* method className methodName"}
+test compile-18.12 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble method nosuchclass foo
+} -result {nosuchclass does not refer to an object}
+test compile-18.13 {disassembler - basics} -returnCodes error -setup {
+    oo::object create justanobject
+} -body {
+    tcl::unsupported::disassemble method justanobject foo
+} -cleanup {
+    justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.14 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble method oo::object nosuchmethod
+} -result {unknown method "nosuchmethod"}
+test compile-18.15 {disassembler - basics} -setup {
+    oo::class create foo {method bar {} {}}
+} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble method foo bar
+} -cleanup {
+    foo destroy
+} -match glob -result *
+test compile-18.16 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble objmethod
+} -match glob -result {wrong # args: should be "* objmethod objectName methodName"}
+test compile-18.17 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble objmethod nosuchobject foo
+} -result {nosuchobject does not refer to an object}
+test compile-18.18 {disassembler - basics} -returnCodes error -body {
+    tcl::unsupported::disassemble objmethod oo::object nosuchmethod
+} -result {unknown method "nosuchmethod"}
+test compile-18.19 {disassembler - basics} -setup {
+    oo::object create foo
+    oo::objdefine foo {method bar {} {}}
+} -body {
+    # Allow any string: the result format is not defined anywhere!
+    tcl::unsupported::disassemble objmethod foo bar
+} -cleanup {
+    foo destroy
+} -match glob -result *
+
+test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
+    # This will panic in a --enable-symbols=compile build, unless bug is fixed.
+    apply {{} {list [if 1]}}
+} -returnCodes error -match glob -result *
+
+test compile-20.1 {ensure there are no infinite loops in optimizing} {
+    tcl::unsupported::disassemble script {
+	while 1 {
+	    return -code continue -level 0
+	}
+    }
+    return
+} {}
+test compile-20.2 {ensure there are no infinite loops in optimizing} {
+    tcl::unsupported::disassemble script {
+	while 1 {
+	    while 1 {
+		return -code break -level 0
+	    }
+	}
+    }
+    return
+} {}
+
+test compile-21.1 {stack balance management} {
+    apply {{} {
+	set result {}
+	while 1 {
+	    lappend result a
+	    lappend result [list b [break]]
+	    lappend result c
+	}
+	return $result
+    }}
+} a
+test compile-21.2 {stack balance management} {
+    apply {{} {
+	set result {}
+	while {[incr i] <= 10} {
+	    lappend result $i
+	    lappend result [list b [continue] c]
+	    lappend result c
+	}
+	return $result
+    }}
+} {1 2 3 4 5 6 7 8 9 10}
+test compile-21.3 {stack balance management} {
+    apply {args {
+	set result {}
+	while 1 {
+	    lappend result a
+	    lappend result [concat {*}$args [break]]
+	    lappend result c
+	}
+	return $result
+    }} P Q R S T
+} a
+test compile-21.4 {stack balance management} {
+    apply {args {
+	set result {}
+	while {[incr i] <= 10} {
+	    lappend result $i
+	    lappend result [concat {*}$args [continue] c]
+	    lappend result c
+	}
+	return $result
+    }} P Q R S T
+} {1 2 3 4 5 6 7 8 9 10}
+
+# TODO sometime - check that bytecode from tbcload is *not* disassembled.
+
 # cleanup
 catch {rename p ""}
 catch {namespace delete test_ns_compile}
@@ -626,3 +817,8 @@ catch {unset y}
 catch {unset a}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/concat.test b/tests/concat.test
index c369340..eeb11ca 100644
--- a/tests/concat.test
+++ b/tests/concat.test
@@ -1,23 +1,21 @@
 # Commands covered:  concat
 #
-# 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-1996 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.
-#
-# RCS: @(#) $Id: concat.test,v 1.6 2004/05/19 10:55:05 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-
+
 test concat-1.1 {simple concatenation} {
     concat a b c d e f g
 } {a b c d e f g}
@@ -48,7 +46,12 @@ test concat-4.2 {pruning off extra white space} {
 test concat-4.3 {pruning off extra white space sets length correctly} {
     llength [concat { {{a}} }]
 } 1
-
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/config.test b/tests/config.test
index 2023d9c..d14837e 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -11,8 +11,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: config.test,v 1.4 2004/10/29 15:39:10 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -35,7 +33,7 @@ test pkgconfig-1.3 {query value multiple times} {
 test pkgconfig-2.0 {error: missing subcommand} {
     catch {::tcl::pkgconfig} msg
     set msg
-} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}
+} {wrong # args: should be "::tcl::pkgconfig subcommand ?arg?"}
 test pkgconfig-2.1 {error: illegal subcommand} {
     catch {::tcl::pkgconfig foo} msg
     set msg
@@ -55,7 +53,7 @@ test pkgconfig-2.4 {error: query unknown key} {
 test pkgconfig-2.5 {error: query with to many arguments} {
     catch {::tcl::pkgconfig get foo bar} msg
     set msg
-} {wrong # args: should be "::tcl::pkgconfig subcommand ?argument?"}
+} {wrong # args: should be "::tcl::pkgconfig subcommand ?arg?"}
 
 # cleanup
 ::tcltest::cleanupTests
diff --git a/tests/coroutine.test b/tests/coroutine.test
new file mode 100644
index 0000000..05b58c9
--- /dev/null
+++ b/tests/coroutine.test
@@ -0,0 +1,739 @@
+# Commands covered:  coroutine, yield, yieldto, [info coroutine]
+#
+# This file contains a collection of tests for experimental commands that are
+# found in ::tcl::unsupported. The tests will migrate to normal test files
+# if/when the commands find their way into the core.
+#
+# Copyright (c) 2008 by Miguel Sofer.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testnrelevels [llength [info commands testnrelevels]]
+testConstraint memory [llength [info commands memory]]
+
+set lambda [list {{start 0} {stop 10}} {
+    # init
+    set i    $start
+    set imax $stop
+    yield
+    while {$i < $imax} {
+	yield [expr {$i*$stop}]
+	incr i
+    }
+}]
+
+test coroutine-1.1 {coroutine basic} -setup {
+    coroutine foo ::apply $lambda
+    set res {}
+} -body {
+    for {set k 1} {$k < 4} {incr k} {
+	lappend res [foo]
+    }
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {0 10 20}
+test coroutine-1.2 {coroutine basic} -setup {
+    coroutine foo ::apply $lambda 2 8
+    set res {}
+} -body {
+    for {set k 1} {$k < 4} {incr k} {
+	lappend res [foo]
+    }
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {16 24 32}
+test coroutine-1.3 {yield returns new arg} -setup {
+    set body {
+	# init
+	set i    $start
+	set imax $stop
+	yield
+	while {$i < $imax} {
+	    set stop [yield [expr {$i*$stop}]]
+	    incr i
+	}
+    }
+    coroutine foo ::apply [list {{start 2} {stop 10}} $body] 
+    set res {}
+} -body {
+    for {set k 1} {$k < 4} {incr k} {
+	lappend res [foo $k]
+    }
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {20 6 12}
+test coroutine-1.4 {yield in nested proc} -setup {
+    proc moo {} {
+	upvar 1 i i stop stop
+	yield [expr {$i*$stop}]
+    }
+    set body {
+	# init
+	set i    $start
+	set imax $stop
+	yield
+	while {$i < $imax} {
+	    moo
+	    incr i
+	}
+    }
+    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+    set res {}
+} -body {
+    for {set k 1} {$k < 4} {incr k} {
+	lappend res [foo $k]
+    }
+    set res
+} -cleanup {
+    rename foo {}
+    rename moo {}
+    unset body res
+} -result {0 10 20}
+test coroutine-1.5 {just yield} -body {
+    coroutine foo yield
+    list [foo] [catch foo msg] $msg
+} -cleanup {
+    unset msg
+} -result {{} 1 {invalid command name "foo"}}
+test coroutine-1.6 {just yield} -body {
+    coroutine foo [list yield]
+    list [foo] [catch foo msg] $msg
+} -cleanup {
+    unset msg
+} -result {{} 1 {invalid command name "foo"}}
+test coroutine-1.7 {yield in nested uplevel} -setup {
+    set body {
+	# init
+	set i    $start
+	set imax $stop
+	yield
+	while {$i < $imax} {
+	    uplevel 0 [list yield [expr {$i*$stop}]]
+	    incr i
+	}
+    }
+    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+    set res {}
+} -body {
+    for {set k 1} {$k < 4} {incr k} {
+	lappend res [eval foo $k]
+    }
+    set res
+} -cleanup {
+    rename foo {}
+    unset body res
+} -result {0 10 20}
+test coroutine-1.8 {yield in nested uplevel} -setup {
+    set body {
+	# init
+	set i    $start
+	set imax $stop
+	yield
+	while {$i < $imax} {
+	    uplevel 0 yield [expr {$i*$stop}]
+	    incr i
+	}
+    }
+    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+    set res {}
+} -body {
+    for {set k 1} {$k < 4} {incr k} {
+	lappend res [eval foo $k]
+    }
+    set res
+} -cleanup {
+    rename foo {}
+    unset body res
+} -result {0 10 20}
+test coroutine-1.9 {yield in nested eval} -setup {
+    proc moo {} {
+	upvar 1 i i stop stop
+	yield [expr {$i*$stop}]
+    }
+    set body {
+	# init
+	set i    $start
+	set imax $stop
+	yield
+	while {$i < $imax} {
+	    eval moo
+	    incr i
+	}
+    }
+    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+    set res {}
+} -body {
+    for {set k 1} {$k < 4} {incr k} {
+	lappend res [foo $k]
+    }
+    set res
+} -cleanup {
+    rename moo {}
+    unset body res
+} -result {0 10 20}
+test coroutine-1.10 {yield in nested eval} -setup {
+    set body {
+	# init
+	set i    $start
+	set imax $stop
+	yield
+	while {$i < $imax} {
+	    eval yield [expr {$i*$stop}]
+	    incr i
+	}
+    }
+    coroutine foo ::apply [list {{start 0} {stop 10}} $body]
+    set res {}
+} -body {
+    for {set k 1} {$k < 4} {incr k} {
+	lappend res [eval foo $k]
+    }
+    set res
+} -cleanup {
+    unset body res
+} -result {0 10 20}
+test coroutine-1.11 {yield outside coroutine} -setup {
+    proc moo {} {
+	upvar 1 i i stop stop
+	yield [expr {$i*$stop}]
+    }
+} -body {
+    variable i 5 stop 6
+    moo
+} -cleanup {
+    rename moo {}
+    unset i stop
+} -returnCodes error -result {yield can only be called in a coroutine}
+test coroutine-1.12 {proc as coroutine} -setup {
+    set body {
+	# init
+	set i    $start
+	set imax $stop
+	yield
+	while {$i < $imax} {
+	    uplevel 0 [list yield [expr {$i*$stop}]]
+	    incr i
+	}
+    }
+    proc moo {{start 0} {stop 10}} $body
+    coroutine foo moo 2 8
+} -body {
+    list [foo] [foo]
+} -cleanup {
+    unset body
+    rename moo {}
+    rename foo {}
+} -result {16 24}
+test coroutine-1.13 {subst as coroutine: literal} {
+    list [coroutine foo eval {subst {>>[yield a],[yield b]<<}}] [foo x] [foo y]
+} {a b >>x,y<<}
+test coroutine-1.14 {subst as coroutine: in variable} {
+    set pattern {>>[yield c],[yield d]<<}
+    list [coroutine foo eval {subst $pattern}] [foo p] [foo q]
+} {c d >>p,q<<}
+
+test coroutine-2.1 {self deletion on return} -body {
+    coroutine foo set x 3
+    foo
+} -returnCodes error -result {invalid command name "foo"}
+test coroutine-2.2 {self deletion on return} -body {
+    coroutine foo ::apply [list {} {yield; yield 1; return 2}]
+    list [foo] [foo] [catch foo msg] $msg
+} -result {1 2 1 {invalid command name "foo"}}
+test coroutine-2.3 {self deletion on error return} -body {
+    coroutine foo ::apply [list {} {yield;yield 1; error ouch!}]
+    list [foo] [catch foo msg] $msg [catch foo msg] $msg
+} -result {1 1 ouch! 1 {invalid command name "foo"}}
+test coroutine-2.4 {self deletion on other return} -body {
+    coroutine foo ::apply [list {} {yield;yield 1; return -code 100 ouch!}]
+    list [foo] [catch foo msg] $msg [catch foo msg] $msg
+} -result {1 100 ouch! 1 {invalid command name "foo"}}
+test coroutine-2.5 {deletion of suspended coroutine} -body {
+    coroutine foo ::apply [list {} {yield; yield 1; return 2}]
+    list [foo] [rename foo {}] [catch foo msg] $msg
+} -result {1 {} 1 {invalid command name "foo"}}
+test coroutine-2.6 {deletion of running coroutine} -body {
+    coroutine foo ::apply [list {} {yield; rename foo {}; yield 1; return 2}]
+    list [foo] [catch foo msg] $msg
+} -result {1 1 {invalid command name "foo"}}
+
+test coroutine-3.1 {info level computation} -setup {
+    proc a {} {while 1 {yield [info level]}}
+    proc b {} foo
+} -body {
+    # note that coroutines execute in uplevel #0
+    set l0 [coroutine foo a]
+    set l1 [foo]
+    set l2 [b]
+    list $l0 $l1 $l2
+} -cleanup {
+    rename a {}
+    rename b {}
+} -result {1 1 1}
+test coroutine-3.2 {info frame computation} -setup {
+    proc a {} {while 1 {yield [info frame]}}
+    proc b {} foo
+} -body {
+    set l0 [coroutine foo a]
+    set l1 [foo]
+    set l2 [b]
+    expr {$l2 - $l1}
+} -cleanup {
+    rename a {}
+    rename b {}
+} -result 1
+test coroutine-3.3 {info coroutine} -setup {
+    proc a {} {info coroutine}
+    proc b {} a
+} -body {
+    b
+} -cleanup {
+    rename a {}
+    rename b {}
+} -result {}
+test coroutine-3.4 {info coroutine} -setup {
+    proc a {} {info coroutine}
+    proc b {} a
+} -body {
+    coroutine foo b
+} -cleanup {
+    rename a {}
+    rename b {}
+} -result ::foo
+test coroutine-3.5 {info coroutine} -setup {
+    proc a {} {info coroutine}
+    proc b {} {rename [info coroutine] {}; a}
+} -body {
+    coroutine foo b
+} -cleanup {
+    rename a {}
+    rename b {}
+} -result {}
+test coroutine-3.6 {info frame, bug #2910094} -setup {
+    proc stack {} {
+	set res [list "LEVEL:[set lev [info frame]]"]
+	for {set i 1} {$i < $lev} {incr i} {
+	    lappend res [info frame $i]
+	}
+	set res
+	# the precise command depends on line numbers and such, is likely not
+	# to be stable: just check that the test completes!
+	return
+    }
+    proc a {} stack
+} -body {
+    coroutine aa a
+} -cleanup {
+    rename stack {}
+    rename a {}
+} -result {}
+test coroutine-3.7 {bug 0b874c344d} {
+    dict get [coroutine X coroutine Y info frame 0] cmd
+} {coroutine X coroutine Y info frame 0}
+
+test coroutine-4.1 {bug #2093188} -setup {
+    proc foo {} {
+	set v 1
+	trace add variable v {write unset} bar
+	yield
+	set v 2
+	yield
+	set v 3
+    }
+    proc bar args {lappend ::res $args}
+    coroutine a foo
+} -body {
+    list [a] [a] $::res
+} -cleanup {
+    rename foo {}
+    rename bar {}
+    unset ::res
+} -result {{} 3 {{v {} write} {v {} write} {v {} unset}}}
+test coroutine-4.2 {bug #2093188} -setup {
+    proc foo {} {
+	set v 1
+	trace add variable v {read unset} bar
+	yield
+	set v 2
+	set v
+	yield
+	set v 3
+    }
+    proc bar args {lappend ::res $args}
+    coroutine a foo
+} -body {
+    list [a] [a] $::res
+} -cleanup {
+    rename foo {}
+    rename bar {}
+    unset ::res
+} -result {{} 3 {{v {} read} {v {} unset}}}
+
+test coroutine-4.3 {bug #2093947} -setup {
+    proc foo {} {
+	set v 1
+	trace add variable v {write unset} bar
+	yield
+	set v 2
+	yield
+	set v 3
+    }
+    proc bar args {lappend ::res $args}
+} -body {
+    coroutine a foo
+    a
+    a
+    coroutine a foo
+    a
+    rename a {}
+    set ::res
+} -cleanup {
+    rename foo {}
+    rename bar {}
+    unset ::res
+} -result {{v {} write} {v {} write} {v {} unset} {v {} write} {v {} unset}}
+
+test coroutine-4.4 {bug #2917627: cmd resolution} -setup {
+    proc a {} {return global}
+    namespace eval b {proc a {} {return local}}
+} -body {
+    namespace eval b {coroutine foo a}
+} -cleanup {
+    rename a {}
+    namespace delete b
+} -result local
+
+test coroutine-4.5 {bug #2724403} -constraints {memory} \
+-setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+} -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	set ns ::y$i
+	namespace eval $ns {}
+	proc ${ns}::start {} {yield; puts hello}
+	coroutine ${ns}::run ${ns}::start
+	namespace delete $ns
+	set start $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $start}]
+} -cleanup {
+    rename getbytes {}
+    unset i ns start end
+} -result 0
+
+test coroutine-4.6 {compile context, bug #3282869} -setup {
+    unset -nocomplain ::x
+    proc f x {
+	coroutine D eval {yield X$x;yield Y}
+    }
+} -body {
+    f 12
+} -cleanup {
+    rename f {}
+} -returnCodes error -match glob -result {can't read *}
+
+test coroutine-4.7 {compile context, bug #3282869} -setup {
+    proc f x {
+	coroutine D eval {yield X$x;yield Y$x}
+    }
+} -body {
+    set ::x 15
+    set ::x [f 12]
+    D
+} -cleanup {
+    D
+    unset ::x
+    rename f {}
+} -result YX15
+
+test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels} \
+-setup {
+    proc nestedYield {{val {}}} {
+	yield $val
+    }
+    proc getNumLevel {} {
+	# remove the level for this proc's call
+	expr {[lindex [testnrelevels] 1] - 1}
+    }
+    proc relativeLevel base {
+	# remove the level for this proc's call	
+	expr {[getNumLevel] - $base - 1}
+    }
+    proc foo {} {
+	while 1 {
+	    nestedYield
+	}
+    }
+    set res {}
+} -body {
+    set base [getNumLevel]
+    lappend res [relativeLevel $base]
+    eval {coroutine a foo}
+    # back to base level
+    lappend res [relativeLevel $base]
+    a
+    lappend res [relativeLevel $base]
+    eval a
+    lappend res [relativeLevel $base]
+    eval {eval a}
+    lappend res [relativeLevel $base]
+    rename a {}
+    lappend res [relativeLevel $base]
+    set res
+} -cleanup {
+    rename foo {}
+    rename nestedYield {}
+    rename getNumLevel {}
+    rename relativeLevel {}
+    unset res
+} -result {0 0 0 0 0 0}
+test coroutine-5.2 {right numLevels within coro} -constraints {testnrelevels} \
+-setup {
+    proc nestedYield {{val {}}} {
+	yield $val
+    }
+    proc getNumLevel {} {
+	# remove the level for this proc's call
+	expr {[lindex [testnrelevels] 1] - 1}
+    }
+    proc relativeLevel base {
+	# remove the level for this proc's call	
+	expr {[getNumLevel] - $base - 1}
+    }
+    proc foo base {
+	while 1 {
+	    set base [nestedYield [relativeLevel $base]]
+	}
+    }
+    set res {}
+} -body {
+    lappend res [eval {coroutine a foo [getNumLevel]}]
+    lappend res [a [getNumLevel]]
+    lappend res [eval {a [getNumLevel]}]
+    lappend res [eval {eval {a [getNumLevel]}}]
+    set base [lindex $res 0]
+    foreach x $res[set res {}] {
+	lappend res [expr {$x-$base}]
+    }
+    set res
+} -cleanup {
+    rename a {}
+    rename foo {}
+    rename nestedYield {}
+    rename getNumLevel {}
+    rename relativeLevel {}
+    unset res
+} -result {0 0 0 0}
+
+test coroutine-6.1 {coroutine nargs} -body {
+    coroutine a ::apply $lambda
+    a
+} -cleanup {
+    rename a {}
+} -result 0
+test coroutine-6.2 {coroutine nargs} -body {
+    coroutine a ::apply $lambda
+    a a
+} -cleanup {
+    rename a {}
+} -result 0
+test coroutine-6.3 {coroutine nargs} -body {
+    coroutine a ::apply $lambda
+    a a a
+} -cleanup {
+    rename a {}
+} -returnCodes error -result {wrong # args: should be "a ?arg?"}
+
+test coroutine-7.1 {yieldto} -body {
+    coroutine c apply {{} {
+	yield
+	yieldto return -level 0 -code 1 quux
+	return quuy
+    }}
+    set res [list [catch c msg] $msg]
+    lappend res [catch c msg] $msg
+    lappend res [catch c msg] $msg
+} -cleanup {
+    unset res
+} -result [list 1 quux 0 quuy 1 {invalid command name "c"}]
+test coroutine-7.2 {multi-argument yielding with yieldto} -body {
+    proc corobody {} {
+	set a 1
+	while 1 {
+	    set a [yield $a]
+	    set a [yieldto return -level 0 $a]
+	    lappend a [llength $a]
+	}
+    }
+    coroutine a corobody
+    coroutine b corobody
+    list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \
+	[b ok] [rename b {}] 
+} -cleanup {
+    rename corobody {}
+} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}}
+test coroutine-7.3 {yielding between coroutines} -body {
+    proc juggler {target {value ""}} {
+	if {$value eq ""} {
+	    set value [yield [info coroutine]]
+	}
+	while {[llength $value]} {
+	    lappend ::result $value [info coroutine]
+	    set value [lrange $value 0 end-1]
+	    lassign [yieldto $target $value] value
+	}
+	# Clear nested collection of coroutines
+	catch $target
+    }
+    set result ""
+    coroutine j1 juggler [coroutine j2 juggler [coroutine j3 juggler j1]]\
+	{a b c d e}
+    list $result [info command j1] [info command j2] [info command j3]
+} -cleanup {
+    catch {rename juggler ""}
+} -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}}
+test coroutine-7.4 {Bug 8ff0cb9fe1} -setup {
+    proc foo {a b} {catch yield; return 1}
+} -cleanup {
+    rename foo {}
+} -body {
+    coroutine demo lsort -command foo {a b}
+} -result {b a}
+test coroutine-7.5 {return codes} {
+    set result {}
+    foreach code {0 1 2 3 4 5} {
+	lappend result [catch {coroutine demo return -level 0 -code $code}]
+    }
+    set result
+} {0 1 2 3 4 5}
+test coroutine-7.6 {Early yield crashes} {
+    proc foo args {}
+    trace add execution foo enter {catch yield}
+    coroutine demo foo
+    rename foo {}
+} {}
+test coroutine-7.7 {Bug 2486550} -setup {
+    interp hide {} yield
+} -body {
+    coroutine demo interp invokehidden {} yield ok
+} -cleanup {
+    demo
+    interp expose {} yield
+} -result ok
+test coroutine-7.8 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	yieldto ::return -level 0 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    namespace delete cotest
+    namespace eval cotest {}
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.9 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	set y ::yieldto
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	$y ::return -level 0 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    namespace delete cotest
+    namespace eval cotest {}
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.10 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	yieldto ::return -level 0 -cotest [namespace delete ::cotest] 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
+    namespace eval cotest {}
+    set ::result ""
+} -body {
+    proc cotest::body {} {
+	set y ::yieldto
+	lappend ::result a
+	yield OUT
+	lappend ::result b
+	$y ::return -level 0 -cotest [namespace delete ::cotest] 123
+	lappend ::result c
+	return
+    }
+    lappend ::result [coroutine cotest cotest::body]
+    lappend ::result [cotest]
+    cotest
+    return $result
+} -returnCodes error -cleanup {
+    catch {namespace delete ::cotest}
+    catch {rename cotest ""}
+} -result {yieldto called in deleted namespace}
+
+
+# cleanup
+unset lambda
+::tcltest::cleanupTests
+
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/dcall.test b/tests/dcall.test
index 55f6731..41dd777 100644
--- a/tests/dcall.test
+++ b/tests/dcall.test
@@ -10,13 +10,12 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: dcall.test,v 1.6 2004/05/19 10:54:20 dkf Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testdcall [llength [info commands testdcall]]
 
@@ -40,5 +39,5 @@ test dcall-1.6 {deletion callbacks} testdcall {
 } {}
 
 # cleanup
-::tcltest::cleanupTests
+cleanupTests
 return
diff --git a/tests/dict.test b/tests/dict.test
index 090142e..a583de8 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -1,15 +1,13 @@
-# This test file covers the dictionary object type and the dict
-# command used to work with values of that type.
+# This test file covers the dictionary object type and the dict command used
+# to work with values of that type.
 #
-# 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) 2003 Donal K. Fellows
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: dict.test,v 1.13 2005/07/21 21:49:08 dkf Exp $
+# Copyright (c) 2003-2009 Donal K. Fellows
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -18,27 +16,24 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 
 # Used for constraining memory leak tests
 testConstraint memory [llength [info commands memory]]
-
-# Procedure to help check the contents of a dictionary.  Note that we
-# can't just compare the string version because the order of the
-# elements is (deliberately) not defined.  This is because it is
-# dependent on the underlying hash table implementation and also
-# potentially on the history of the value itself.  Net result: you
-# cannot safely assume anything about the ordering of values.
-proc getOrder {dictVal args} {
-    foreach key $args {
-	lappend result $key [dict get $dictVal $key]
+if {[testConstraint memory]} {
+    proc memtest script {
+	set end [lindex [split [memory info] \n] 3 3]
+	for {set i 0} {$i < 5} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [lindex [split [memory info] \n] 3 3]
+	}
+	expr {$end - $tmp}
     }
-    lappend result [dict size $dictVal]
-    return $result
 }
-
-test dict-1.1 {dict command basic syntax} {
-    list [catch {dict} msg] $msg
-} {1 {wrong # args: should be "dict subcommand ?arg ...?"}}
-test dict-1.2 {dict command basic syntax} {
-    list [catch {dict ?} msg] $msg
-} {1 {bad subcommand "?": must be append, create, exists, filter, for, get, incr, info, keys, lappend, merge, remove, replace, set, size, unset, update, values, or with}}
+
+test dict-1.1 {dict command basic syntax} -returnCodes error -body {
+    dict
+} -result {wrong # args: should be "dict subcommand ?arg ...?"}
+test dict-1.2 {dict command basic syntax} -returnCodes error -body {
+    dict ?
+} -match glob -result {unknown or ambiguous subcommand "?": must be *}
 
 test dict-2.1 {dict create command} {
     dict create
@@ -46,7 +41,7 @@ test dict-2.1 {dict create command} {
 test dict-2.2 {dict create command} {
     dict create a b
 } {a b}
-test dict-2.3 {dict create command} {
+test dict-2.3 {dict create command} -body {
     set result {}
     set dict [dict create a b c d]
     # Can't compare directly as ordering of values is undefined
@@ -57,87 +52,119 @@ test dict-2.3 {dict create command} {
 	}
 	lappend result [lindex $dict [expr {$idx+1}]]
     }
-    set result
-} {b d}
-test dict-2.4 {dict create command} {
-    list [catch {dict create a} msg] $msg
-} {1 {wrong # args: should be "dict create ?key value ...?"}}
-test dict-2.5 {dict create command} {
-    list [catch {dict create a b c} msg] $msg
-} {1 {wrong # args: should be "dict create ?key value ...?"}}
-test dict-2.6 {dict create command - initialse refcount field!} {
+    return $result
+} -cleanup {
+    unset result dict key idx
+} -result {b d}
+test dict-2.4 {dict create command} -returnCodes error -body {
+    dict create a
+} -result {wrong # args: should be "dict create ?key value ...?"}
+test dict-2.5 {dict create command} -returnCodes error -body {
+    dict create a b c
+} -result {wrong # args: should be "dict create ?key value ...?"}
+test dict-2.6 {dict create command - initialse refcount field!} -body {
     # Bug 715751 will show up in memory debuggers like purify
     for {set i 0} {$i<10} {incr i} {
 	set dictv [dict create a 0]
 	set share [dict values $dictv]
 	list [dict incr dictv a]
     }
-} {}
+} -cleanup {
+    unset i dictv share
+} -result {}
 test dict-2.7 {dict create command - #-quoting in string rep} {
     dict create # #comment
 } {{#} #comment}
 test dict-2.8 {dict create command - #-quoting in string rep} -body {
     dict create #a x #b x
 } -match glob -result {{#?} x #? x}
+test dict-2.9 {dict create command: compilation} {
+    apply {{} {dict create [format a] b}}
+} {a b}
+test dict-2.10 {dict create command: compilation} {
+    apply {{} {dict create [format a] b c d}}
+} {a b c d}
+test dict-2.11 {dict create command: compilation} {
+    apply {{} {dict create [format a] b c d a x}}
+} {a x c d}
+test dict-2.12 {dict create command: non-compilation} {
+    dict create [format a] b
+} {a b}
+test dict-2.13 {dict create command: non-compilation} {
+    dict create [format a] b c d
+} {a b c d}
+test dict-2.14 {dict create command: non-compilation} {
+    dict create [format a] b c d a x
+} {a x c d}
 
 test dict-3.1 {dict get command} {dict get {a b} a} b
 test dict-3.2 {dict get command} {dict get {a b c d} a} b
 test dict-3.3 {dict get command} {dict get {a b c d} c} d
-test dict-3.4 {dict get command} {
-    list [catch {dict get {a b c d} b} msg] $msg
-} {1 {key "b" not known in dictionary}}
+test dict-3.4 {dict get command} -returnCodes error -body {
+    dict get {a b c d} b
+} -result {key "b" not known in dictionary}
 test dict-3.5 {dict get command} {dict get {a {p q r s} b {u v x y}} a p} q
 test dict-3.6 {dict get command} {dict get {a {p q r s} b {u v x y}} a r} s
 test dict-3.7 {dict get command} {dict get {a {p q r s} b {u v x y}} b u} v
 test dict-3.8 {dict get command} {dict get {a {p q r s} b {u v x y}} b x} y
-test dict-3.9 {dict get command} {
-    list [catch {dict get {a {p q r s} b {u v x y}} a z} msg] $msg
-} {1 {key "z" not known in dictionary}}
-test dict-3.10 {dict get command} {
-    list [catch {dict get {a {p q r s} b {u v x y}} c z} msg] $msg
-} {1 {key "c" not known in dictionary}}
+test dict-3.9 {dict get command} -returnCodes error -body {
+    dict get {a {p q r s} b {u v x y}} a z
+} -result {key "z" not known in dictionary}
+test dict-3.10 {dict get command} -returnCodes error -body {
+    dict get {a {p q r s} b {u v x y}} c z
+} -result {key "c" not known in dictionary}
 test dict-3.11 {dict get command} {dict get [dict create a b c d] a} b
-test dict-3.12 {dict get command} {
-    list [catch {dict get} msg] $msg
-} {1 {wrong # args: should be "dict get dictionary ?key key ...?"}}
-test dict-3.13 {dict get command} {
+test dict-3.12 {dict get command} -returnCodes error -body {
+    dict get
+} -result {wrong # args: should be "dict get dictionary ?key ...?"}
+test dict-3.13 {dict get command} -body {
     set dict [dict get {a b c d}]
     if {$dict eq "a b c d"} {
-	subst OK
+	return OK
     } elseif {$dict eq "c d a b"} {
-	subst OK
+	return reordered
     } else {
-	set dict
+	return $dict
     }
-} OK
-test dict-3.14 {dict get command} {
-    list [catch {dict get {a b c d} a c} msg] $msg
-} {1 {missing value to go with key}}
+} -cleanup {
+    unset dict
+} -result OK
+test dict-3.14 {dict get command} -returnCodes error -body {
+    dict get {a b c d} a c
+} -result {missing value to go with key}
+test dict-3.15 {compiled dict get error cleanliness - Bug 2431847} -body {
+    apply {{} {
+	dict set a(z) b c
+	dict get $a(z) d
+    }}
+} -returnCodes error -result {key "d" not known in dictionary}
+test dict-3.16 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;set l} {p 1 p 2 q 3}
+test dict-3.17 {dict/list shimmering - Bug 3004007} {set l [list p 1 p 2 q 3];dict get $l q;llength $l} 6
 
 test dict-4.1 {dict replace command} {
-    getOrder [dict replace {a b c d}] a c
-} {a b c d 2}
+    dict replace {a b c d}
+} {a b c d}
 test dict-4.2 {dict replace command} {
-    getOrder [dict replace {a b c d} e f] a c e
-} {a b c d e f 3}
+    dict replace {a b c d} e f
+} {a b c d e f}
 test dict-4.3 {dict replace command} {
-    getOrder [dict replace {a b c d} c f] a c
-} {a b c f 2}
+    dict replace {a b c d} c f
+} {a b c f}
 test dict-4.4 {dict replace command} {
-    getOrder [dict replace {a b c d} c x a y] a c
-} {a y c x 2}
-test dict-4.5 {dict replace command} {
-    list [catch {dict replace} msg] $msg
-} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
-test dict-4.6 {dict replace command} {
-    list [catch {dict replace {a a} a} msg] $msg
-} {1 {wrong # args: should be "dict replace dictionary ?key value ...?"}}
-test dict-4.7 {dict replace command} {
-    list [catch {dict replace {a a a} a b} msg] $msg
-} {1 {missing value to go with key}}
-test dict-4.8 {dict replace command} {
-    list [catch {dict replace [list a a a] a b} msg] $msg
-} {1 {missing value to go with key}}
+    dict replace {a b c d} c x a y
+} {a y c x}
+test dict-4.5 {dict replace command} -returnCodes error -body {
+    dict replace
+} -result {wrong # args: should be "dict replace dictionary ?key value ...?"}
+test dict-4.6 {dict replace command} -returnCodes error -body {
+    dict replace {a a} a
+} -result {wrong # args: should be "dict replace dictionary ?key value ...?"}
+test dict-4.7 {dict replace command} -returnCodes error -body {
+    dict replace {a a a} a b
+} -result {missing value to go with key}
+test dict-4.8 {dict replace command} -returnCodes error -body {
+    dict replace [list a a a] a b
+} -result {missing value to go with key}
 test dict-4.9 {dict replace command} {dict replace [list a a] a b} {a b}
 test dict-4.10 {dict replace command} {dict replace [list a a] a b a c} {a c}
 
@@ -146,12 +173,12 @@ test dict-5.2 {dict remove command} {dict remove {a b c d} c} {a b}
 test dict-5.3 {dict remove command} {dict remove {a b c d} a c} {}
 test dict-5.4 {dict remove command} {dict remove {a b c d} c a} {}
 test dict-5.5 {dict remove command} {
-    getOrder [dict remove {a b c d}] a c
-} {a b c d 2}
+    dict remove {a b c d}
+} {a b c d}
 test dict-5.6 {dict remove command} {dict remove {a b} c} {a b}
-test dict-5.7 {dict remove command} {
-    list [catch {dict remove} msg] $msg
-} {1 {wrong # args: should be "dict remove dictionary ?key ...?"}}
+test dict-5.7 {dict remove command} -returnCodes error -body {
+    dict remove
+} -result {wrong # args: should be "dict remove dictionary ?key ...?"}
 
 test dict-6.1 {dict keys command} {dict keys {a b}} a
 test dict-6.2 {dict keys command} {dict keys {c d}} c
@@ -160,15 +187,15 @@ test dict-6.4 {dict keys command} {dict keys {a b c d} a} a
 test dict-6.5 {dict keys command} {dict keys {a b c d} c} c
 test dict-6.6 {dict keys command} {dict keys {a b c d} e} {}
 test dict-6.7 {dict keys command} {lsort [dict keys {a b c d ca da} c*]} {c ca}
-test dict-6.8 {dict keys command} {
-    list [catch {dict keys} msg] $msg
-} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
-test dict-6.9 {dict keys command} {
-    list [catch {dict keys {} a b} msg] $msg
-} {1 {wrong # args: should be "dict keys dictionary ?pattern?"}}
-test dict-6.10 {dict keys command} {
-    list [catch {dict keys a} msg] $msg
-} {1 {missing value to go with key}}
+test dict-6.8 {dict keys command} -returnCodes error -body {
+    dict keys
+} -result {wrong # args: should be "dict keys dictionary ?pattern?"}
+test dict-6.9 {dict keys command} -returnCodes error -body {
+    dict keys {} a b
+} -result {wrong # args: should be "dict keys dictionary ?pattern?"}
+test dict-6.10 {dict keys command} -returnCodes error -body {
+    dict keys a
+} -result {missing value to go with key}
 
 test dict-7.1 {dict values command} {dict values {a b}} b
 test dict-7.2 {dict values command} {dict values {c d}} d
@@ -177,259 +204,332 @@ test dict-7.4 {dict values command} {dict values {a b c d} b} b
 test dict-7.5 {dict values command} {dict values {a b c d} d} d
 test dict-7.6 {dict values command} {dict values {a b c d} e} {}
 test dict-7.7 {dict values command} {lsort [dict values {a b c d ca da} d*]} {d da}
-test dict-7.8 {dict values command} {
-    list [catch {dict values} msg] $msg
-} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
-test dict-7.9 {dict values command} {
-    list [catch {dict values {} a b} msg] $msg
-} {1 {wrong # args: should be "dict values dictionary ?pattern?"}}
-test dict-7.10 {dict values command} {
-    list [catch {dict values a} msg] $msg
-} {1 {missing value to go with key}}
+test dict-7.8 {dict values command} -returnCodes error -body {
+    dict values
+} -result {wrong # args: should be "dict values dictionary ?pattern?"}
+test dict-7.9 {dict values command} -returnCodes error -body {
+    dict values {} a b
+} -result {wrong # args: should be "dict values dictionary ?pattern?"}
+test dict-7.10 {dict values command} -returnCodes error -body {
+    dict values a
+} -result {missing value to go with key}
 
 test dict-8.1 {dict size command} {dict size {}} 0
 test dict-8.2 {dict size command} {dict size {a b}} 1
 test dict-8.3 {dict size command} {dict size {a b c d}} 2
-test dict-8.4 {dict size command} {
-    list [catch {dict size} msg] $msg
-} {1 {wrong # args: should be "dict size dictionary"}}
-test dict-8.5 {dict size command} {
-    list [catch {dict size a b} msg] $msg
-} {1 {wrong # args: should be "dict size dictionary"}}
-test dict-8.6 {dict size command} {
-    list [catch {dict size a} msg] $msg
-} {1 {missing value to go with key}}
+test dict-8.4 {dict size command} -returnCodes error -body {
+    dict size
+} -result {wrong # args: should be "dict size dictionary"}
+test dict-8.5 {dict size command} -returnCodes error -body {
+    dict size a b
+} -result {wrong # args: should be "dict size dictionary"}
+test dict-8.6 {dict size command} -returnCodes error -body {
+    dict size a
+} -result {missing value to go with key}
 
 test dict-9.1 {dict exists command} {dict exists {a b} a} 1
 test dict-9.2 {dict exists command} {dict exists {a b} b} 0
 test dict-9.3 {dict exists command} {dict exists {a {b c}} a b} 1
 test dict-9.4 {dict exists command} {dict exists {a {b c}} a c} 0
 test dict-9.5 {dict exists command} {dict exists {a {b c}} b c} 0
-test dict-9.6 {dict exists command} {
-    list [catch {dict exists {a {b c d}} a c} msg] $msg
-} {1 {missing value to go with key}}
-test dict-9.7 {dict exists command} {
-    list [catch {dict exists} msg] $msg
-} {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}}
-test dict-9.8 {dict exists command} {
-    list [catch {dict exists {}} msg] $msg
-} {1 {wrong # args: should be "dict exists dictionary key ?key ...?"}}
+test dict-9.6 {dict exists command} {dict exists {a {b c d}} a c} 0
+test dict-9.7 {dict exists command} -returnCodes error -body {
+    dict exists
+} -result {wrong # args: should be "dict exists dictionary key ?key ...?"}
+test dict-9.8 {dict exists command} -returnCodes error -body {
+    dict exists {}
+} -result {wrong # args: should be "dict exists dictionary key ?key ...?"}
 
-test dict-10.1 {dict info command} {
+test dict-10.1 {dict info command} -body {
     # Actual string returned by this command is undefined; it is
     # intended for human consumption and not for use by scripts.
     dict info {}
-    subst {}
-} {}
-test dict-10.2 {dict info command} {
-    list [catch {dict info} msg] $msg
-} {1 {wrong # args: should be "dict info dictionary"}}
-test dict-10.3 {dict info command} {
-    list [catch {dict info {} x} msg] $msg
-} {1 {wrong # args: should be "dict info dictionary"}}
-test dict-10.4 {dict info command} {
-    list [catch {dict info x} msg] $msg
-} {1 {missing value to go with key}}
+} -match glob -result *
+test dict-10.2 {dict info command} -returnCodes error -body {
+    dict info
+} -result {wrong # args: should be "dict info dictionary"}
+test dict-10.3 {dict info command} -returnCodes error -body {
+    dict info {} x
+} -result {wrong # args: should be "dict info dictionary"}
+test dict-10.4 {dict info command} -returnCodes error -body {
+    dict info x
+} -result {missing value to go with key}
 
-test dict-11.1 {dict incr command: unshared value} {
+test dict-11.1 {dict incr command: unshared value} -body {
     set dictv [dict create \
 	    a [string index "=0=" 1] \
 	    b [expr {1+2}] \
 	    c [expr {wide(0x80000000)+1}]]
-    getOrder [dict incr dictv a] a b c
-} {a 1 b 3 c 2147483649 3}
-test dict-11.2 {dict incr command: unshared value} {
+    dict incr dictv a
+} -cleanup {
+    unset dictv
+} -result {a 1 b 3 c 2147483649}
+test dict-11.2 {dict incr command: unshared value} -body {
     set dictv [dict create \
 	    a [string index "=0=" 1] \
 	    b [expr {1+2}] \
 	    c [expr {wide(0x80000000)+1}]]
-    getOrder [dict incr dictv b] a b c
-} {a 0 b 4 c 2147483649 3}
-test dict-11.3 {dict incr command: unshared value} {
+    dict incr dictv b
+} -cleanup {
+    unset dictv
+} -result {a 0 b 4 c 2147483649}
+test dict-11.3 {dict incr command: unshared value} -body {
     set dictv [dict create \
 	    a [string index "=0=" 1] \
 	    b [expr {1+2}] \
 	    c [expr {wide(0x80000000)+1}]]
-    getOrder [dict incr dictv c] a b c
-} {a 0 b 3 c 2147483650 3}
-test dict-11.4 {dict incr command: shared value} {
+    dict incr dictv c
+} -cleanup {
+    unset dictv
+} -result {a 0 b 3 c 2147483650}
+test dict-11.4 {dict incr command: shared value} -body {
     set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
     set sharing [dict values $dictv]
-    getOrder [dict incr dictv a] a b c
-} {a 1 b 3 c 2147483649 3}
-test dict-11.5 {dict incr command: shared value} {
+    dict incr dictv a
+} -cleanup {
+    unset dictv sharing
+} -result {a 1 b 3 c 2147483649}
+test dict-11.5 {dict incr command: shared value} -body {
     set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
     set sharing [dict values $dictv]
-    getOrder [dict incr dictv b] a b c
-} {a 0 b 4 c 2147483649 3}
-test dict-11.6 {dict incr command: shared value} {
+    dict incr dictv b
+} -cleanup {
+    unset dictv sharing
+} -result {a 0 b 4 c 2147483649}
+test dict-11.6 {dict incr command: shared value} -body {
     set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
     set sharing [dict values $dictv]
-    getOrder [dict incr dictv c] a b c
-} {a 0 b 3 c 2147483650 3}
-test dict-11.7 {dict incr command: unknown values} {
+    dict incr dictv c
+} -cleanup {
+    unset dictv sharing
+} -result {a 0 b 3 c 2147483650}
+test dict-11.7 {dict incr command: unknown values} -body {
     set dictv [dict create a 0 b [expr {1+2}] c [expr {wide(0x80000000)+1}]]
-    getOrder [dict incr dictv d] a b c d
-} {a 0 b 3 c 2147483649 d 1 4}
-test dict-11.8 {dict incr command} {
+    dict incr dictv d
+} -cleanup {
+    unset dictv
+} -result {a 0 b 3 c 2147483649 d 1}
+test dict-11.8 {dict incr command} -body {
     set dictv {a 1}
     dict incr dictv a 2
-} {a 3}
-test dict-11.9 {dict incr command} {
+} -cleanup {
+    unset dictv
+} -result {a 3}
+test dict-11.9 {dict incr command} -returnCodes error -body {
     set dictv {a dummy}
-    list [catch {dict incr dictv a} msg] $msg
-} {1 {expected integer but got "dummy"}}
-test dict-11.10 {dict incr command} {
+    dict incr dictv a
+} -cleanup {
+    unset dictv
+} -result {expected integer but got "dummy"}
+test dict-11.10 {dict incr command} -returnCodes error -body {
     set dictv {a 1}
-    list [catch {dict incr dictv a dummy} msg] $msg
-} {1 {expected integer but got "dummy"}}
-test dict-11.11 {dict incr command} {
-    catch {unset dictv}
+    dict incr dictv a dummy
+} -cleanup {
+    unset dictv
+} -result {expected integer but got "dummy"}
+test dict-11.11 {dict incr command} -setup {
+    unset -nocomplain dictv
+} -body {
     dict incr dictv a
-} {a 1}
-test dict-11.12 {dict incr command} {
+} -cleanup {
+    unset dictv
+} -result {a 1}
+test dict-11.12 {dict incr command} -returnCodes error -body {
     set dictv a
-    list [catch {dict incr dictv a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-11.13 {dict incr command} {
+    dict incr dictv a
+} -cleanup {
+    unset dictv
+} -result {missing value to go with key}
+test dict-11.13 {dict incr command} -returnCodes error -body {
     set dictv a
-    list [catch {dict incr dictv a a a} msg] $msg
-} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
-test dict-11.14 {dict incr command} {
+    dict incr dictv a a a
+} -cleanup {
+    unset dictv
+} -result {wrong # args: should be "dict incr varName key ?increment?"}
+test dict-11.14 {dict incr command} -returnCodes error -body {
     set dictv a
-    list [catch {dict incr dictv} msg] $msg
-} {1 {wrong # args: should be "dict incr varName key ?increment?"}}
-test dict-11.15 {dict incr command: write failure} {
-    catch {unset dictVar}
+    dict incr dictv
+} -cleanup {
+    unset dictv
+} -result {wrong # args: should be "dict incr varName key ?increment?"}
+test dict-11.15 {dict incr command: write failure} -setup {
+    unset -nocomplain dictVar
+} -body {
     set dictVar(block) {}
-    set result [list [catch {dict incr dictVar a} msg] $msg]
-    catch {unset dictVar}
-    set result
-} {1 {can't set "dictVar": variable is array}}
+    dict incr dictVar a
+} -returnCodes error -cleanup {
+    unset dictVar
+} -result {can't set "dictVar": variable is array}
 test dict-11.16 {dict incr command: compilation} {
-    proc dicttest {} {
+    apply {{} {
 	set v {a 0 b 0 c 0}
 	dict incr v a
 	dict incr v b 1
 	dict incr v c 2
 	dict incr v d 3
 	list [dict get $v a] [dict get $v b] [dict get $v c] [dict get $v d]
-    }
-    dicttest
+    }}
 } {1 1 2 3}
+test dict-11.17 {dict incr command: compilation} {
+    apply {{} {
+	set dictv {a 1}
+	dict incr dictv a 2
+    }}
+} {a 3}
 
-test dict-12.1 {dict lappend command} {
+test dict-12.1 {dict lappend command} -body {
     set dictv {a a}
     dict lappend dictv a
-} {a a}
-test dict-12.2 {dict lappend command} {
+} -cleanup {
+    unset dictv
+} -result {a a}
+test dict-12.2 {dict lappend command} -body {
     set dictv {a a}
     set sharing [dict values $dictv]
     dict lappend dictv a b
-} {a {a b}}
-test dict-12.3 {dict lappend command} {
+} -cleanup {
+    unset dictv sharing
+} -result {a {a b}}
+test dict-12.3 {dict lappend command} -body {
     set dictv {a a}
     dict lappend dictv a b c
-} {a {a b c}}
-test dict-12.2.1 {dict lappend command} {
+} -cleanup {
+    unset dictv
+} -result {a {a b c}}
+test dict-12.2.1 {dict lappend command} -body {
     set dictv [dict create a [string index =a= 1]]
     dict lappend dictv a b
-} {a {a b}}
-test dict-12.4 {dict lappend command} {
+} -cleanup {
+    unset dictv
+} -result {a {a b}}
+test dict-12.4 {dict lappend command} -body {
     set dictv {}
     dict lappend dictv a x y z
-} {a {x y z}}
-test dict-12.5 {dict lappend command} {
-    catch {unset dictv}
+} -cleanup {
+    unset dictv
+} -result {a {x y z}}
+test dict-12.5 {dict lappend command} -body {
+    unset -nocomplain dictv
     dict lappend dictv a b
-} {a b}
-test dict-12.6 {dict lappend command} {
+} -cleanup {
+    unset dictv
+} -result {a b}
+test dict-12.6 {dict lappend command} -returnCodes error -body {
     set dictv a
-    list [catch {dict lappend dictv a a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-12.7 {dict lappend command} {
-    list [catch {dict lappend} msg] $msg
-} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
-test dict-12.8 {dict lappend command} {
-    list [catch {dict lappend dictv} msg] $msg
-} {1 {wrong # args: should be "dict lappend varName key ?value ...?"}}
-test dict-12.9 {dict lappend command} {
+    dict lappend dictv a a
+} -cleanup {
+    unset dictv
+} -result {missing value to go with key}
+test dict-12.7 {dict lappend command} -returnCodes error -body {
+    dict lappend
+} -result {wrong # args: should be "dict lappend varName key ?value ...?"}
+test dict-12.8 {dict lappend command} -returnCodes error -body {
+    dict lappend dictv
+} -result {wrong # args: should be "dict lappend varName key ?value ...?"}
+test dict-12.9 {dict lappend command} -returnCodes error -body {
     set dictv [dict create a "\{"]
-    list [catch {dict lappend dictv a a} msg] $msg
-} {1 {unmatched open brace in list}}
-test dict-12.10 {dict lappend command: write failure} {
-    catch {unset dictVar}
+    dict lappend dictv a a
+} -cleanup {
+    unset dictv
+} -result {unmatched open brace in list}
+test dict-12.10 {dict lappend command: write failure} -setup {
+    unset -nocomplain dictVar
+} -body {
     set dictVar(block) {}
-    set result [list [catch {dict lappend dictVar a x} msg] $msg]
-    catch {unset dictVar}
-    set result
-} {1 {can't set "dictVar": variable is array}}
+    dict lappend dictVar a x
+} -returnCodes error -cleanup {
+    unset dictVar
+} -result {can't set "dictVar": variable is array}
+test dict-12.11 {compiled dict append: invalidate string rep - Bug 3079830} {
+    apply {{} {set d {a 1 b 2 c 3}; dict lappend d b 22}}
+} {a 1 b {2 22} c 3}
 
-test dict-13.1 {dict append command} {
+test dict-13.1 {dict append command} -body {
     set dictv {a a}
     dict append dictv a
-} {a a}
-test dict-13.2 {dict append command} {
+} -cleanup {
+    unset dictv
+} -result {a a}
+test dict-13.2 {dict append command} -body {
     set dictv {a a}
     set sharing [dict values $dictv]
     dict append dictv a b
-} {a ab}
-test dict-13.3 {dict append command} {
+} -cleanup {
+    unset dictv sharing
+} -result {a ab}
+test dict-13.3 {dict append command} -body {
     set dictv {a a}
     dict append dictv a b c
-} {a abc}
-test dict-13.2.1 {dict append command} {
+} -cleanup {
+    unset dictv
+} -result {a abc}
+test dict-13.2.1 {dict append command} -body {
     set dictv [dict create a [string index =a= 1]]
     dict append dictv a b
-} {a ab}
-test dict-13.4 {dict append command} {
+} -cleanup {
+    unset dictv
+} -result {a ab}
+test dict-13.4 {dict append command} -body {
     set dictv {}
     dict append dictv a x y z
-} {a xyz}
-test dict-13.5 {dict append command} {
-    catch {unset dictv}
+} -cleanup {
+    unset dictv
+} -result {a xyz}
+test dict-13.5 {dict append command} -body {
+    unset -nocomplain dictv
     dict append dictv a b
-} {a b}
-test dict-13.6 {dict append command} {
+} -cleanup {
+    unset dictv
+} -result {a b}
+test dict-13.6 {dict append command} -returnCodes error -body {
     set dictv a
-    list [catch {dict append dictv a a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-13.7 {dict append command} {
-    list [catch {dict append} msg] $msg
-} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
-test dict-13.8 {dict append command} {
-    list [catch {dict append dictv} msg] $msg
-} {1 {wrong # args: should be "dict append varName key ?value ...?"}}
-test dict-13.9 {dict append command: write failure} {
-    catch {unset dictVar}
+    dict append dictv a a
+} -cleanup {
+    unset dictv
+} -result {missing value to go with key}
+test dict-13.7 {dict append command} -returnCodes error -body {
+    dict append
+} -result {wrong # args: should be "dict append varName key ?value ...?"}
+test dict-13.8 {dict append command} -returnCodes error -body {
+    dict append dictv
+} -result {wrong # args: should be "dict append varName key ?value ...?"}
+test dict-13.9 {dict append command: write failure} -setup {
+    unset -nocomplain dictVar
+} -body {
     set dictVar(block) {}
-    set result [list [catch {dict append dictVar a x} msg] $msg]
-    catch {unset dictVar}
-    set result
-} {1 {can't set "dictVar": variable is array}}
+    dict append dictVar a x
+} -returnCodes error -cleanup {
+    unset dictVar
+} -result {can't set "dictVar": variable is array}
+test dict-13.10 {compiled dict append: crash case} {
+    apply {{} {dict append dictVar a o k}}
+} {a ok}
+test dict-13.11 {compiled dict append: invalidate string rep - Bug 3079830} {
+    apply {{} {set d {a 1 b 2 c 3}; dict append d b 22}}
+} {a 1 b 222 c 3}
 
-test dict-14.1 {dict for command: syntax} {
-    list [catch {dict for} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.2 {dict for command: syntax} {
-    list [catch {dict for x} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.3 {dict for command: syntax} {
-    list [catch {dict for x x} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.4 {dict for command: syntax} {
-    list [catch {dict for x x x x} msg] $msg
-} {1 {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}}
-test dict-14.5 {dict for command: syntax} {
-    list [catch {dict for x x x} msg] $msg
-} {1 {must have exactly two variable names}}
-test dict-14.6 {dict for command: syntax} {
-    list [catch {dict for {x x x} x x} msg] $msg
-} {1 {must have exactly two variable names}}
-test dict-14.7 {dict for command: syntax} {
-    list [catch {dict for "\{x" x x} msg] $msg
-} {1 {unmatched open brace in list}}
-test dict-14.8 {dict for command} {
+test dict-14.1 {dict for command: syntax} -returnCodes error -body {
+    dict for
+} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+test dict-14.2 {dict for command: syntax} -returnCodes error -body {
+    dict for x
+} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+test dict-14.3 {dict for command: syntax} -returnCodes error -body {
+    dict for x x
+} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+test dict-14.4 {dict for command: syntax} -returnCodes error -body {
+    dict for x x x x
+} -result {wrong # args: should be "dict for {keyVar valueVar} dictionary script"}
+test dict-14.5 {dict for command: syntax} -returnCodes error -body {
+    dict for x x x
+} -result {must have exactly two variable names}
+test dict-14.6 {dict for command: syntax} -returnCodes error -body {
+    dict for {x x x} x x
+} -result {must have exactly two variable names}
+test dict-14.7 {dict for command: syntax} -returnCodes error -body {
+    dict for "\{x" x x
+} -result {unmatched open brace in list}
+test dict-14.8 {dict for command} -body {
     # This test confirms that [dict keys], [dict values] and [dict for]
     # all traverse a dictionary in the same order.
     set dictv {a A b B c C}
@@ -443,31 +543,37 @@ test dict-14.8 {dict for command} {
 	$keys eq [dict keys $dictv] && $values eq [dict values $dictv]
     }]
     expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
-} YES
+} -cleanup {
+    unset result keys values k v dictv
+} -result YES
 test dict-14.9 {dict for command} {
     dict for {k v} {} {
 	error "unexpected execution of 'dict for' body"
     }
 } {}
-test dict-14.10 {dict for command: script results} {
+test dict-14.10 {dict for command: script results} -body {
     set times 0
     dict for {k v} {a a b b} {
 	incr times
 	continue
 	error "shouldn't get here"
     }
-    set times
-} 2
-test dict-14.11 {dict for command: script results} {
+    return $times
+} -cleanup {
+    unset times k v
+} -result 2
+test dict-14.11 {dict for command: script results} -body {
     set times 0
     dict for {k v} {a a b b} {
 	incr times
 	break
 	error "shouldn't get here"
     }
-    set times
-} 1
-test dict-14.12 {dict for command: script results} {
+    return $times
+} -cleanup {
+    unset times k v
+} -result 1
+test dict-14.12 {dict for command: script results} -body {
     set times 0
     list [catch {
 	dict for {k v} {a a b b} {
@@ -475,7 +581,9 @@ test dict-14.12 {dict for command: script results} {
 	    error test
 	}
     } msg] $msg $times $::errorInfo
-} {1 test 1 {test
+} -cleanup {
+    unset times k v msg
+} -result {1 test 1 {test
     while executing
 "error test"
     ("dict for" body line 3)
@@ -485,17 +593,15 @@ test dict-14.12 {dict for command: script results} {
 	    error test
 	}"}}
 test dict-14.13 {dict for command: script results} {
-    proc dicttest {} {
-	rename dicttest {}
+    apply {{} {
 	dict for {k v} {a b} {
 	    return ok,$k,$v
 	    error "skipped return completely"
 	}
 	error "return didn't go far enough"
-    }
-    dicttest
+    }}
 } ok,a,b
-test dict-14.14 {dict for command: handle representation loss} {
+test dict-14.14 {dict for command: handle representation loss} -body {
     set dictVar {a b c d e f g h}
     set keys {}
     set values {}
@@ -506,11 +612,14 @@ test dict-14.14 {dict for command: handle representation loss} {
 	}
     }
     list [lsort $keys] [lsort $values]
-} {{a c e g} {b d f h}}
-test dict-14.15 {dict for command: keys are unique and iterated over once only} {
-    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
-    catch {unset accum}
+} -cleanup {
+    unset dictVar keys values k v
+} -result {{a c e g} {b d f h}}
+test dict-14.15 {dict for command: keys are unique and iterated over once only} -setup {
+    unset -nocomplain accum
     array set accum {}
+} -body {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
     dict for {k v} $dictVar {
 	append accum($k) $v,
     }
@@ -519,416 +628,618 @@ test dict-14.15 {dict for command: keys are unique and iterated over once only}
     foreach k $result {
 	catch {lappend result $accum($k)}
     }
-    catch {unset accum}
-    set result
-} {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
+    return $result
+} -cleanup {
+    unset dictVar k v result accum
+} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
 test dict-14.16 {dict for command in compilation context} {
-    proc dicttest {} {
+    apply {{} {
 	set res {x x x x x x}
 	dict for {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
 	    lset res $v $k
 	    continue
 	}
 	return $res
-    }
-    dicttest
+    }}
 } {a b c d e f}
-# There's probably a lot more tests to add here.  Really ought to use
-# a coverage tool for this job...
+test dict-14.17 {dict for command in compilation context} {
+    # Bug 1379349
+    apply {{} {
+	set d [dict create a 1]		;# Dict must be unshared!
+	dict for {k v} $d {
+	    dict set d $k 0		;# Any modification will do
+	}
+	return $d
+    }}
+} {a 0}
+test dict-14.18 {dict for command in compilation context} {
+    # Bug 1382528
+    apply {{} {
+	dict for {k v} {} {}		;# Note empty dict
+	catch { error foo }		;# Note compiled [catch]
+    }}
+} 1
+test dict-14.19 {dict for and invalid dicts: bug 1531184} -body {
+    di[list]ct for {k v} x {}
+} -returnCodes 1 -result {missing value to go with key}
+test dict-14.20 {dict for stack space compilation: bug 1903325} {
+    apply {{x y args} {
+	dict for {a b} $x {}
+	concat "c=$y,$args"
+    }} {} 1 2 3
+} {c=1,2 3}
+test dict-14.21 {compiled dict for and break} {
+    apply {{} {
+	dict for {a b} {c d e f} {
+	    lappend result $a,$b
+	    break
+	}
+	return $result
+    }}
+} c,d
+test dict-14.22 {dict for and exception range depths: Bug 3614382} {
+    apply {{} {
+	dict for {a b} {c d} {
+	    dict for {e f} {g h} {
+		return 5
+	    }
+	}
+    }}
+} 5
+# There's probably a lot more tests to add here. Really ought to use a
+# coverage tool for this job...
 
-test dict-15.1 {dict set command} {
+test dict-15.1 {dict set command} -body {
     set dictVar {}
     dict set dictVar a x
-} {a x}
-test dict-15.2 {dict set command} {
+} -cleanup {
+    unset dictVar
+} -result {a x}
+test dict-15.2 {dict set command} -body {
     set dictvar {a {}}
     dict set dictvar a b x
-} {a {b x}}
-test dict-15.3 {dict set command} {
+} -cleanup {
+    unset dictvar
+} -result {a {b x}}
+test dict-15.3 {dict set command} -body {
     set dictvar {a {b {}}}
     dict set dictvar a b c x
-} {a {b {c x}}}
-test dict-15.4 {dict set command} {
+} -cleanup {
+    unset dictvar
+} -result {a {b {c x}}}
+test dict-15.4 {dict set command} -body {
     set dictVar {a y}
     dict set dictVar a x
-} {a x}
-test dict-15.5 {dict set command} {
+} -cleanup {
+    unset dictVar
+} -result {a x}
+test dict-15.5 {dict set command} -body {
     set dictVar {a {b y}}
     dict set dictVar a b x
-} {a {b x}}
-test dict-15.6 {dict set command} {
+} -cleanup {
+    unset dictVar
+} -result {a {b x}}
+test dict-15.6 {dict set command} -body {
     set dictVar {a {b {c y}}}
     dict set dictVar a b c x
-} {a {b {c x}}}
-test dict-15.7 {dict set command: path creation} {
+} -cleanup {
+    unset dictVar
+} -result {a {b {c x}}}
+test dict-15.7 {dict set command: path creation} -body {
     set dictVar {}
     dict set dictVar a b x
-} {a {b x}}
-test dict-15.8 {dict set command: creates variables} {
-    catch {unset dictVar}
+} -cleanup {
+    unset dictVar
+} -result {a {b x}}
+test dict-15.8 {dict set command: creates variables} -setup {
+    unset -nocomplain dictVar
+} -body {
     dict set dictVar a x
-    set dictVar
-} {a x}
-test dict-15.9 {dict set command: write failure} {
-    catch {unset dictVar}
+    return $dictVar
+} -cleanup {
+    unset dictVar
+} -result {a x}
+test dict-15.9 {dict set command: write failure} -setup {
+    unset -nocomplain dictVar
+} -body {
     set dictVar(block) {}
-    set result [list [catch {dict set dictVar a x} msg] $msg]
-    catch {unset dictVar}
-    set result
-} {1 {can't set "dictVar": variable is array}}
-test dict-15.10 {dict set command: syntax} {
-    list [catch {dict set} msg] $msg
-} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
-test dict-15.11 {dict set command: syntax} {
-    list [catch {dict set a} msg] $msg
-} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
-test dict-15.12 {dict set command: syntax} {
-    list [catch {dict set a a} msg] $msg
-} {1 {wrong # args: should be "dict set varName key ?key ...? value"}}
-test dict-15.13 {dict set command} {
+    dict set dictVar a x
+} -returnCodes error -cleanup {
+    unset dictVar
+} -result {can't set "dictVar": variable is array}
+test dict-15.10 {dict set command: syntax} -returnCodes error -body {
+    dict set
+} -result {wrong # args: should be "dict set varName key ?key ...? value"}
+test dict-15.11 {dict set command: syntax} -returnCodes error -body {
+    dict set a
+} -result {wrong # args: should be "dict set varName key ?key ...? value"}
+test dict-15.12 {dict set command: syntax} -returnCodes error -body {
+    dict set a a
+} -result {wrong # args: should be "dict set varName key ?key ...? value"}
+test dict-15.13 {dict set command} -returnCodes error -body {
     set dictVar a
-    list [catch {dict set dictVar b c} msg] $msg
-} {1 {missing value to go with key}}
+    dict set dictVar b c
+} -cleanup {
+    unset dictVar
+} -result {missing value to go with key}
 
-test dict-16.1 {dict unset command} {
+test dict-16.1 {dict unset command} -body {
     set dictVar {a b c d}
     dict unset dictVar a
-} {c d}
-test dict-16.2 {dict unset command} {
+} -cleanup {
+    unset dictVar
+} -result {c d}
+test dict-16.2 {dict unset command} -body {
     set dictVar {a b c d}
     dict unset dictVar c
-} {a b}
-test dict-16.3 {dict unset command} {
+} -cleanup {
+    unset dictVar
+} -result {a b}
+test dict-16.3 {dict unset command} -body {
     set dictVar {a b}
     dict unset dictVar c
-} {a b}
-test dict-16.4 {dict unset command} {
+} -cleanup {
+    unset dictVar
+} -result {a b}
+test dict-16.4 {dict unset command} -body {
     set dictVar {a {b c d e}}
     dict unset dictVar a b
-} {a {d e}}
-test dict-16.5 {dict unset command} {
+} -cleanup {
+    unset dictVar
+} -result {a {d e}}
+test dict-16.5 {dict unset command} -returnCodes error -body {
     set dictVar a
-    list [catch {dict unset dictVar a} msg] $msg
-} {1 {missing value to go with key}}
-test dict-16.6 {dict unset command} {
+    dict unset dictVar a
+} -cleanup {
+    unset dictVar
+} -result {missing value to go with key}
+test dict-16.6 {dict unset command} -returnCodes error -body {
     set dictVar {a b}
-    list [catch {dict unset dictVar c d} msg] $msg
-} {1 {key "c" not known in dictionary}}
-test dict-16.7 {dict unset command} {
-    catch {unset dictVar}
+    dict unset dictVar c d
+} -cleanup {
+    unset dictVar
+} -result {key "c" not known in dictionary}
+test dict-16.7 {dict unset command} -setup {
+    unset -nocomplain dictVar
+} -body {
     list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]
-} {0 {} 1}
-test dict-16.8 {dict unset command} {
-    list [catch {dict unset dictVar} msg] $msg
-} {1 {wrong # args: should be "dict unset varName key ?key ...?"}}
-test dict-16.9 {dict unset command: write failure} {
-    catch {unset dictVar}
+} -cleanup {
+    unset dictVar
+} -result {0 {} 1}
+test dict-16.8 {dict unset command} -returnCodes error -body {
+    dict unset dictVar
+} -result {wrong # args: should be "dict unset varName key ?key ...?"}
+test dict-16.9 {dict unset command: write failure} -setup {
+    unset -nocomplain dictVar
+} -body {
     set dictVar(block) {}
-    set result [list [catch {dict unset dictVar a} msg] $msg]
-    catch {unset dictVar}
-    set result
-} {1 {can't set "dictVar": variable is array}}
+    dict unset dictVar a
+} -returnCodes error -cleanup {
+    unset dictVar
+} -result {can't set "dictVar": variable is array}
+# Now test with an LVT present (i.e., the bytecoded version).
+test dict-16.10 {dict unset command} -body {
+    apply {{} {
+	set dictVar {a b c d}
+	dict unset dictVar a
+    }}
+} -result {c d}
+test dict-16.11 {dict unset command} -body {
+    apply {{} {
+	set dictVar {a b c d}
+	dict unset dictVar c
+    }}
+} -result {a b}
+test dict-16.12 {dict unset command} -body {
+    apply {{} {
+	set dictVar {a b}
+	dict unset dictVar c
+    }}
+} -result {a b}
+test dict-16.13 {dict unset command} -body {
+    apply {{} {
+	set dictVar {a {b c d e}}
+	dict unset dictVar a b
+    }}
+} -result {a {d e}}
+test dict-16.14 {dict unset command} -returnCodes error -body {
+    apply {{} {
+	set dictVar a
+	dict unset dictVar a
+    }}
+} -result {missing value to go with key}
+test dict-16.15 {dict unset command} -returnCodes error -body {
+    apply {{} {
+	set dictVar {a b}
+	dict unset dictVar c d
+    }}
+} -result {key "c" not known in dictionary}
+test dict-16.16 {dict unset command} -body {
+    apply {{} {list [info exists dictVar] [dict unset dictVar a] [info exists dictVar]}}
+} -result {0 {} 1}
+test dict-16.17 {dict unset command} -returnCodes error -body {
+    apply {{} {dict unset dictVar}}
+} -result {wrong # args: should be "dict unset varName key ?key ...?"}
+test dict-16.18 {dict unset command: write failure} -body {
+    apply {{} {
+	set dictVar(block) {}
+	dict unset dictVar a
+    }}
+} -returnCodes error -result {can't set "dictVar": variable is array}
 
-test dict-17.1 {dict filter command: key} {
+test dict-17.1 {dict filter command: key} -body {
     set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
     dict filter $dictVar key a2
-} {a2 b}
-test dict-17.2 {dict filter command: key} {
+} -cleanup {
+    unset dictVar
+} -result {a2 b}
+test dict-17.2 {dict filter command: key} -body {
     set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
     dict size [dict filter $dictVar key *]
-} 6
-test dict-17.3 {dict filter command: key} {
+} -cleanup {
+    unset dictVar
+} -result 6
+test dict-17.3 {dict filter command: key} -body {
     set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
-    getOrder [dict filter $dictVar key ???] bar foo
-} {bar foo foo bar 2}
-test dict-17.4 {dict filter command: key} {
-    list [catch {dict filter {} key} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
-test dict-17.5 {dict filter command: key} {
-    list [catch {dict filter {} key a a} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary key globPattern"}}
-test dict-17.6 {dict filter command: value} {
+    dict filter $dictVar key ???
+} -cleanup {
+    unset dictVar
+} -result {foo bar bar foo}
+test dict-17.4 {dict filter command: key - no patterns} {
+    dict filter {a b c d} key
+} {}
+test dict-17.4.1 {dict filter command: key - many patterns} {
+    dict filter {a1 a a2 b b1 c b2 d foo bar bar foo} key a? b?
+} {a1 a a2 b b1 c b2 d}
+test dict-17.5 {dict filter command: key - bad dict} -returnCodes error -body {
+    dict filter {a b c} key
+} -result {missing value to go with key}
+test dict-17.6 {dict filter command: value} -body {
     set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
     dict filter $dictVar value c
-} {b1 c}
-test dict-17.7 {dict filter command: value} {
+} -cleanup {
+    unset dictVar
+} -result {b1 c}
+test dict-17.7 {dict filter command: value} -body {
     set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
     dict size [dict filter $dictVar value *]
-} 6
-test dict-17.8 {dict filter command: value} {
+} -cleanup {
+    unset dictVar
+} -result 6
+test dict-17.8 {dict filter command: value} -body {
     set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
-    getOrder [dict filter $dictVar value ???] bar foo
-} {bar foo foo bar 2}
-test dict-17.9 {dict filter command: value} {
-    list [catch {dict filter {} value} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
-test dict-17.10 {dict filter command: value} {
-    list [catch {dict filter {} value a a} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary value globPattern"}}
-test dict-17.11 {dict filter command: script} {
+    dict filter $dictVar value ???
+} -cleanup {
+    unset dictVar
+} -result {foo bar bar foo}
+test dict-17.9 {dict filter command: value - no patterns} {
+    dict filter {a b c d} value
+} {}
+test dict-17.9.1 {dict filter command: value - many patterns} {
+    dict filter {a a1 b a2 c b1 foo bar bar foo d b2} value a? b?
+} {a a1 b a2 c b1 d b2}
+test dict-17.10 {dict filter command: value - bad dict} -body {
+    dict filter {a b c} value a
+} -returnCodes error -result {missing value to go with key}
+test dict-17.11 {dict filter command: script} -body {
     set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
     set n 0
-    list [getOrder [dict filter $dictVar script {k v} {
+    list [dict filter $dictVar script {k v} {
 	incr n
 	expr {[string length $k] == [string length $v]}
-    }] bar foo] $n
-} {{bar foo foo bar 2} 6}
-test dict-17.12 {dict filter command: script} {
-    list [catch {dict filter {a b} script {k v} {concat $k $v}} msg] $msg
-} {1 {expected boolean value but got "a b"}}
-test dict-17.13 {dict filter command: script} {
+    }] $n
+} -cleanup {
+    unset dictVar n k v
+} -result {{foo bar bar foo} 6}
+test dict-17.12 {dict filter command: script} -returnCodes error -body {
+    dict filter {a b} script {k v} {
+	concat $k $v
+    }
+} -cleanup {
+    unset k v
+} -result {expected boolean value but got "a b"}
+test dict-17.13 {dict filter command: script} -body {
     list [catch {dict filter {a b} script {k v} {error x}} msg] $msg \
 	    $::errorInfo
-} {1 x {x
+} -cleanup {
+    unset k v msg
+} -result {1 x {x
     while executing
 "error x"
     ("dict filter" script line 1)
     invoked from within
 "dict filter {a b} script {k v} {error x}"}}
-test dict-17.14 {dict filter command: script} {
+test dict-17.14 {dict filter command: script} -setup {
     set n 0
+} -body {
     list [dict filter {a b c d} script {k v} {
 	incr n
 	break
 	error boom!
     }] $n
-} {{} 1}
-test dict-17.15 {dict filter command: script} {
+} -cleanup {
+    unset n k v
+} -result {{} 1}
+test dict-17.15 {dict filter command: script} -setup {
     set n 0
+} -body {
     list [dict filter {a b c d} script {k v} {
 	incr n
 	continue
 	error boom!
     }] $n
-} {{} 2}
+} -cleanup {
+    unset n k v
+} -result {{} 2}
 test dict-17.16 {dict filter command: script} {
-    proc dicttest {} {
-	rename dicttest {}
+    apply {{} {
 	dict filter {a b} script {k v} {
 	    return ok,$k,$v
 	    error "skipped return completely"
 	}
 	error "return didn't go far enough"
-    }
-    dicttest
+    }}
 } ok,a,b
-test dict-17.17 {dict filter command: script} {
+test dict-17.17 {dict filter command: script} -body {
     dict filter {a b} script {k k} {continue}
-    set k
-} b
-test dict-17.18 {dict filter command: script} {
-    list [catch {dict filter {a b} script {k k}} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary script {keyVar valueVar} filterScript"}}
-test dict-17.19 {dict filter command: script} {
-    list [catch {dict filter {a b} script k {continue}} msg] $msg
-} {1 {must have exactly two variable names}}
-test dict-17.20 {dict filter command: script} {
-    list [catch {dict filter {a b} script "\{k v" {continue}} msg] $msg
-} {1 {unmatched open brace in list}}
-test dict-17.21 {dict filter command} {
-    list [catch {dict filter {a b}} msg] $msg
-} {1 {wrong # args: should be "dict filter dictionary filterType ..."}}
-test dict-17.22 {dict filter command} {
-    list [catch {dict filter {a b} JUNK} msg] $msg
-} {1 {bad filterType "JUNK": must be key, script, or value}}
-test dict-17.23 {dict filter command} {
-    list [catch {dict filter a key *} msg] $msg
-} {1 {missing value to go with key}}
+    return $k
+} -cleanup {
+    unset k
+} -result b
+test dict-17.18 {dict filter command: script} -returnCodes error -body {
+    dict filter {a b} script {k k}
+} -result {wrong # args: should be "dict filter dictionary script {keyVar valueVar} filterScript"}
+test dict-17.19 {dict filter command: script} -returnCodes error -body {
+    dict filter {a b} script k {continue}
+} -result {must have exactly two variable names}
+test dict-17.20 {dict filter command: script} -returnCodes error -body {
+    dict filter {a b} script "\{k v" {continue}
+} -result {unmatched open brace in list}
+test dict-17.21 {dict filter command} -returnCodes error -body {
+    dict filter {a b}
+} -result {wrong # args: should be "dict filter dictionary filterType ?arg ...?"}
+test dict-17.22 {dict filter command} -returnCodes error -body {
+    dict filter {a b} JUNK
+} -result {bad filterType "JUNK": must be key, script, or value}
+test dict-17.23 {dict filter command} -returnCodes error -body {
+    dict filter a key *
+} -result {missing value to go with key}
 
-test dict-18.1 {dict-list relationship} {
-    -body {
-        # Test that any internal conversion between list and dict
-        # does not change the object
-        set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y]
-        dict values $l
-        set l
-    }
-    -result {1 2 3 4 5 6 7 8 9 0 q w e r t y}
-}
-test dict-18.2 {dict-list relationship} {
-    -body {
-        # Test that the dictionary is a valid list
-        set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2]
-        for {set t 0} {$t < 5} {incr t} {
-            llength $d
-            dict lappend d "abc def" "\}\{"
-            dict append  d "a\{b" "\}"
-            dict incr    d "c\}d" 1
-        }
-        llength $d
+test dict-18.1 {dict-list relationship} -body {
+    # Test that any internal conversion between list and dict does not change
+    # the object
+    set l [list 1 2 3 4 5 6 7 8 9 0 q w e r t y]
+    dict values $l
+    return $l
+} -cleanup {
+    unset l
+} -result {1 2 3 4 5 6 7 8 9 0 q w e r t y}
+test dict-18.2 {dict-list relationship} -body {
+    # Test that the dictionary is a valid list
+    set d [dict create "abc def" 0 "a\{b" 1 "c\}d" 2]
+    for {set t 0} {$t < 5} {incr t} {
+	llength $d
+	dict lappend d "abc def" "\}\{"
+	dict append  d "a\{b" "\}"
+	dict incr    d "c\}d" 1
     }
-    -result 6
-}
+    llength $d
+} -cleanup {
+    unset d t
+} -result 6
+test dict-18.3 {dict-list relationship} -body {
+    set ld [list a b c d c e f g]
+    list [string length $ld] [dict size $ld] [llength $ld]
+} -cleanup {
+    unset ld
+} -result {15 3 8}
+test dict-18.4 {dict-list relationship} -body {
+    set ld [list a b c d c e f g]
+    list [llength $ld] [dict size $ld] [llength $ld]
+} -cleanup {
+    unset ld
+} -result {8 3 8}
 
 # This is a test for a specific bug.
 # It shows a bad ref counter when running with memdebug on.
-test dict-19.1 {memory bug} -setup {
-    proc xxx {} {
+test dict-19.1 {memory bug} {
+    apply {{} {
         set successors [dict create x {c d}]
         dict set successors x a b
         dict get $successors x
-    }
-} -body {
-    xxx
-} -cleanup {
-    rename xxx {}
-} -result [dict create c d a b]
-test dict-19.2 {dict: testing for leaks} -setup {
-    proc getbytes {} {
-        set lines [split [memory info] "\n"]
-        lindex [lindex $lines 3] 3
-    }
+    }}
+} [dict create c d a b]
+test dict-19.2 {dict: testing for leaks} -constraints memory -body {
     # This test is made to stress object reference management
-    proc stress {} {
-        # A shared invalid dictinary
-        set apa {a {}b c d}
-        set bepa $apa
-        catch {dict replace $apa e f}
-        catch {dict remove  $apa c d}
-        catch {dict incr    apa  a 5}
-        catch {dict lappend apa  a 5}
-        catch {dict append  apa  a 5}
-        catch {dict set     apa  a 5}
-        catch {dict unset   apa  a}
+    memtest {
+	apply {{} {
+	    # A shared invalid dictinary
+	    set apa {a {}b c d}
+	    set bepa $apa
+	    catch {dict replace $apa e f}
+	    catch {dict remove  $apa c d}
+	    catch {dict incr    apa  a 5}
+	    catch {dict lappend apa  a 5}
+	    catch {dict append  apa  a 5}
+	    catch {dict set     apa  a 5}
+	    catch {dict unset   apa  a}
 
-        # A shared valid dictionary, invalid incr
-        set apa {a b c d}
-        set bepa $apa
-        catch {dict incr bepa a 5}
+	    # A shared valid dictionary, invalid incr
+	    set apa {a b c d}
+	    set bepa $apa
+	    catch {dict incr bepa a 5}
 
-        # An error during write to an unshared object, incr
-        set apa {a 1 b 2}
-        set bepa [lrange $apa 0 end]
-        trace add variable bepa write {error hej}
-        catch {dict incr bepa a 5}
-        unset bepa
+	    # An error during write to an unshared object, incr
+	    set apa {a 1 b 2}
+	    set bepa [lrange $apa 0 end]
+	    trace add variable bepa write {error hej}
+	    catch {dict incr bepa a 5}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
 
-        # An error during write to a shared object, incr
-        set apa {a 1 b 2}
-        set bepa $apa
-        trace add variable bepa write {error hej}
-        catch {dict incr bepa a 5}
-        unset bepa
+	    # An error during write to a shared object, incr
+	    set apa {a 1 b 2}
+	    set bepa $apa
+	    trace add variable bepa write {error hej}
+	    catch {dict incr bepa a 5}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
 
-        # A shared valid dictionary, invalid lappend
-        set apa [list a {{}b} c d]
-        set bepa $apa
-        catch {dict lappend bepa a 5}
+	    # A shared valid dictionary, invalid lappend
+	    set apa [list a {{}b} c d]
+	    set bepa $apa
+	    catch {dict lappend bepa a 5}
 
-        # An error during write to an unshared object, lappend
-        set apa {a 1 b 2}
-        set bepa [lrange $apa 0 end]
-        trace add variable bepa write {error hej}
-        catch {dict lappend bepa a 5}
-        unset bepa
+	    # An error during write to an unshared object, lappend
+	    set apa {a 1 b 2}
+	    set bepa [lrange $apa 0 end]
+	    trace add variable bepa write {error hej}
+	    catch {dict lappend bepa a 5}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
 
-        # An error during write to a shared object, lappend
-        set apa {a 1 b 2}
-        set bepa $apa
-        trace add variable bepa write {error hej}
-        catch {dict lappend bepa a 5}
-        unset bepa
+	    # An error during write to a shared object, lappend
+	    set apa {a 1 b 2}
+	    set bepa $apa
+	    trace add variable bepa write {error hej}
+	    catch {dict lappend bepa a 5}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
 
-        # An error during write to an unshared object, append
-        set apa {a 1 b 2}
-        set bepa [lrange $apa 0 end]
-        trace add variable bepa write {error hej}
-        catch {dict append bepa a 5}
-        unset bepa
+	    # An error during write to an unshared object, append
+	    set apa {a 1 b 2}
+	    set bepa [lrange $apa 0 end]
+	    trace add variable bepa write {error hej}
+	    catch {dict append bepa a 5}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
 
-        # An error during write to a shared object, append
-        set apa {a 1 b 2}
-        set bepa $apa
-        trace add variable bepa write {error hej}
-        catch {dict append bepa a 5}
-        unset bepa
+	    # An error during write to a shared object, append
+	    set apa {a 1 b 2}
+	    set bepa $apa
+	    trace add variable bepa write {error hej}
+	    catch {dict append bepa a 5}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
 
-        # An error during write to an unshared object, set
-        set apa {a 1 b 2}
-        set bepa [lrange $apa 0 end]
-        trace add variable bepa write {error hej}
-        catch {dict set bepa a 5}
-        unset bepa
+	    # An error during write to an unshared object, set
+	    set apa {a 1 b 2}
+	    set bepa [lrange $apa 0 end]
+	    trace add variable bepa write {error hej}
+	    catch {dict set bepa a 5}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
 
-        # An error during write to a shared object, set
-        set apa {a 1 b 2}
-        set bepa $apa
-        trace add variable bepa write {error hej}
-        catch {dict set bepa a 5}
-        unset bepa
+	    # An error during write to a shared object, set
+	    set apa {a 1 b 2}
+	    set bepa $apa
+	    trace add variable bepa write {error hej}
+	    catch {dict set bepa a 5}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
 
-        # An error during write to an unshared object, unset
-        set apa {a 1 b 2}
-        set bepa [lrange $apa 0 end]
-        trace add variable bepa write {error hej}
-        catch {dict unset bepa a}
-        unset bepa
+	    # An error during write to an unshared object, unset
+	    set apa {a 1 b 2}
+	    set bepa [lrange $apa 0 end]
+	    trace add variable bepa write {error hej}
+	    catch {dict unset bepa a}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
 
-        # An error during write to a shared object, unset
-        set apa {a 1 b 2}
-        set bepa $apa
-        trace add variable bepa write {error hej}
-        catch {dict unset bepa a}
-        unset bepa
+	    # An error during write to a shared object, unset
+	    set apa {a 1 b 2}
+	    set bepa $apa
+	    trace add variable bepa write {error hej}
+	    catch {dict unset bepa a}
+	    trace remove variable bepa write {error hej}
+	    unset bepa
+	}}
     }
-} -constraints memory -body {
-    set end [getbytes]
-    for {set i 0} {$i < 5} {incr i} {
-        stress
-        set tmp $end
-        set end [getbytes]
+} -result 0
+test dict-19.3 {testing for leaks - Bug 2874678} -constraints memory -body {
+    set d aDictVar; # Force interpreted [dict incr]
+    memtest {
+	dict incr $d aKey 0
+	unset $d
     }
-    expr {$end - $tmp}
 } -cleanup {
-    unset -nocomplain end i tmp
-    rename getbytes {}
-    rename stress {}
+    unset d
 } -result 0
 
 test dict-20.1 {dict merge command} {
     dict merge
 } {}
 test dict-20.2 {dict merge command} {
-    getOrder [dict merge {a b c d e f}] a c e
-} {a b c d e f 3}
+    dict merge {a b c d e f}
+} {a b c d e f}
 test dict-20.3 {dict merge command} -body {
     dict merge {a b c d e}
-} -result {missing value to go with key} -returnCodes 1
+} -result {missing value to go with key} -returnCodes error
 test dict-20.4 {dict merge command} {
-    getOrder [dict merge {a b c d} {e f g h}] a c e g
-} {a b c d e f g h 4}
+    dict merge {a b c d} {e f g h}
+} {a b c d e f g h}
 test dict-20.5 {dict merge command} -body {
     dict merge {a b c d e} {e f g h}
-} -result {missing value to go with key} -returnCodes 1
+} -result {missing value to go with key} -returnCodes error
 test dict-20.6 {dict merge command} -body {
     dict merge {a b c d} {e f g h i}
-} -result {missing value to go with key} -returnCodes 1
+} -result {missing value to go with key} -returnCodes error
 test dict-20.7 {dict merge command} {
-    getOrder [dict merge {a b c d e f} {e x g h}] a c e g
-} {a b c d e x g h 4}
+    dict merge {a b c d e f} {e x g h}
+} {a b c d e x g h}
 test dict-20.8 {dict merge command} {
-    getOrder [dict merge {a b c d} {a x c y}] a c
-} {a x c y 2}
+    dict merge {a b c d} {a x c y}
+} {a x c y}
 test dict-20.9 {dict merge command} {
-    getOrder [dict merge {a b c d} {a x c y}] a c
-} {a x c y 2}
+    dict merge {a b c d} {c y a x}
+} {a x c y}
 test dict-20.10 {dict merge command} {
-    getOrder [dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}] a c e 1 3
-} {a - c d e f 1 - 3 4 5}
+    dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}
+} {a - c d e f 1 - 3 4}
+test dict-20.11 {dict merge command} {
+    apply {{} {dict merge}}
+} {}
+test dict-20.12 {dict merge command} {
+    apply {{} {dict merge {a b c d e f}}}
+} {a b c d e f}
+test dict-20.13 {dict merge command} -body {
+    apply {{} {dict merge {a b c d e}}}
+} -result {missing value to go with key} -returnCodes error
+test dict-20.14 {dict merge command} {
+    apply {{} {dict merge {a b c d} {e f g h}}}
+} {a b c d e f g h}
+test dict-20.15 {dict merge command} -body {
+    apply {{} {dict merge {a b c d e} {e f g h}}}
+} -result {missing value to go with key} -returnCodes error
+test dict-20.16 {dict merge command} -body {
+    apply {{} {dict merge {a b c d} {e f g h i}}}
+} -result {missing value to go with key} -returnCodes error
+test dict-20.17 {dict merge command} {
+    apply {{} {dict merge {a b c d e f} {e x g h}}}
+} {a b c d e x g h}
+test dict-20.18 {dict merge command} {
+    apply {{} {dict merge {a b c d} {a x c y}}}
+} {a x c y}
+test dict-20.19 {dict merge command} {
+    apply {{} {dict merge {a b c d} {c y a x}}}
+} {a x c y}
+test dict-20.20 {dict merge command} {
+    apply {{} {dict merge {a b c d e f} {a x 1 2 3 4} {a - 1 -}}}
+} {a - c d e f 1 - 3 4}
 
-test dict-21.1 {dict update command} -body {
+test dict-21.1 {dict update command} -returnCodes 1 -body {
     dict update
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.2 {dict update command} -body {
+} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+test dict-21.2 {dict update command} -returnCodes 1 -body {
     dict update v
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.3 {dict update command} -body {
+} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+test dict-21.3 {dict update command} -returnCodes 1 -body {
     dict update v k
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.4 {dict update command} -body {
+} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+test dict-21.4 {dict update command} -returnCodes 1 -body {
     dict update v k v
-} -returnCodes 1 -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
-test dict-21.5 {dict update command} {
+} -result {wrong # args: should be "dict update varName key varName ?key varName ...? script"}
+test dict-21.5 {dict update command} -body {
     set a {b c}
     set result {}
     set bb {}
@@ -936,8 +1247,10 @@ test dict-21.5 {dict update command} {
 	lappend result $a $bb
     }
     lappend result $a
-} {{b c} c {b c}}
-test dict-21.6 {dict update command} {
+} -cleanup {
+    unset a result bb
+} -result {{b c} c {b c}}
+test dict-21.6 {dict update command} -body {
     set a {b c}
     set result {}
     set bb {}
@@ -945,8 +1258,10 @@ test dict-21.6 {dict update command} {
 	lappend result $a $bb [set bb d]
     }
     lappend result $a
-} {{b c} c d {b d}}
-test dict-21.7 {dict update command} {
+} -cleanup {
+    unset a result bb
+} -result {{b c} c d {b d}}
+test dict-21.7 {dict update command} -body {
     set a {b c}
     set result {}
     set bb {}
@@ -954,44 +1269,56 @@ test dict-21.7 {dict update command} {
 	lappend result $a $bb [unset bb]
     }
     lappend result $a
-} {{b c} c {} {}}
-test dict-21.8 {dict update command} {
+} -cleanup {
+    unset a result
+} -result {{b c} c {} {}}
+test dict-21.8 {dict update command} -body {
     set a {b c d e}
     dict update a b v1 d v2 {
 	lassign "$v1 $v2" v2 v1
     }
-    getOrder $a b d
-} {b e d c 2}
-test dict-21.9 {dict update command} {
+    return $a
+} -cleanup {
+    unset a v1 v2
+} -result {b e d c}
+test dict-21.9 {dict update command} -body {
     set a {b c d e}
     dict update a b v1 d v2 {unset a}
     info exist a
-} 0
-test dict-21.10 {dict update command} {
+} -cleanup {
+    unset v1 v2
+} -result 0
+test dict-21.10 {dict update command} -body {
     set a {b {c d}}
     dict update a b v1 {
 	dict update v1 c v2 {
 	    set v2 foo
 	}
     }
-    set a
-} {b {c foo}}
-test dict-21.11 {dict update command} {
+    return $a
+} -cleanup {
+    unset a v1 v2
+} -result {b {c foo}}
+test dict-21.11 {dict update command} -body {
     set a {b c d e}
     dict update a b v1 d v2 {
 	dict set a f g
     }
-    getOrder $a b d f
-} {b c d e f g 3}
-test dict-21.12 {dict update command} {
+    return $a
+} -cleanup {
+    unset a v1 v2
+} -result {b c d e f g}
+test dict-21.12 {dict update command} -body {
     set a {b c d e}
     dict update a b v1 d v2 f v3 {
 	set v3 g
     }
-    getOrder $a b d f
-} {b c d e f g 3}
+    return $a
+} -cleanup {
+    unset a v1 v2 v3
+} -result {b c d e f g}
 test dict-21.13 {dict update command: compilation} {
-    proc dicttest {d} {
+    apply {d {
 	while 1 {
 	    dict update d a alpha b beta {
 		set beta $alpha
@@ -1000,9 +1327,52 @@ test dict-21.13 {dict update command: compilation} {
 	    }
 	}
 	return $d
+    }} {a 1 c 2}
+} {c 2 b 1}
+test dict-21.14 {dict update command: compilation} {
+    apply {x {
+	set indices {2 3}
+	trace add variable aa write "string length \$indices ;#"
+	dict update x k aa l bb {}
+    }} {k 1 l 2}
+} {}
+test dict-21.15 {dict update command: compilation} {
+    apply {x {
+	set indices {2 3}
+	trace add variable aa read "string length \$indices ;#"
+	dict update x k aa l bb {}
+    }} {k 1 l 2}
+} {}
+test dict-21.16 {dict update command: no recursive structures [Bug 1786481]} -body {
+    set foo {a {b {c {d {e 1}}}}}
+    dict update foo a t {
+	dict update t b t {
+	    dict update t c t {
+		dict update t d t {
+		    dict incr t e
+		}
+	    }
+	}
     }
-    getOrder [dicttest {a 1 c 2}] b c
-} {b 1 c 2 2}
+    string range [append foo OK] end-1 end
+} -cleanup {
+    unset foo t
+} -result OK
+test dict-21.17 {dict update command: no recursive structures [Bug 1786481]} {
+    apply {{} {
+	set foo {a {b {c {d {e 1}}}}}
+	dict update foo a t {
+	    dict update t b t {
+		dict update t c t {
+		    dict update t d t {
+			dict incr t e
+		    }
+		}
+	    }
+	}
+	string range [append foo OK] end-1 end
+    }}
+} OK
 
 test dict-22.1 {dict with command} -body {
     dict with
@@ -1014,53 +1384,65 @@ test dict-22.3 {dict with command} -body {
     unset -nocomplain v
     dict with v {error "in body"}
 } -returnCodes 1 -result {can't read "v": no such variable}
-test dict-22.4 {dict with command} {
+test dict-22.4 {dict with command} -body {
     set a {b c d e}
     unset -nocomplain b d
     set result [list [info exist b] [info exist d]]
     dict with a {
 	lappend result [info exist b] [info exist d] $b $d
     }
-    set result
-} {0 0 1 1 c e}
-test dict-22.5 {dict with command} {
+    return $result
+} -cleanup {
+    unset a b d result
+} -result {0 0 1 1 c e}
+test dict-22.5 {dict with command} -body {
     set a {b c d e}
     dict with a {
 	lassign "$b $d" d b
     }
-    getOrder $a b d
-} {b e d c 2}
-test dict-22.6 {dict with command} {
+    return $a
+} -cleanup {
+    unset a b d
+} -result {b e d c}
+test dict-22.6 {dict with command} -body {
     set a {b c d e}
     dict with a {
 	unset b
 	# This *won't* go into the dict...
 	set f g
     }
-    set a
-} {d e}
-test dict-22.7 {dict with command} {
+    return $a
+} -cleanup {
+    unset a d f
+} -result {d e}
+test dict-22.7 {dict with command} -body {
     set a {b c d e}
     dict with a {
 	dict unset a b
     }
-    getOrder $a b d
-} {b c d e 2}
-test dict-22.8 {dict with command} {
+    return $a
+} -cleanup {
+    unset a
+} -result {d e b c}
+test dict-22.8 {dict with command} -body {
     set a [dict create b c]
     dict with a {
 	set b $a
     }
-    set a
-} {b {b c}}
-test dict-22.9 {dict with command} {
+    return $a
+} -cleanup {
+    unset a b
+} -result {b {b c}}
+test dict-22.9 {dict with command} -body {
     set a {b {c d}}
     dict with a b {
 	set c $c$c
     }
-    set a
-} {b {c dd}}
-test dict-22.10 {dict with command: result handling tricky case} {
+    return $a
+} -cleanup {
+    unset a c
+} -result {b {c dd}}
+test dict-22.10 {dict with command: result handling tricky case} -body {
     set a {b {c d}}
     foreach i {0 1} {
 	if {$i} break
@@ -1071,8 +1453,523 @@ test dict-22.10 {dict with command: result handling tricky case} {
 	}
     }
     list $i $a
-} {0 {}}
+} -cleanup {
+    unset a i c
+} -result {0 {}}
+test dict-22.11 {dict with command: no recursive structures [Bug 1786481]} -body {
+    set foo {t {t {t {inner 1}}}}
+    dict with foo {
+	dict with t {
+	    dict with t {
+		dict with t {
+		    incr inner
+		}
+	    }
+	}
+    }
+    string range [append foo OK] end-1 end
+} -cleanup {
+    unset foo t inner
+} -result OK
+test dict-22.12 {dict with: compiled} {
+    apply {{} {
+	set d {a 1 b 2}
+	list [dict with d {
+	    set a $b
+	    unset b
+	    dict set d c 3
+	    list ok
+	}] $d
+    }}
+} {ok {a 2 c 3}}
+test dict-22.13 {dict with: compiled} {
+    apply {i {
+	set d($i) {a 1 b 2}
+	list [dict with d($i) {
+	    set a $b
+	    unset b
+	    dict set d($i) c 3
+	    list ok
+	}] [array get d]
+    }} e
+} {ok {e {a 2 c 3}}}
+test dict-22.14 {dict with: compiled} {
+    apply {{} {
+	set d {a 1 b 2}
+	foreach x {1 2 3} {
+	    dict with d {
+		incr a $b
+		if {$x == 2} break
+	    }
+	    unset a b
+	}
+	list $a $b $x $d
+    }}
+} {5 2 2 {a 5 b 2}}
+test dict-22.15 {dict with: compiled} {
+    apply {i {
+	set d($i) {a 1 b 2}
+	foreach x {1 2 3} {
+	    dict with d($i) {
+		incr a $b
+		if {$x == 2} break
+	    }
+	    unset a b
+	}
+	list $a $b $x [array get d]
+    }} e
+} {5 2 2 {e {a 5 b 2}}}
+test dict-22.16 {dict with: compiled} {
+    apply {{} {
+	set d {p {q {a 1 b 2}}}
+	dict with d p q {
+	    set a $b.$a
+	}
+	return $d
+    }}
+} {p {q {a 2.1 b 2}}}
+test dict-22.17 {dict with: compiled} {
+    apply {i {
+	set d($i) {p {q {a 1 b 2}}}
+	dict with d($i) p q {
+	    set a $b.$a
+	}
+	array get d
+    }} e
+} {e {p {q {a 2.1 b 2}}}}
+test dict-22.18 {dict with: compiled} {
+    set ::d {a 1 b 2}
+    apply {{} {
+	dict with ::d {
+	    set a $b.$a
+	}
+	return $::d
+    }}
+} {a 2.1 b 2}
+test dict-22.19 {dict with: compiled} {
+    set ::d {p {q {r {a 1 b 2}}}}
+    apply {{} {
+	dict with ::d p q r {
+	    set a $b.$a
+	}
+	return $::d
+    }}
+} {p {q {r {a 2.1 b 2}}}}
+test dict-22.20 {dict with: compiled} {
+    apply {d {
+	dict with d {
+	}
+	return $a,$b
+    }} {a 1 b 2}
+} 1,2
+test dict-22.21 {dict with: compiled} {
+    apply {d {
+	dict with d p q {
+	}
+	return $a,$b
+    }} {p {q {a 1 b 2}}}
+} 1,2
+test dict-22.22 {dict with: compiled} {
+    set ::d {a 1 b 2}
+    apply {{} {
+	dict with ::d {
+	}
+	return $a,$b
+    }}
+} 1,2
+test dict-22.23 {dict with: compiled} {
+    set ::d {p {q {a 1 b 2}}}
+    apply {{} {
+	dict with ::d p q {
+	}
+	return $a,$b
+    }}
+} 1,2
+
+proc linenumber {} {
+    dict get [info frame -1] line
+}
+test dict-23.1 {dict compilation crash: Bug 3487626} {
+    apply {{} {apply {n {
+	set e {}
+	set k {}
+	dict for {a b} {c {d {e {f g}}}} {
+	    ::tcl::dict::for {h i} $b {
+		dict update i e j {
+		    ::tcl::dict::update j f k {
+			return [expr {$n - [linenumber]}]
+		    }
+		}
+	    }
+	}
+    }} [linenumber]}}
+} 5
+test dict-23.2 {dict compilation crash: Bug 3487626} {
+    # Something isn't quite right in line number and continuation line
+    # tracking; at time of writing, this test produces 7, not 5, which
+    # indicates that the extra newlines in the non-script argument are
+    # confusing things.
+    apply {{} {apply {n {
+	set e {}
+	set k {}
+	dict for {a {
+b
+}} {c {d {e {f g}}}} {
+	    ::tcl::dict::for {h {
+i
+}} ${
+b
+} {
+		dict update {
+i
+} e {
+j
+} {
+		    ::tcl::dict::update {
+j
+} f k {
+			return [expr {$n - [linenumber]}]
+		    }
+		}
+	    }
+	}
+    }} [linenumber]}}
+} 5
+rename linenumber {}
+
+test dict-24.1 {dict map command: syntax} -returnCodes error -body {
+    dict map
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.2 {dict map command: syntax} -returnCodes error -body {
+    dict map x
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.3 {dict map command: syntax} -returnCodes error -body {
+    dict map x x
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.4 {dict map command: syntax} -returnCodes error -body {
+    dict map x x x x
+} -result {wrong # args: should be "dict map {keyVar valueVar} dictionary script"}
+test dict-24.5 {dict map command: syntax} -returnCodes error -body {
+    dict map x x x
+} -result {must have exactly two variable names}
+test dict-24.6 {dict map command: syntax} -returnCodes error -body {
+    dict map {x x x} x x
+} -result {must have exactly two variable names}
+test dict-24.7 {dict map command: syntax} -returnCodes error -body {
+    dict map "\{x" x x
+} -result {unmatched open brace in list}
+test dict-24.8 {dict map command} -setup {
+    set values {}
+    set keys {}
+} -body {
+    # This test confirms that [dict keys], [dict values] and [dict map]
+    # all traverse a dictionary in the same order.
+    set dictv {a A b B c C}
+    dict map {k v} $dictv {
+	lappend keys $k
+	lappend values $v
+    }
+    set result [expr {
+	$keys eq [dict keys $dictv] && $values eq [dict values $dictv]
+    }]
+    expr {$result ? "YES" : [list "NO" $dictv $keys $values]}
+} -cleanup {
+    unset result keys values k v dictv
+} -result YES
+test dict-24.9 {dict map command} {
+    dict map {k v} {} {
+	error "unexpected execution of 'dict map' body"
+    }
+} {}
+test dict-24.10 {dict map command: script results} -body {
+    set times 0
+    dict map {k v} {a a b b} {
+	incr times
+	continue
+	error "shouldn't get here"
+    }
+    return $times
+} -cleanup {
+    unset times k v
+} -result 2
+test dict-24.11 {dict map command: script results} -body {
+    set times 0
+    dict map {k v} {a a b b} {
+	incr times
+	break
+	error "shouldn't get here"
+    }
+    return $times
+} -cleanup {
+    unset times k v
+} -result 1
+test dict-24.12 {dict map command: script results} -body {
+    set times 0
+    list [catch {
+	dict map {k v} {a a b b} {
+	    incr times
+	    error test
+	}
+    } msg] $msg $times $::errorInfo
+} -cleanup {
+    unset times k v msg
+} -result {1 test 1 {test
+    while executing
+"error test"
+    ("dict map" body line 3)
+    invoked from within
+"dict map {k v} {a a b b} {
+	    incr times
+	    error test
+	}"}}
+test dict-24.13 {dict map command: script results} {
+    apply {{} {
+	dict map {k v} {a b} {
+	    return ok,$k,$v
+	    error "skipped return completely"
+	}
+	error "return didn't go far enough"
+    }}
+} ok,a,b
+test dict-24.14 {dict map command: handle representation loss} -setup {
+    set keys {}
+    set values {}
+} -body {
+    set dictVar {a b c d e f g h}
+    list [dict size [dict map {k v} $dictVar {
+	if {[llength $dictVar]} {
+	    lappend keys $k
+	    lappend values $v
+	    return -level 0 $k
+	}
+    }]] [lsort $keys] [lsort $values]
+} -cleanup {
+    unset dictVar keys values k v
+} -result {4 {a c e g} {b d f h}}
+test dict-24.14a {dict map command: handle representation loss} -body {
+    apply {{} {
+	set dictVar {a b c d e f g h}
+	list [dict size [dict map {k v} $dictVar {
+	    if {[llength $dictVar]} {
+		lappend keys $k
+		lappend values $v
+		return -level 0 $k
+	    }
+	}]] [lsort $keys] [lsort $values]
+    }}
+} -result {4 {a c e g} {b d f h}}
+test dict-24.15 {dict map command: keys are unique and iterated over once only} -setup {
+    unset -nocomplain accum
+    array set accum {}
+} -body {
+    set dictVar {a1 a a2 b b1 c b2 d foo bar bar foo}
+    dict map {k v} $dictVar {
+	append accum($k) $v,
+    }
+    set result [lsort [array names accum]]
+    lappend result :
+    foreach k $result {
+	catch {lappend result $accum($k)}
+    }
+    return $result
+} -cleanup {
+    unset dictVar k v result accum
+} -result {a1 a2 b1 b2 bar foo : a, b, c, d, foo, bar,}
+test dict-24.16 {dict map command in compilation context} {
+    apply {{} {
+	set res {x x x x x x}
+	dict map {k v} {a 0 b 1 c 2 d 3 e 4 f 5} {
+	    lset res $v $k
+	    continue
+	}
+	return $res
+    }}
+} {a b c d e f}
+test dict-24.17 {dict map command in compilation context} {
+    # Bug 1379349 (dict for)
+    apply {{} {
+	set d [dict create a 1]		;# Dict must be unshared!
+	dict map {k v} $d {
+	    dict set d $k 0		;# Any modification will do
+	}
+	return $d
+    }}
+} {a 0}
+test dict-24.17a {dict map command in compilation context} {
+    # Bug 1379349 (dict for)
+    apply {{} {
+	set d [dict create a 1]		;# Dict must be unshared!
+	dict map {k v} $d {
+	    dict set d $k 0		;# Any modification will do
+	}
+    }}
+} {a {a 0}}
+test dict-24.18 {dict map command in compilation context} {
+    # Bug 1382528 (dict for)
+    apply {{} {
+	dict map {k v} {} {}		;# Note empty dict
+	catch { error foo }		;# Note compiled [catch]
+    }}
+} 1
+test dict-24.19 {dict map and invalid dicts: 'dict for' bug 1531184} -body {
+    di[list]ct map {k v} x {}
+} -returnCodes 1 -result {missing value to go with key}
+test dict-24.20 {dict map stack space compilation: 'dict for' bug 1903325} {
+    apply {{x y args} {
+	dict map {a b} $x {}
+	concat "c=$y,$args"
+    }} {} 1 2 3
+} {c=1,2 3}
+proc linenumber {} {
+    dict get [info frame -1] line
+}
+test dict-24.20.1 {dict compilation crash: 'dict for' bug 3487626} {
+    apply {{} {apply {n {
+	set e {}
+	set k {}
+	dict map {a b} {c {d {e {f g}}}} {
+	    ::tcl::dict::map {h i} $b {
+		dict update i e j {
+		    ::tcl::dict::update j f k {
+			return [expr {$n - [linenumber]}]
+		    }
+		}
+	    }
+	}
+    }} [linenumber]}}
+} 5
+test dict-24.21 {dict compilation crash: 'dict for' bug 3487626} {
+    apply {{} {apply {n {
+	set e {}
+	set k {}
+	dict map {a {
+b
+}} {c {d {e {f g}}}} {
+	    ::tcl::dict::map {h {
+i
+}} ${
+b
+} {
+		dict update {
+i
+} e {
+j
+} {
+		    ::tcl::dict::update {
+j
+} f k {
+			return [expr {$n - [linenumber]}]
+		    }
+		}
+	    }
+	}
+    }} [linenumber]}}
+} 5
+test dict-23.3 {CompileWord OBOE} {
+    # segfault when buggy
+    apply {{} {tcl::dict::lappend foo bar \
+	[format baz]}}
+} {bar baz}
+test dict-23.4 {CompileWord OBOE} {
+    apply {n {
+	dict set foo {*}{
+	} [return [incr n -[linenumber]]] val
+    }} [linenumber]
+} 1
+test dict-23.5 {CompileWord OBOE} {
+    # segfault when buggy
+    apply {{} {tcl::dict::incr foo \
+	[format bar]}}
+} {bar 1}
+test dict-23.6 {CompileWord OBOE} {
+    apply {n {
+	dict get {a b} {*}{
+	} [return [incr n -[linenumber]]]
+    }} [linenumber]
+} 1
+test dict-23.7 {CompileWord OBOE} {
+    apply {n {
+	dict for {a b} [return [incr n -[linenumber]]] {*}{
+	} {}
+    }} [linenumber]
+} 2
+test dict-23.8 {CompileWord OBOE} {
+    apply {n {
+	dict update foo {*}{
+	} [return [incr n -[linenumber]]] x {}
+    }} [linenumber]
+} 1
+test dict-23.9 {CompileWord OBOE} {
+    apply {n {
+	dict exists {} {*}{
+	} [return [incr n -[linenumber]]]
+    }} [linenumber]
+} 1
+test dict-23.10 {CompileWord OBOE} {
+    apply {n {
+	dict with foo {*}{
+	} [return [incr n -[linenumber]]] {}
+    }} [linenumber]
+} 1
+test dict-23.11 {CompileWord OBOE} {
+    apply {n {
+	dict with ::foo {*}{
+	} [return [incr n -[linenumber]]] {}
+    }} [linenumber]
+} 1
+test dict-23.12 {CompileWord OBOE} {
+    apply {n {
+	dict with {*}{
+	} [return [incr n -[linenumber]]] {}
+    }} [linenumber]
+} 1
+test dict-23.13 {CompileWord OBOE} {
+    apply {n {
+	dict with {*}{
+	} [return [incr n -[linenumber]]] {bar}
+    }} [linenumber]
+} 1
+test dict-23.14 {CompileWord OBOE} {
+    apply {n {
+	dict with foo {*}{
+	} [return [incr n -[linenumber]]] {bar}
+    }} [linenumber]
+} 1
+
+rename linenumber {}
+test dict-24.22 {dict map results (non-compiled)} {
+    dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
+	return -level 0 "$k,$v"
+    }
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.23 {dict map results (compiled)} {
+    apply {{} {
+	dict map {k v} [dict map {k v} {a 1 b 2 c 3 d 4} { list $v $k }] {
+	    return -level 0 "$k,$v"
+	}
+    }}
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.23a {dict map results (compiled)} {
+    apply {{list} {
+	dict map {k v} [dict map {k v} $list { list $v $k }] {
+	    return -level 0 "$k,$v"
+	}
+    }} {a 1 b 2 c 3 d 4}
+} {a {a,1 a} b {b,2 b} c {c,3 c} d {d,4 d}}
+test dict-24.24 {dict map with huge dict (non-compiled)} {
+    tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat 100000 x] x] {
+	expr { $k * $v }
+    }]
+} 166666666600000
+test dict-24.25 {dict map with huge dict (compiled)} {
+    apply {{n} {
+	tcl::mathop::+ {*}[dict map {k v} [lsearch -all [lrepeat $n y] y] {
+	    expr { $k * $v }
+	}]
+    }} 100000
+} 166666666600000
 
+
 # cleanup
 ::tcltest::cleanupTests
 return
diff --git a/tests/dstring.test b/tests/dstring.test
index 033e29e..06121a3 100644
--- a/tests/dstring.test
+++ b/tests/dstring.test
@@ -1,44 +1,57 @@
 # Commands covered:  none
 #
-# This file contains a collection of tests for Tcl's dynamic string
-# library procedures.  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 Tcl's dynamic string library
+# procedures. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
 #
 # Copyright (c) 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.
-#
-# RCS: @(#) $Id: dstring.test,v 1.8 2004/06/24 10:34:12 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
-testConstraint testdstring [llength [info commands testdstring]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
-test dstring-1.1 {appending and retrieving} testdstring {
+testConstraint testdstring [llength [info commands testdstring]]
+if {[testConstraint testdstring]} {
+    testdstring free
+}
+
+test dstring-1.1 {appending and retrieving} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "abc" -1
     list [testdstring get] [testdstring length]
-} {abc 3}
-test dstring-1.2 {appending and retrieving} testdstring {
+} -cleanup {
     testdstring free
+} -result {abc 3}
+test dstring-1.2 {appending and retrieving} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append "abc" -1
     testdstring append " xyzzy" 3
     testdstring append " 12345" -1
     list [testdstring get] [testdstring length]
-} {{abc xy 12345} 12}
-test dstring-1.3 {appending and retrieving} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{abc xy 12345} 12}
+test dstring-1.3 {appending and retrieving} -constraints testdstring -setup {
     testdstring free
+} -body {
     foreach l {a b c d e f g h i j k l m n o p} {
 	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
     }
     list [testdstring get] [testdstring length]
-} {{aaaaaaaaaaaaaaaaaaaaa
+} -cleanup {
+    testdstring free
+} -result {{aaaaaaaaaaaaaaaaaaaaa
 bbbbbbbbbbbbbbbbbbbbb
 ccccccccccccccccccccc
 ddddddddddddddddddddd
@@ -56,101 +69,143 @@ ooooooooooooooooooooo
 ppppppppppppppppppppp
 } 352}
 
-test dstring-2.1 {appending list elements} testdstring {
+test dstring-2.1 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring element "abc"
     testdstring element "d e f"
     list [testdstring get] [testdstring length]
-} {{abc {d e f}} 11}
-test dstring-2.2 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result {{abc {d e f}} 11}
+test dstring-2.2 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring element "x"
     testdstring element "\{"
     testdstring element "ab\}"
     testdstring get
-} {x \{ ab\}}
-test dstring-2.3 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {x \{ ab\}}
+test dstring-2.3 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     foreach l {a b c d e f g h i j k l m n o p} {
 	testdstring element $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l
     }
     testdstring get
-} {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
-test dstring-2.4 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result {aaaaaaaaaaaaaaaaaaaaa bbbbbbbbbbbbbbbbbbbbb ccccccccccccccccccccc ddddddddddddddddddddd eeeeeeeeeeeeeeeeeeeee fffffffffffffffffffff ggggggggggggggggggggg hhhhhhhhhhhhhhhhhhhhh iiiiiiiiiiiiiiiiiiiii jjjjjjjjjjjjjjjjjjjjj kkkkkkkkkkkkkkkkkkkkk lllllllllllllllllllll mmmmmmmmmmmmmmmmmmmmm nnnnnnnnnnnnnnnnnnnnn ooooooooooooooooooooo ppppppppppppppppppppp}
+test dstring-2.4 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append "a\{" -1
     testdstring element abc
     testdstring append "	\{" -1
     testdstring element xyzzy
     testdstring get
-} "a{ abc	{xyzzy"
-test dstring-2.5 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result "a{ abc	{xyzzy"
+test dstring-2.5 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append " \{" -1
     testdstring element abc
     testdstring get
-} " {abc"
-test dstring-2.6 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result " {abc"
+test dstring-2.6 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append " " -1
     testdstring element abc
     testdstring get
-} { abc}
-test dstring-2.7 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result { abc}
+test dstring-2.7 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append "\\ " -1
     testdstring element abc
     testdstring get
-} "\\  abc"
-test dstring-2.8 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result "\\  abc"
+test dstring-2.8 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "x " -1
     testdstring element abc
     testdstring get
-} {x abc}
-test dstring-2.9 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {x abc}
+test dstring-2.9 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring element #
     testdstring get
-} {{#}}
-test dstring-2.10 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result {{#}}
+test dstring-2.10 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append " " -1
     testdstring element #
     testdstring get
-} { {#}}
-test dstring-2.11 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result { {#}}
+test dstring-2.11 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append \t -1
     testdstring element #
     testdstring get
-} \t{#}
-test dstring-2.12 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result \t{#}
+test dstring-2.12 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append x -1
     testdstring element #
     testdstring get
-} {x #}
-test dstring-2.13 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {x #}
+test dstring-2.13 {appending list elements} -constraints testdstring -body {
     # This test shows lack of sophistication in Tcl_DStringAppendElement's
     # decision about whether #-quoting can be disabled.
     testdstring free
     testdstring append "x " -1
     testdstring element #
     testdstring get
-} {x {#}}
+} -cleanup {
+    testdstring free
+} -result {x {#}}
 
-test dstring-3.1 {nested sublists} testdstring {
+test dstring-3.1 {nested sublists} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring start
     testdstring element foo
     testdstring element bar
     testdstring end
     testdstring element another
     testdstring get
-} {{foo bar} another}
-test dstring-3.2 {nested sublists} testdstring {
+} -cleanup {
     testdstring free
+} -result {{foo bar} another}
+test dstring-3.2 {nested sublists} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring start
     testdstring start
     testdstring element abc
@@ -159,9 +214,12 @@ test dstring-3.2 {nested sublists} testdstring {
     testdstring end
     testdstring element ghi
     testdstring get
-} {{{abc def}} ghi}
-test dstring-3.3 {nested sublists} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{{abc def}} ghi}
+test dstring-3.3 {nested sublists} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring start
     testdstring start
     testdstring start
@@ -173,9 +231,12 @@ test dstring-3.3 {nested sublists} testdstring {
     testdstring end
     testdstring element foo4
     testdstring get
-} {{{{foo foo2}} foo3} foo4}
-test dstring-3.4 {nested sublists} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{{{foo foo2}} foo3} foo4}
+test dstring-3.4 {nested sublists} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring element before
     testdstring start
     testdstring element during
@@ -183,52 +244,69 @@ test dstring-3.4 {nested sublists} testdstring {
     testdstring end
     testdstring element last
     testdstring get
-} {before {during more} last}
-test dstring-3.5 {nested sublists} testdstring {
+} -cleanup {
     testdstring free
+} -result {before {during more} last}
+test dstring-3.5 {nested sublists} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring element "\{"
     testdstring start
     testdstring element first
     testdstring element second
     testdstring end
     testdstring get
-} {\{ {first second}}
-test dstring-3.6 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {\{ {first second}}
+test dstring-3.6 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append x -1
     testdstring start
     testdstring element #
     testdstring end
     testdstring get
-} {x {{#}}}
-test dstring-3.7 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {x {{#}}}
+test dstring-3.7 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append x -1
     testdstring start
     testdstring append " " -1
     testdstring element #
     testdstring end
     testdstring get
-} {x { {#}}}
-test dstring-3.8 {appending list elements} testdstring {
+} -cleanup {
     testdstring free
+} -result {x { {#}}}
+test dstring-3.8 {appending list elements} -constraints testdstring -setup {
+    testdstring free
+} -body {
     testdstring append x -1
     testdstring start
     testdstring append \t -1
     testdstring element #
     testdstring end
     testdstring get
-} "x {\t{#}}"
-test dstring-3.9 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result "x {\t{#}}"
+test dstring-3.9 {appending list elements} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append x -1
     testdstring start
     testdstring append x -1
     testdstring element #
     testdstring end
     testdstring get
-} {x {x #}}
-test dstring-3.10 {appending list elements} testdstring {
+} -cleanup {
+    testdstring free
+} -result {x {x #}}
+test dstring-3.10 {appending list elements} -constraints testdstring -body {
     # This test shows lack of sophistication in Tcl_DStringAppendElement's
     # decision about whether #-quoting can be disabled.
     testdstring free
@@ -238,36 +316,50 @@ test dstring-3.10 {appending list elements} testdstring {
     testdstring element #
     testdstring end
     testdstring get
-} {x {x {#}}}
+} -cleanup {
+    testdstring free
+} -result {x {x {#}}}
 
-test dstring-4.1 {truncation} testdstring {
+test dstring-4.1 {truncation} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "abcdefg" -1
     testdstring trunc 3
     list [testdstring get] [testdstring length]
-} {abc 3}
-test dstring-4.2 {truncation} testdstring {
+} -cleanup {
+    testdstring free
+} -result {abc 3}
+test dstring-4.2 {truncation} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append "xyzzy" -1
     testdstring trunc 0
     list [testdstring get] [testdstring length]
-} {{} 0}
+} -cleanup {
+    testdstring free
+} -result {{} 0}
 
-test dstring-5.1 {copying to result} testdstring {
+test dstring-5.1 {copying to result} -constraints testdstring -setup {
     testdstring free
+} -body {
     testdstring append xyz -1
     testdstring result
-} xyz
-test dstring-5.2 {copying to result} testdstring {
+} -cleanup {
+    testdstring free
+} -result xyz
+test dstring-5.2 {copying to result} -constraints testdstring -setup {
     testdstring free
-    catch {unset a}
+    unset -nocomplain a
+} -body {
     foreach l {a b c d e f g h i j k l m n o p} {
 	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
     }
     set a [testdstring result]
     testdstring append abc -1
     list $a [testdstring get]
-} {{aaaaaaaaaaaaaaaaaaaaa
+} -cleanup {
+    testdstring free
+} -result {{aaaaaaaaaaaaaaaaaaaaa
 bbbbbbbbbbbbbbbbbbbbb
 ccccccccccccccccccccc
 ddddddddddddddddddddd
@@ -285,23 +377,31 @@ ooooooooooooooooooooo
 ppppppppppppppppppppp
 } abc}
 
-test dstring-6.1 {Tcl_DStringGetResult} testdstring {
+test dstring-6.1 {Tcl_DStringGetResult} -constraints testdstring -setup {
     testdstring free
+} -body {
     list [testdstring gresult staticsmall] [testdstring get]
-} {{} short}
-test dstring-6.2 {Tcl_DStringGetResult} testdstring {
+} -cleanup {
     testdstring free
+} -result {{} short}
+test dstring-6.2 {Tcl_DStringGetResult} -constraints testdstring -setup {
+    testdstring free
+} -body {
     foreach l {a b c d e f g h i j k l m n o p} {
 	testdstring append $l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l$l\n -1
     }
     list [testdstring gresult staticsmall] [testdstring get]
-} {{} short}
-test dstring-6.3 {Tcl_DStringGetResult} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{} short}
+test dstring-6.3 {Tcl_DStringGetResult} -constraints testdstring -body {
     set result {}
     lappend result [testdstring gresult staticlarge]
     testdstring append x 1
     lappend result [testdstring get]
-} {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
+} -cleanup {
+    testdstring free
+} -result {{} {first0 first1 first2 first3 first4 first5 first6 first7 first8 first9
 second0 second1 second2 second3 second4 second5 second6 second7 second8 second9
 third0 third1 third2 third3 third4 third5 third6 third7 third8 third9
 fourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9
@@ -309,22 +409,31 @@ fifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9
 sixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9
 seventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9
 x}}
-test dstring-6.4 {Tcl_DStringGetResult} testdstring {
+test dstring-6.4 {Tcl_DStringGetResult} -constraints testdstring -body {
     set result {}
     lappend result [testdstring gresult free]
     testdstring append y 1
     lappend result [testdstring get]
-} {{} {This is a malloc-ed stringy}}
-test dstring-6.5 {Tcl_DStringGetResult} testdstring {
+} -cleanup {
+    testdstring free
+} -result {{} {This is a malloc-ed stringy}}
+test dstring-6.5 {Tcl_DStringGetResult} -constraints testdstring -body {
     set result {}
     lappend result [testdstring gresult special]
     testdstring append z 1
     lappend result [testdstring get]
-} {{} {This is a specially-allocated stringz}}
-
+} -cleanup {
+    testdstring free
+} -result {{} {This is a specially-allocated stringz}}
+
 # cleanup
 if {[testConstraint testdstring]} {
     testdstring free
 }
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/encoding.test b/tests/encoding.test
index dc4fd8c..0374e2d 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -1,50 +1,63 @@
 # This file contains a collection of tests for tclEncoding.c
-# 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.
-#
-# RCS: @(#) $Id: encoding.test,v 1.23 2005/05/10 18:35:18 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 package require tcltest 2
+
+namespace eval ::tcl::test::encoding {
+    variable x
+
 namespace import -force ::tcltest::*
 
+catch {
+    ::tcltest::loadTestedCommands
+    package require -exact Tcltest [info patchlevel]
+}
+
 proc toutf {args} {
-    global x
+    variable x
     lappend x "toutf $args"
 }
 proc fromutf {args} {
-    global x
+    variable x
     lappend x "fromutf $args"
 }
 
+proc runtests {} {
+    variable x
+
 # Some tests require the testencoding command
 testConstraint testencoding [llength [info commands testencoding]]
 testConstraint exec [llength [info commands exec]]
-
+testConstraint testgetdefenc [llength [info commands testgetdefenc]]
+
 # TclInitEncodingSubsystem is tested by the rest of this file
 # TclFinalizeEncodingSubsystem is not currently tested
 
-test encoding-1.1 {Tcl_GetEncoding: system encoding} {testencoding} {
-    testencoding create foo toutf fromutf
+test encoding-1.1 {Tcl_GetEncoding: system encoding} -setup {
     set old [encoding system]
+} -constraints {testencoding} -body {
+    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
     encoding system foo
     set x {}
     encoding convertto abcd
+    return $x
+} -cleanup {
     encoding system $old
     testencoding delete foo
-    set x
-} {{fromutf }}
+} -result {{fromutf }}
 test encoding-1.2 {Tcl_GetEncoding: existing encoding} {testencoding} {
-    testencoding create foo toutf fromutf
+    testencoding create foo [namespace origin toutf] [namespace origin fromutf]
     set x {}
     encoding convertto foo abcd
     testencoding delete foo
-    set x
+    return $x
 } {{fromutf }}
 test encoding-1.3 {Tcl_GetEncoding: load encoding} {
     list [encoding convertto jis0208 \u4e4e] \
@@ -54,70 +67,77 @@ test encoding-1.3 {Tcl_GetEncoding: load encoding} {
 test encoding-2.1 {Tcl_FreeEncoding: refcount == 0} {
     encoding convertto jis0208 \u4e4e
 } {8C}
-test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} {testencoding} {
+test encoding-2.2 {Tcl_FreeEncoding: refcount != 0} -setup {
     set system [encoding system]
-    set path [testencoding path]
+    set path [encoding dirs]
+} -constraints {testencoding} -body {
     encoding system shiftjis		;# incr ref count
-    testencoding path [list [pwd]]
+    encoding dirs [list [pwd]]
     set x [encoding convertto shiftjis \u4e4e]	;# old one found   
     encoding system identity
+    llength shiftjis		;# Shimmer away any cache of Tcl_Encoding
     lappend x [catch {encoding convertto shiftjis \u4e4e} msg] $msg
+} -cleanup {
     encoding system identity
-    testencoding path $path
+    encoding dirs $path
     encoding system $system
-    set x
-} "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
+} -result "\u008c\u00c1 1 {unknown encoding \"shiftjis\"}"
 
-test encoding-3.1 {Tcl_GetEncodingName, NULL} {
+test encoding-3.1 {Tcl_GetEncodingName, NULL} -setup {
     set old [encoding system]
+} -body {
     encoding system shiftjis
-    set x [encoding system]
+    encoding system
+} -cleanup {
     encoding system $old
-    set x
-} {shiftjis}
-test encoding-3.2 {Tcl_GetEncodingName, non-null} {
+} -result {shiftjis}
+test encoding-3.2 {Tcl_GetEncodingName, non-null} -setup {
     set old [fconfigure stdout -encoding]
+} -body {
     fconfigure stdout -encoding jis0208
-    set x [fconfigure stdout -encoding]
+    fconfigure stdout -encoding
+} -cleanup {
     fconfigure stdout -encoding $old
-    set x
-} {jis0208}
+} -result {jis0208}
 
-test encoding-4.1 {Tcl_GetEncodingNames} {testencoding} {
+test encoding-4.1 {Tcl_GetEncodingNames} -constraints {testencoding} -setup {
     cd [makeDirectory tmp]
     makeDirectory [file join tmp encoding]
-    makeFile {} [file join tmp encoding junk.enc]
-    makeFile {} [file join tmp encoding junk2.enc]
-    set path [testencoding path]
-    testencoding path {}
+    set path [encoding dirs]
+    encoding dirs {}
     catch {unset encodings}
     catch {unset x}
+} -body {
     foreach encoding [encoding names] {
 	set encodings($encoding) 1
     }
-    testencoding path [list [file join [pwd] encoding]]
+    makeFile {} [file join tmp encoding junk.enc]
+    makeFile {} [file join tmp encoding junk2.enc]
+    encoding dirs [list [file join [pwd] encoding]]
     foreach encoding [encoding names] {
 	if {![info exists encodings($encoding)]} {
 	    lappend x $encoding
 	}
     }
-    testencoding path $path
+    lsort $x
+} -cleanup {
+    encoding dirs $path
     cd [workingDirectory]
     removeFile [file join tmp encoding junk2.enc]
     removeFile [file join tmp encoding junk.enc]
     removeDirectory [file join tmp encoding]
     removeDirectory tmp
-    lsort $x
-} {junk junk2}
+} -result {junk junk2}
 
-test encoding-5.1 {Tcl_SetSystemEncoding} {
+test encoding-5.1 {Tcl_SetSystemEncoding} -setup {
     set old [encoding system]
+} -body {
     encoding system jis0208
-    set x [encoding convertto \u4e4e]
+    encoding convertto \u4e4e
+} -cleanup {
     encoding system identity
     encoding system $old
-    set x
-} {8C}
+} -result {8C}
 test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
     set old [encoding system]
     encoding system $old
@@ -125,20 +145,22 @@ test encoding-5.2 {Tcl_SetSystemEncoding: test ref count} {
 } {0}
 
 test encoding-6.1 {Tcl_CreateEncoding: new} {testencoding} {
-    testencoding create foo {toutf 1} {fromutf 2}
+    testencoding create foo [namespace code {toutf 1}] \
+	[namespace code {fromutf 2}]
     set x {}
     encoding convertfrom foo abcd
     encoding convertto foo abcd
     testencoding delete foo
-    set x
+    return $x
 } {{toutf 1} {fromutf 2}}
 test encoding-6.2 {Tcl_CreateEncoding: replace encoding} {testencoding} {
-    testencoding create foo {toutf a} {fromutf b}
+    testencoding create foo [namespace code {toutf a}] \
+	[namespace code {fromutf b}]
     set x {}
     encoding convertfrom foo abcd
     encoding convertto foo abcd
     testencoding delete foo
-    set x
+    return $x
 } {{toutf a} {fromutf b}}
 
 test encoding-7.1 {Tcl_ExternalToUtfDString: small buffer} {
@@ -164,7 +186,7 @@ test encoding-8.1 {Tcl_ExternalToUtf} {
     set x [read $f]
     close $f
     file delete [file join [temporaryDirectory] dummy]
-    set x
+    return $x
 } "ab\u4e4eg"
 
 test encoding-9.1 {Tcl_UtfToExternalDString: small buffer} {
@@ -192,7 +214,7 @@ test encoding-10.1 {Tcl_UtfToExternal} {
     set x [read $f]
     close $f
     file delete [file join [temporaryDirectory] dummy]
-    set x
+    return $x
 } "ab\x8c\xc1g"
 
 proc viewable {str} {
@@ -209,11 +231,12 @@ proc viewable {str} {
 
 test encoding-11.1 {LoadEncodingFile: unknown encoding} {testencoding} {
     set system [encoding system]
-    set path [testencoding path]
+    set path [encoding dirs]
     encoding system iso8859-1
-    testencoding path {}
+    encoding dirs {}
+    llength jis0208	;# Shimmer any cached Tcl_Encoding in shared literal
     set x [list [catch {encoding convertto jis0208 \u4e4e} msg] $msg]
-    testencoding path $path
+    encoding dirs $path
     encoding system $system
     lappend x [encoding convertto jis0208 \u4e4e]
 } {1 {unknown encoding "jis0208"} 8C}
@@ -232,27 +255,28 @@ test encoding-11.5 {LoadEncodingFile: escape file} {
 test encoding-11.5.1 {LoadEncodingFile: escape file} {
     viewable [encoding convertto iso2022-jp \u4e4e]
 } [viewable "\x1b\$B8C\x1b(B"]
-test encoding-11.6 {LoadEncodingFile: invalid file} {testencoding} {
+test encoding-11.6 {LoadEncodingFile: invalid file} -constraints {testencoding} -setup {
     set system [encoding system]
-    set path [testencoding path]
+    set path [encoding dirs]
     encoding system identity
+} -body {
     cd [temporaryDirectory]
-    testencoding path [file join tmp encoding]
+    encoding dirs [file join tmp encoding]
     makeDirectory tmp
     makeDirectory [file join tmp encoding]
     set f [open [file join tmp encoding splat.enc] w]
     fconfigure $f -translation binary 
     puts $f "abcdefghijklmnop"
     close $f
-    set x [list [catch {encoding convertto splat \u4e4e} msg] $msg]
+    encoding convertto splat \u4e4e
+} -returnCodes error -cleanup {
     file delete [file join [temporaryDirectory] tmp encoding splat.enc]
     removeDirectory [file join tmp encoding]
     removeDirectory tmp
     cd [workingDirectory]
-    testencoding path $path
+    encoding dirs $path
     encoding system $system
-    set x
-} {1 {invalid encoding file "splat"}}
+} -result {invalid encoding file "splat"}
 
 # OpenEncodingFile is fully tested by the rest of the tests in this file.
 
@@ -290,7 +314,6 @@ test encoding-14.1 {BinaryProc} {
 test encoding-15.1 {UtfToUtfProc} {
     encoding convertto utf-8 \xa3
 } "\xc2\xa3"
-
 test encoding-15.2 {UtfToUtfProc null character output} {
     set x \u0000
     set y [encoding convertto utf-8 \u0000]
@@ -298,7 +321,6 @@ test encoding-15.2 {UtfToUtfProc null character output} {
     binary scan $y H* z
     list [string bytelength $x] [string bytelength $y] $z
 } {2 1 00}
-
 test encoding-15.3 {UtfToUtfProc null character input} {
     set x [encoding convertfrom identity \x00]
     set y [encoding convertfrom utf-8 $x]
@@ -307,8 +329,9 @@ test encoding-15.3 {UtfToUtfProc null character input} {
 } {1 2 c080}
 
 test encoding-16.1 {UnicodeToUtfProc} {
-    encoding convertfrom unicode NN
-} "\u4e4e"
+    set val [encoding convertfrom unicode NN]
+    list $val [format %x [scan $val %c]]
+} "\u4e4e 4e4e"
 
 test encoding-17.1 {UtfToUnicodeProc} {
 } {}
@@ -328,14 +351,14 @@ test encoding-21.1 {EscapeToUtfProc} {
 test encoding-22.1 {EscapeFromUtfProc} {
 } {}
 
-set ::iso2022encData "\u001b\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\u001b(B
+set iso2022encData "\u001b\$B;d\$I\$b\$G\$O!\"%A%C%W\$49XF~;~\$K\$4EPO?\$\$\$?\$@\$\$\$?\$4=;=j\$r%-%c%C%7%e%\"%&%H\$N:]\$N\u001b(B
 \u001b\$B>.@Z<jAwIU@h\$H\$7\$F;HMQ\$7\$F\$*\$j\$^\$9!#62\$lF~\$j\$^\$9\$,!\"@5\$7\$\$=;=j\$r\$4EPO?\$7\$J\$*\u001b(B
 \u001b\$B\$*4j\$\$\$\$\$?\$7\$^\$9!#\$^\$?!\"BgJQ62=L\$G\$9\$,!\"=;=jJQ99\$N\$\"\$H!\"F|K\\8l%5!<%S%9It!J\u001b(B
 casino_japanese@___.com \u001b\$B!K\$^\$G\$4=;=jJQ99:Q\$NO\"Mm\$r\$\$\$?\$@\$1\$J\$\$\$G\u001b(B
 \u001b\$B\$7\$g\$&\$+!)\u001b(B"
 
-set ::iso2022uniData [encoding convertfrom iso2022-jp $::iso2022encData]
-set ::iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3054\u8cfc\u5165\u6642\u306b\u3054\u767b\u9332\u3044\u305f\u3060\u3044\u305f\u3054\u4f4f\u6240\u3092\u30ad\u30e3\u30c3\u30b7\u30e5\u30a2\u30a6\u30c8\u306e\u969b\u306e
+set iso2022uniData [encoding convertfrom iso2022-jp $iso2022encData]
+set iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3054\u8cfc\u5165\u6642\u306b\u3054\u767b\u9332\u3044\u305f\u3060\u3044\u305f\u3054\u4f4f\u6240\u3092\u30ad\u30e3\u30c3\u30b7\u30e5\u30a2\u30a6\u30c8\u306e\u969b\u306e
 \u5c0f\u5207\u624b\u9001\u4ed8\u5148\u3068\u3057\u3066\u4f7f\u7528\u3057\u3066\u304a\u308a\u307e\u3059\u3002\u6050\u308c\u5165\u308a\u307e\u3059\u304c\u3001\u6b63\u3057\u3044\u4f4f\u6240\u3092\u3054\u767b\u9332\u3057\u306a\u304a
 \u304a\u9858\u3044\u3044\u305f\u3057\u307e\u3059\u3002\u307e\u305f\u3001\u5927\u5909\u6050\u7e2e\u3067\u3059\u304c\u3001\u4f4f\u6240\u5909\u66f4\u306e\u3042\u3068\u3001\u65e5\u672c\u8a9e\u30b5\u30fc\u30d3\u30b9\u90e8\uff08
 \u0063\u0061\u0073\u0069\u006e\u006f\u005f\u006a\u0061\u0070\u0061\u006e\u0065\u0073\u0065\u0040\u005f\u005f\u005f\u002e\u0063\u006f\u006d\u0020\uff09\u307e\u3067\u3054\u4f4f\u6240\u5909\u66f4\u6e08\u306e\u9023\u7d61\u3092\u3044\u305f\u3060\u3051\u306a\u3044\u3067
@@ -344,11 +367,11 @@ set ::iso2022uniData2 "\u79c1\u3069\u3082\u3067\u306f\u3001\u30c1\u30c3\u30d7\u3
 cd [temporaryDirectory]
 set fid [open iso2022.txt w]
 fconfigure $fid -encoding binary
-puts -nonewline $fid $::iso2022encData
+puts -nonewline $fid $iso2022encData
 close $fid
 
 test encoding-23.1 {iso2022-jp escape encoding test} {
-    string equal $::iso2022uniData $::iso2022uniData2
+    string equal $iso2022uniData $iso2022uniData2
 } 1
 test encoding-23.2 {iso2022-jp escape encoding test} {
     # This checks that 'gets' isn't resetting the encoding inappropriately.
@@ -366,54 +389,52 @@ test encoding-23.2 {iso2022-jp escape encoding test} {
 	incr count $num
     }
     close $fid
-    if {[string compare $::iso2022uniData $out]} {
+    if {[string compare $iso2022uniData $out]} {
 	return -code error "iso2022-jp read in doesn't match original"
     }
     list $count $out
-} [list [string length $::iso2022uniData] $::iso2022uniData]
+} [list [string length $iso2022uniData] $iso2022uniData]
 test encoding-23.3 {iso2022-jp escape encoding test} {
     # read $fis <size> reads size in chars, not raw bytes.
     set fid [open iso2022.txt r]
     fconfigure $fid -encoding iso2022-jp
     set data [read $fid 50]
     close $fid
-    set data
-} [string range $::iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
+    return $data
+} [string range $iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
 cd [workingDirectory]
 
-test encoding-24.1 {EscapeFreeProc on open channels} -constraints {
-	exec
-} -setup {
-    # Bug #524674 input
-    set file [makeFile {
+# Code to make the next few tests more intelligible; the code being tested
+# should be in the body of the test!
+proc runInSubprocess {contents {filename iso2022.tcl}} {
+    set theFile [makeFile $contents $filename]
+    try {
+	exec [interpreter] $theFile
+    } finally {
+	removeFile $theFile
+    }
+}
+
+test encoding-24.1 {EscapeFreeProc on open channels} exec {
+    runInSubprocess {
 	set f [open [file join [file dirname [info script]] iso2022.txt]]
 	fconfigure $f -encoding iso2022-jp
 	gets $f
-    } iso2022.tcl]
-} -body {
-    exec [interpreter] $file
-} -cleanup {
-    removeFile iso2022.tcl
-} -result {}
-
-test encoding-24.2 {EscapeFreeProc on open channels} -constraints {
-	exec
-} -setup {
+    }
+} {}
+test encoding-24.2 {EscapeFreeProc on open channels} {exec} {
     # Bug #524674 output
-    set file [makeFile {
+    viewable [runInSubprocess {
+	encoding system cp1252;	# Bug #2891556 crash revelator
 	fconfigure stdout -encoding iso2022-jp
 	puts ab\u4e4e\u68d9g
+	set env(TCL_FINALIZE_ON_EXIT) 1
 	exit
-    } iso2022.tcl]
-} -body {
-    viewable [exec [interpreter] $file]
-} -cleanup {
-    removeFile iso2022.tcl
-} -result "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
-
+    }]
+} "ab\x1b\$B8C\x1b\$(DD%\x1b(Bg (ab\\u001b\$B8C\\u001b\$(DD%\\u001b(Bg)"
 test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
-    # Bug #219314 - if we don't free escape encodings correctly on
-    # channel closure, we go boom
+    # Bug #219314 - if we don't free escape encodings correctly on channel
+    # closure, we go boom
     set file [makeFile {
 	encoding system iso2022-jp
 	set a "\u4e4e\u4e5e\u4e5f"; # 3 Japanese Kanji letters
@@ -457,18 +478,14 @@ proc foreach-jisx0208 {varName command} {
     } {
 	if {[llength $range] == 2} {
 	    # for adhoc range. simple {first last}. inclusive.
-	    set first [scan [lindex $range 0] %x]
-	    set last [scan [lindex $range 1] %x]
+	    scan $range %x%x first last
 	    for {set i $first} {$i <= $last} {incr i} {
 		set code $i
 		uplevel 1 $command
 	    }
 	} elseif {[llength $range] == 4} {
 	    # for uniform range.
-	    set h0 [scan [lindex $range 0] %x]
-	    set l0 [scan [lindex $range 1] %x]
-	    set hend [scan [lindex $range 2] %x]
-	    set lend [scan [lindex $range 3] %x]
+	    scan $range %x%x%x%x h0 l0 hend lend
 	    for {set hi $h0} {$hi <= $hend} {incr hi} {
 		for {set lo $l0} {$lo <= $lend} {incr lo} {
 		    set code [expr {$hi << 8 | ($lo & 0xff)}]
@@ -512,7 +529,7 @@ proc channel-diff {fa fb} {
 	binary scan [lindex $lb 1] H* got
 	lappend diff [list $code $expected $got]
     }
-    set diff
+    return $diff
 }
 
 # Create char tables.
@@ -531,8 +548,9 @@ file copy -force cp932.chars shiftjis.chars
 set NUM 0
 foreach from {cp932 shiftjis euc-jp iso2022-jp} {
     foreach to {cp932 shiftjis euc-jp iso2022-jp} {
-	test encoding-25.[incr NUM] "jisx0208 $from => $to" {
+	test encoding-25.[incr NUM] "jisx0208 $from => $to" -setup {
 	    cd [temporaryDirectory]
+	} -body {
 	    set f [open $from.chars]
 	    fconfigure $f -encoding $from
 	    set out [open $from.$to.tcltestout w]
@@ -540,41 +558,53 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} {
 	    puts -nonewline $out [read $f]
 	    close $out
 	    close $f
-	    
 	    # then compare $to.chars <=> $from.to.tcltestout as binary.
-	    set fa [open $to.chars]
-	    fconfigure $fa -encoding binary
-	    set fb [open $from.$to.tcltestout]
-	    fconfigure $fb -encoding binary
-	    set diff [channel-diff $fa $fb]
+	    set fa [open $to.chars rb]
+	    set fb [open $from.$to.tcltestout rb]
+	    channel-diff $fa $fb
+	    # Difference should be empty.
+	} -cleanup {
 	    close $fa
 	    close $fb
-	    
-	    # Difference should be empty.
-	    set diff
-	} {}
+	} -result {}
     }
 }
 
-testConstraint testgetdefenc [llength [info commands testgetdefenc]]
-
 test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints {
-    testgetdefenc 
+    testgetdefenc
 } -setup {
-     set origDir [testgetdefenc]
-     testsetdefenc slappy
+    set origDir [testgetdefenc]
+    testsetdefenc slappy
 } -body {
-     testgetdefenc
+    testgetdefenc
 } -cleanup {
-     testsetdefenc $origDir
+    testsetdefenc $origDir
 } -result slappy
 
-file delete {expand}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
+file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
 # ===> Cut here <===
 
-# EscapeFreeProc, GetTableEncoding, unilen
-# are fully tested by the rest of this file
+# EscapeFreeProc, GetTableEncoding, unilen are fully tested by the rest of
+# this file.
+
+
+test encoding-27.1 {encoding dirs basic behavior} -returnCodes error -body {
+    encoding dirs ? ?
+} -result {wrong # args: should be "encoding dirs ?dirList?"}
+test encoding-27.2 {encoding dirs basic behavior} -returnCodes error -body {
+    encoding dirs "\{not a list"
+} -result "expected directory list but got \"\{not a list\""
+
+}
+runtests
+
+}
 
 # cleanup
+namespace delete ::tcl::test::encoding
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/env.test b/tests/env.test
index 24dc2e3..83d99e0 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -1,17 +1,15 @@
 # Commands covered:  none (tests environment variable implementation)
 #
-# 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.
-#
-# RCS: @(#) $Id: env.test,v 1.21 2005/05/24 04:44:08 das Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -23,74 +21,90 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 testConstraint exec [llength [info commands exec]]
 
 #
-# These tests will run on any platform (and indeed crashed
-# on the Mac).  So put them before you test for the existance
-# of exec.
+# These tests will run on any platform (and indeed crashed on the Mac). So put
+# them before you test for the existance of exec.
 #
-test env-1.1 {propagation of env values to child interpreters} {
+test env-1.1 {propagation of env values to child interpreters} -setup {
     catch {interp delete child}
     catch {unset env(test)}
+} -body {
     interp create child
     set env(test) garbage
-    set return [child eval {set env(test)}]
+    child eval {set env(test)}
+} -cleanup {
     interp delete child
     unset env(test)
-    set return
-} {garbage}
+} -result {garbage}
 #
-# This one crashed on Solaris under Tcl8.0, so we only
-# want to make sure it runs.
+# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
+# runs.
 #
-test env-1.2 {lappend to env value} {
+test env-1.2 {lappend to env value} -setup {
     catch {unset env(test)}
+} -body {
     set env(test) aaaaaaaaaaaaaaaa
     append env(test) bbbbbbbbbbbbbb
     unset env(test)
-} {}
-test env-1.3 {reflection of env by "array names"} {
+}
+test env-1.3 {reflection of env by "array names"} -setup {
     catch {interp delete child}
     catch {unset env(test)}
+} -body {
     interp create child
     child eval {set env(test) garbage}
-    set names [array names env]
+    expr {"test" in [array names env]}
+} -cleanup {
     interp delete child
-    set ix [lsearch $names test]
     catch {unset env(test)}
-    expr {$ix >= 0}
-} {1}
+} -result {1}
 
 set printenvScript [makeFile {
+    encoding system iso8859-1
     proc lrem {listname name} {
 	upvar $listname list
-	set i [lsearch $list $name]
+	set i [lsearch -nocase $list $name]
 	if {$i >= 0} {
 	    set list [lreplace $list $i $i]
 	}
 	return $list
     }
-	
+    proc mangle s {
+	regsub -all {\[|\\|\]} $s {\\&} s
+	regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s
+	return [subst -novariables $s]
+    }
+    proc manglechar c {
+	return [format {\u%04x} [scan $c %c]]
+    }
+
     set names [lsort [array names env]]
-    if {$tcl_platform(platform) == "windows"} {
+    if {$tcl_platform(platform) eq "windows"} {
 	lrem names HOME
         lrem names COMSPEC
 	lrem names ComSpec
 	lrem names ""
-    }	
-    foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY SHLIB_PATH DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH __CF_USER_TEXT_ENCODING } {
+    }
+    foreach name {
+	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
+	SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
+	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
+	__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
+	CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
+    } {
 	lrem names $name
     }
     foreach p $names {
-	puts "$p=$env($p)"
+	puts "[mangle $p]=[mangle $env($p)]"
     }
     exit
 } printenv]
-	
-# [exec] is required here to see the actual environment received
-# by child processes.
+
+# [exec] is required here to see the actual environment received by child
+# processes.
 proc getenv {} {
     global printenvScript tcltest
     catch {exec [interpreter] $printenvScript} out
-    if {$out == "child process exited abnormally"} {
+    if {$out eq "child process exited abnormally"} {
 	set out {}
     }
     return $out
@@ -98,151 +112,220 @@ proc getenv {} {
 
 # Save the current environment variables at the start of the test.
 
+set env2 [array get env]
 foreach name [array names env] {
-    set env2($name) $env($name)
-    unset env($name)
-}
-
-# Added the following lines so that child tcltest can actually find its
-# library if the initial tcltest is run from a non-standard place.
-# ('saved' env vars)
-foreach name {TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH} {
-    if {[info exists env2($name)]} {
-	set env($name) $env2($name);
+    # Keep some environment variables that support operation of the tcltest
+    # package.
+    if {[string toupper $name] ni {
+	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
+	SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
+	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
+	SECURITYSESSIONID LANG WINDIR TERM
+	CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
+    }} {
+	unset env($name)
     }
 }
 
-test env-2.1 {adding environment variables} {exec} {
-    getenv
-} {}
+# Need to run 'getenv' in known encoding, so save the current one here...
+set sysenc [encoding system]
 
-set env(NAME1) "test string"
-test env-2.2 {adding environment variables} {exec} {
+test env-2.1 {adding environment variables} -setup {
+    encoding system iso8859-1
+} -constraints {exec} -body {
     getenv
-} {NAME1=test string}
-
-set env(NAME2) "more"
-test env-2.3 {adding environment variables} {exec} {
+} -cleanup {
+    encoding system $sysenc
+} -result {}
+test env-2.2 {adding environment variables} -setup {
+    encoding system iso8859-1
+} -constraints {exec} -body {
+    set env(NAME1) "test string"
+    getenv
+} -cleanup {
+    encoding system $sysenc
+} -result {NAME1=test string}
+test env-2.3 {adding environment variables} -setup {
+    encoding system iso8859-1
+} -constraints {exec} -body {
+    set env(NAME2) "more"
     getenv
-} {NAME1=test string
+} -cleanup {
+    encoding system $sysenc
+} -result {NAME1=test string
 NAME2=more}
-
-set env(XYZZY) "garbage"
-test env-2.4 {adding environment variables} {exec} {
+test env-2.4 {adding environment variables} -setup {
+    encoding system iso8859-1
+} -constraints {exec} -body {
+    set env(XYZZY) "garbage"
     getenv
-} {NAME1=test string
+} -cleanup {
+    encoding system $sysenc
+} -result {NAME1=test string
 NAME2=more
 XYZZY=garbage}
 
 set env(NAME2) "new value"
-test env-3.1 {changing environment variables} {exec} {
+test env-3.1 {changing environment variables} -setup {
+    encoding system iso8859-1
+} -constraints {exec} -body {
     set result [getenv]
     unset env(NAME2)
     set result
-} {NAME1=test string
+} -cleanup {
+    encoding system $sysenc
+} -result {NAME1=test string
 NAME2=new value
 XYZZY=garbage}
 
-test env-4.1 {unsetting environment variables} {exec} {
-    set result [getenv]
-    unset env(NAME1)
-    set result
-} {NAME1=test string
+test env-4.1 {unsetting environment variables: default} -setup {
+    encoding system iso8859-1
+} -constraints {exec} -body {
+    getenv
+} -cleanup {
+    encoding system $sysenc
+} -result {NAME1=test string
 XYZZY=garbage}
-
-test env-4.2 {unsetting environment variables} {exec} {
-    set result [getenv]
+test env-4.2 {unsetting environment variables} -setup {
+    encoding system iso8859-1
+} -constraints {exec} -body {
+    unset env(NAME1)
+    getenv
+} -cleanup {
     unset env(XYZZY)
-    set result
-} {XYZZY=garbage}
-
-test env-4.3 {setting international environment variables} {exec} {
+    encoding system $sysenc
+} -result {XYZZY=garbage}
+test env-4.3 {setting international environment variables} -setup {
+    encoding system iso8859-1
+} -constraints {exec} -body {
     set env(\ua7) \ub6
     getenv
-} "\ua7=\ub6"
-test env-4.4 {changing international environment variables} {exec} {
+} -cleanup {
+    encoding system $sysenc
+} -result {\u00a7=\u00b6}
+test env-4.4 {changing international environment variables} -setup {
+    encoding system iso8859-1
+} -constraints {exec} -body {
     set env(\ua7) \ua7
     getenv
-} "\ua7=\ua7"
-test env-4.5 {unsetting international environment variables} {exec} {
+} -cleanup {
+    encoding system $sysenc
+} -result {\u00a7=\u00a7}
+test env-4.5 {unsetting international environment variables} -setup {
+    encoding system iso8859-1
+} -body {
     set env(\ub6) \ua7
     unset env(\ua7)
-    set result [getenv]
+    getenv
+} -constraints {exec} -cleanup {
     unset env(\ub6)
-    set result
-} "\ub6=\ua7"
+    encoding system $sysenc
+} -result {\u00b6=\u00a7}
 
-test env-5.0 {corner cases - set a value, it should exist} {} {
+test env-5.0 {corner cases - set a value, it should exist} -body {
     set env(temp) a
-    set result [set env(temp)]
+    set env(temp)
+} -cleanup {
     unset env(temp)
-    set result
-} {a}
-test env-5.1 {corner cases - remove one elem at a time} {} {
-    # When no environment variables exist, the env var will
-    # contain no entries.  The "array names" call synchs up
-    # the C-level environ array with the Tcl level env array.
-    # Make sure an empty Tcl array is created.
-
+} -result {a}
+test env-5.1 {corner cases - remove one elem at a time} -setup {
     set x [array get env]
+} -body {
+    # When no environment variables exist, the env var will contain no
+    # entries. The "array names" call synchs up the C-level environ array with
+    # the Tcl level env array. Make sure an empty Tcl array is created.
     foreach e [array names env] {
 	unset env($e)
     }
-    set result [catch {array names env}]
+    array size env
+} -cleanup {
     array set env $x
-    set result
-} {0}
-test env-5.2 {corner cases - unset the env array} {} {
-    # Unsetting a variable in an interp detaches the C-level
-    # traces from the Tcl "env" variable.
-
-    interp create i 
-    i eval { unset env }
-    i eval { set env(THIS_SHOULDNT_EXIST) a}
-    set result [info exists env(THIS_SHOULDNT_EXIST)]
+} -result {0}
+test env-5.2 {corner cases - unset the env array} -setup {
+    interp create i
+} -body {
+    # Unsetting a variable in an interp detaches the C-level traces from the
+    # Tcl "env" variable.
+    i eval {
+	unset env
+	set env(THIS_SHOULDNT_EXIST) a
+    }
+    info exists env(THIS_SHOULDNT_EXIST)
+} -cleanup {
     interp delete i
-    set result
-} {0}
-test env-5.3 {corner cases - unset the env in master should unset child} {} {
-    # Variables deleted in a master interp should be deleted in
-    # child interp too.
-
-    interp create i 
+} -result {0}
+test env-5.3 {corner cases: unset the env in master should unset child} -setup {
+    interp create i
+} -body {
+    # Variables deleted in a master interp should be deleted in child interp
+    # too.
     i eval { set env(THIS_SHOULD_EXIST) a}
     set result [set env(THIS_SHOULD_EXIST)]
     unset env(THIS_SHOULD_EXIST)
     lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
+} -cleanup {
     interp delete i
-    set result
-} {a 1}
-test env-5.4 {corner cases - unset the env array} {} {
+} -result {a 1}
+test env-5.4 {corner cases - unset the env array} -setup {
+    interp create i
+} -body {
     # The info exists command should be in synch with the env array.
     # Know Bug: 1737
-
-    interp create i 
     i eval { set env(THIS_SHOULD_EXIST) a}
     set     result [info exists env(THIS_SHOULD_EXIST)]
     lappend result [set env(THIS_SHOULD_EXIST)]
     lappend result [info exists env(THIS_SHOULD_EXIST)]
+} -cleanup {
     interp delete i
-    set result
-} {1 a 1}
+} -result {1 a 1}
 test env-5.5 {corner cases - cannot have null entries on Windows} {win} {
     set env() a
     catch {set env()}
 } {1}
 
+test env-6.1 {corner cases - add lots of env variables} {} {
+    set size [array size env]
+    for {set i 0} {$i < 100} {incr i} {
+	set env(BOGUS$i) $i
+    }
+    expr {[array size env] - $size}
+} 100
+
+test env-7.1 {[219226]: whole env array should not be unset by read} {
+    set n [array size env]
+    set s [array startsearch env]
+    while {[array anymore env $s]} {
+	array nextelement env $s
+	incr n -1
+    }
+    array donesearch env $s
+    return $n
+} 0
+test env-7.2 {[219226]: links to env elements should not be removed by read} {
+    apply {{} {
+	set ::env(test7_2) ok
+	upvar env(test7_2) elem
+	set ::env(PATH)
+	try {
+	    return $elem
+	} finally {
+	    unset ::env(test7_2)
+	}
+    }}
+} ok
 
 # Restore the environment variables at the end of the test.
 
 foreach name [array names env] {
     unset env($name)
 }
-foreach name [array names env2] {
-    set env($name) $env2($name)
-}
+array set env $env2
 
 # cleanup
 removeFile $printenvScript
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/error.test b/tests/error.test
index ab35c5d..0de644c 100644
--- a/tests/error.test
+++ b/tests/error.test
@@ -1,23 +1,42 @@
-# Commands covered:  error, catch
+# Commands covered:  error, catch, throw, try
 #
-# 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-1996 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.
-#
-# RCS: @(#) $Id: error.test,v 1.13 2005/07/28 18:42:28 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+testConstraint memory [llength [info commands memory]]
+customMatch pairwise {apply {{a b} {
+    string equal [lindex $b 0] [lindex $b 1]
+}}}
+namespace eval ::tcl::test::error {
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
+
 proc foo {} {
     global errorInfo
     set a [catch {format [error glorp2]} b]
@@ -35,88 +54,74 @@ proc foo2 {} {
 test error-1.1 {simple errors from commands} {
     catch {format [string index]} b
 } 1
-
 test error-1.2 {simple errors from commands} {
     catch {format [string index]} b
     set b
 } {wrong # args: should be "string index string charIndex"}
-
 test error-1.3 {simple errors from commands} {
     catch {format [string index]} b
-    set errorInfo
-    # this used to return '... while executing ...', but
-    # string index is fully compiled as of 8.4a3
+    set ::errorInfo
+    # This used to return '... while executing ...', but string index is fully
+    # compiled as of 8.4a3
 } {wrong # args: should be "string index string charIndex"
     while executing
 "string index"}
-
 test error-1.4 {simple errors from commands} {
     catch {error glorp} b
 } 1
-
 test error-1.5 {simple errors from commands} {
     catch {error glorp} b
     set b
 } glorp
-
 test error-1.6 {simple errors from commands} {
     catch {catch a b c d} b
 } 1
-
 test error-1.7 {simple errors from commands} {
     catch {catch a b c d} b
     set b
 } {wrong # args: should be "catch script ?resultVarName? ?optionVarName?"}
-
 test error-1.8 {simple errors from commands} {
-    # This test is non-portable: it generates a memory fault on
-    # machines like DEC Alphas (infinite recursion overflows
-    # stack?)
+    # This test is non-portable: it generates a memory fault on machines like
+    # DEC Alphas (infinite recursion overflows stack?)
     #
     # That claims sounds like a bug to be fixed rather than a portability
-    # problem.  Anyhow, I believe it's out of date (bug's been fixed) so
-    # this test is re-enabled.
-
+    # problem. Anyhow, I believe it's out of date (bug's been fixed) so this
+    # test is re-enabled.
     proc p {} {
         uplevel 1 catch p error
     }
     p
 } 0
 
-# Check errors nested in procedures.  Also check the optional argument
-# to "error" to generate a new error trace.
+# Check errors nested in procedures. Also check the optional argument to
+# "error" to generate a new error trace.
 
 test error-2.1 {errors in nested procedures} {
     catch foo b
 } 1
-
 test error-2.2 {errors in nested procedures} {
     catch foo b
     set b
 } {Human-generated}
-
 test error-2.3 {errors in nested procedures} {
     catch foo b
-    set errorInfo
+    set ::errorInfo
 } {Human-generated
     while executing
 "error {Human-generated}"
     (procedure "foo" line 4)
     invoked from within
 "foo"}
-
 test error-2.4 {errors in nested procedures} {
     catch foo2 b
 } 1
-
 test error-2.5 {errors in nested procedures} {
     catch foo2 b
     set b
 } {Human-generated}
-
 test error-2.6 {errors in nested procedures} {
     catch foo2 b
-    set errorInfo
+    set ::errorInfo
 } {glorp2
     while executing
 "error glorp2"
@@ -136,35 +141,58 @@ test error-3.3 {errors in catch command} {
     catch {unset a}
     set a(0) 22
     list [catch {catch {format 44} a} msg] $msg
-} {1 {couldn't save command result in variable}}
+} {1 {can't set "a": variable is array}}
 catch {unset a}
 
 # More tests related to errorInfo and errorCode
 
 test error-4.1 {errorInfo and errorCode variables} {
-    list [catch {error msg1 msg2 msg3} msg] $msg $errorInfo $errorCode
+    list [catch {error msg1 msg2 msg3} msg] $msg $::errorInfo $::errorCode
 } {1 msg1 msg2 msg3}
 test error-4.2 {errorInfo and errorCode variables} {
-    list [catch {error msg1 {} msg3} msg] $msg $errorInfo $errorCode
+    list [catch {error msg1 {} msg3} msg] $msg $::errorInfo $::errorCode
 } {1 msg1 {msg1
     while executing
 "error msg1 {} msg3"} msg3}
 test error-4.3 {errorInfo and errorCode variables} {
-    list [catch {error msg1 {}} msg] $msg $errorInfo $errorCode
+    list [catch {error msg1 {}} msg] $msg $::errorInfo $::errorCode
 } {1 msg1 {msg1
     while executing
 "error msg1 {}"} NONE}
 test error-4.4 {errorInfo and errorCode variables} {
-    set errorCode bogus
-    list [catch {error msg1} msg] $msg $errorInfo $errorCode
+    set ::errorCode bogus
+    list [catch {error msg1} msg] $msg $::errorInfo $::errorCode
 } {1 msg1 {msg1
     while executing
 "error msg1"} NONE}
 test error-4.5 {errorInfo and errorCode variables} {
-    set errorCode bogus
-    list [catch {error msg1 msg2 {}} msg] $msg $errorInfo $errorCode
+    set ::errorCode bogus
+    list [catch {error msg1 msg2 {}} msg] $msg $::errorInfo $::errorCode
 } {1 msg1 msg2 {}}
 
+test error-4.6 {errorstack via info } -body {
+    proc f x {g $x$x}
+    proc g x {error G:$x}
+    catch {f 12}
+    info errorstack
+} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
+test error-4.7 {errorstack via options dict } -body {
+    proc f x {g $x$x}
+    proc g x {error G:$x}
+    catch {f 12} m d
+    dict get $d -errorstack
+} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
+test error-4.8 {errorstack from exec traces} -body {
+    proc foo args {}
+    proc goo {} foo
+    trace add execution foo enter {error bar;#}
+    catch goo m d
+    dict get $d -errorstack
+} -cleanup {
+    rename goo {}; rename foo {}
+    unset -nocomplain m d
+} -result {INNER {error bar} CALL goo UP 1}
+
 # Errors in error command itself
 
 test error-5.1 {errors in error command} {
@@ -178,49 +206,1000 @@ test error-5.2 {errors in error command} {
 
 test error-6.1 {catch must reset error state} {
     catch {error outer [catch {error inner inner.errorInfo inner.errorCode}]}
-    list $errorCode $errorInfo
+    list $::errorCode $::errorInfo
 } {NONE 1}
 test error-6.2 {catch must reset error state} {
     catch {error outer [catch {return -level 0 -code error -errorcode BUG}]}
-    list $errorCode $errorInfo
+    list $::errorCode $::errorInfo
 } {NONE 1}
 test error-6.3 {catch must reset error state} {
-    set errorCode BUG
+    set ::errorCode BUG
     catch {error outer [catch set]}
-    list $errorCode $errorInfo
+    list $::errorCode $::errorInfo
 } {NONE 1}
 test error-6.4 {catch must reset error state} {
     catch {error [catch {error foo bar baz}] 1}
-    list $errorCode $errorInfo
+    list $::errorCode $::errorInfo
 } {NONE 1}
 test error-6.5 {catch must reset error state} {
     catch {error [catch {return -level 0 -code error -errorcode BUG}] 1}
-    list $errorCode $errorInfo
+    list $::errorCode $::errorInfo
 } {NONE 1}
 test error-6.6 {catch must reset error state} {
     catch {return -level 0 -code error -errorinfo [catch {error foo bar baz}]}
-    list $errorCode $errorInfo
+    list $::errorCode $::errorInfo
 } {NONE 1}
 test error-6.7 {catch must reset error state} {
     proc foo {} {
 	return -code error -errorinfo [catch {error foo bar baz}]
     }
     catch foo
-    list $errorCode
+    list $::errorCode
 } {NONE}
 test error-6.8 {catch must reset error state} {
     catch {return -level 0 -code error [catch {error foo bar baz}]}
-    list $errorCode
+    list $::errorCode
 } {NONE}
 test error-6.9 {catch must reset error state} {
     proc foo {} {
 	return -code error [catch {error foo bar baz}]
     }
     catch foo
-    list $errorCode
+    list $::errorCode
 } {NONE}
+test error-6.10 {catch must reset errorstack} -body {
+	proc f x {g $x$x}
+	proc g x {error G:$x}
+	catch {f 12}
+	set e1 [info errorstack]
+	catch {f 13}
+	set e2 [info errorstack]
+	list $e1 $e2
+} -match glob -result {{INNER * CALL {g 1212} CALL {f 12} UP 1} {INNER * CALL {g 1313} CALL {f 13} UP 1}}
+
+test error-7.1 {Bug 1397843} -body {
+    variable cmds
+    proc EIWrite args {
+	variable cmds
+	lappend cmds [lindex [info level -2] 0]
+    }
+    proc BadProc {} {
+	set i a
+	incr i
+    }
+    trace add variable ::errorInfo write [namespace code EIWrite]
+    catch BadProc
+    trace remove variable ::errorInfo write [namespace code EIWrite]
+    set cmds
+} -match glob -result {*BadProc*}
+
+# throw tests
+
+test error-8.1 {throw produces error 1 at level 0} {
+    catch { throw FOO bar }
+} {1}
+test error-8.2 {throw behaves as error does at level 0} {
+    catch { throw FOO bar } em1 opts1
+    catch { error bar {} FOO } em2 opts2
+    dict set opts1 -result $em1
+    dict set opts2 -result $em2
+    foreach key {-code -level -result -errorcode} {
+	if { [dict get $opts1 $key] ne [dict get $opts2 $key] } {
+	    error "error/throw outcome differs on '$key'"
+	}
+    }
+} {}
+test error-8.3 {throw produces error 1 at level > 0} {
+    proc throw_foo {} {
+	throw FOO bar
+    }
+    catch { throw_foo }
+} {1}
+test error-8.4 {throw behaves as error does at level > 0} {
+    proc throw_foo {} {
+	throw FOO bar
+    }
+    proc error_foo {} {
+	error bar {} FOO
+    }
+    catch { throw_foo } em1 opts1
+    catch { error_foo } em2 opts2
+    dict set opts1 -result $em1
+    dict set opts2 -result $em2
+    foreach key {-code -level -result -errorcode} {
+	if { [dict get $opts1 $key] ne [dict get $opts2 $key] } {
+	    error "error/throw outcome differs on '$key'"
+	}
+    }
+} {}
+test error-8.5 {throw syntax checks} -returnCodes error -body {
+    throw
+} -result {wrong # args: should be "throw type message"}
+test error-8.6 {throw syntax checks} -returnCodes error -body {
+    throw a
+} -result {wrong # args: should be "throw type message"}
+test error-8.7 {throw syntax checks} -returnCodes error -body {
+    throw a b c
+} -result {wrong # args: should be "throw type message"}
+test error-8.8 {throw syntax checks} -returnCodes error -body {
+    throw "not a \{ list" foo
+} -result {unmatched open brace in list}
+test error-8.9 {throw syntax checks} -returnCodes error -body {
+    throw {} foo
+} -result {type must be non-empty list}
+test error-8.10 {Bug 33b7abb8a2: throw stack usage} -returnCodes error -body {
+    apply {code {throw $code foo}} {}
+} -result {type must be non-empty list}
+test error-8.11 {Bug 7174354ecb: throw error message} -returnCodes error  -body {
+    throw {not {}a list} x[]y
+} -result {list element in braces followed by "a" instead of space}
+
+# simple try tests: body completes with code ok
+
+test error-9.1 {try (ok, empty result) with no handlers} {
+    try list
+} {}
+test error-9.2 {try (ok, non-empty result) with no handlers} {
+    try { list a b c }
+} {a b c}
+test error-9.3 {try (ok, non-empty result) with trap handler} {
+    try { list a b c } trap {} {} { list d e f }
+} {a b c}
+test error-9.4 {try (ok, non-empty result) with on handler} {
+    try { list a b c } on break {} { list d e f }
+} {a b c}
+test error-9.5 {try (ok, non-empty result) with on ok handler} {
+    try { list a b c } on ok {} { list d e f }
+} {d e f}
+
+# simple try tests - "on" handler matching
+
+test error-10.1 {try with on ok} {
+    try { list a b c } on ok {} { list d e f }
+} {d e f}
+test error-10.2 {try with on 0} {
+    try { list a b c } on 0 {} { list d e f }
+} {d e f}
+test error-10.3 {try with on error (using error)} {
+    try { error a b c } on error {} { list d e f }
+} {d e f}
+test error-10.4 {try with on error (using return -code)} {
+    try { return -level 0 -code 1 a } on error {} { list d e f }
+} {d e f}
+test error-10.5 {try with on error (using throw)} {
+    try { throw c a } on error {} { list d e f }
+} {d e f}
+test error-10.6 {try with on 1 (using error)} {
+    try { error a b c } on 1 {} { list d e f }
+} {d e f}
+test error-10.7 {try with on return} {
+    try { return [list a b c] } on return {} { list d e f }
+} {d e f}
+test error-10.8 {try with on break} {
+    try { break } on break {} { list d e f }
+} {d e f}
+test error-10.9 {try with on continue} {
+    try { continue } on continue {} { list d e f }
+} {d e f}
+test error-10.10 {try with on for arbitrary (decimal) return code} {
+    try { return -level 0 -code 123456 } on 123456 {} { list d e f }
+} {d e f}
+test error-10.11 {try with on for arbitrary (hex) return code} {
+    try { return -level 0 -code 0x123456 } on 0x123456 {} { list d e f }
+} {d e f}
+test error-10.12 {try with on for arbitrary return code (mixed number representations)} {
+    try { return -level 0 -code 0x10 } on 16 {} { list d e f }
+} {d e f}
+
+# simple try tests - "trap" handler matching
+
+test error-11.1 {try with trap all} {
+    try { throw FOO bar  } trap {} {} { list d e f }
+} {d e f}
+test error-11.2 {try with trap (exact)} {
+    try { throw FOO bar  } trap {FOO} {} { list d e f }
+} {d e f}
+test error-11.3 {try with trap (prefix 1)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO} {} { list d e f }
+} {d e f}
+test error-11.4 {try with trap (prefix 2)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO A} {} { list d e f }
+} {d e f}
+test error-11.5 {try with trap (prefix 3)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO A B} {} { list d e f }
+} {d e f}
+test error-11.6 {try with trap (prefix 4)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO A B C} {} { list d e f }
+} {d e f}
+test error-11.7 {try with trap (exact, 5 elements)} {
+    try { throw [list FOO A B C D] bar  } trap {FOO A B C D} {} { list d e f }
+} {d e f}
+
+# simple try tests - variable assignment and result handling
+
+test error-12.1 {try with no variable assignment in on handler} {
+    try { throw FOO bar } on error {} { list d e f }
+} {d e f}
+test error-12.2 {try with result variable assignment in on handler} {
+    try { throw FOO bar } on error {res} { set res }
+} {bar}
+test error-12.3 {try with result variable assignment in on handler, var remains in scope} {
+    try { throw FOO bar } on error {res} { list d e f }
+    set res
+} {bar}
+test error-12.4 {try with result/opts variable assignment in on handler} {
+    try {
+	throw FOO bar
+    } on error {res opts} {
+	set r "$res,[dict get $opts -errorcode]"
+    }
+} {bar,FOO}
+test error-12.5 {try with result/opts variable assignment in on handler, vars remain in scope} {
+    try { throw FOO bar } on error {res opts} { list d e f }
+    set r "$res,[dict get $opts -errorcode]"
+} {bar,FOO}
+test error-12.6 {try result is propagated if no matching handler} {
+    try { list a b c } on error {} { list d e f }
+} {a b c}
+test error-12.7 {handler result is propagated if handler executes} {
+    try { throw FOO bar } on error {} { list d e f }
+} {d e f}
+
+# negative case try tests - bad args to try
+
+test error-13.1 {try with no arguments} -body {
+    # warning: error message may change
+    try
+} -returnCodes error -match glob -result {wrong # args: *}
+test error-13.2 {try with body only (ok)} {
+    try list
+} {}
+test error-13.3 {try with missing finally body} -body {
+    # warning: error message may change
+    try list finally
+} -returnCodes error -match glob -result {wrong # args to finally clause: *}
+test error-13.4 {try with bad handler keyword} -body {
+    # warning: error message may change
+    try list then a b c
+} -returnCodes error -match glob -result {bad handler *}
+test error-13.5 {try with partial handler #1} -body {
+    # warning: error message may change
+    try list on
+} -returnCodes error -match glob -result {wrong # args to on clause: *}
+test error-13.6 {try with partial handler #2} -body {
+    # warning: error message may change
+    try list on error
+} -returnCodes error -match glob -result {wrong # args to on clause: *}
+test error-13.7 {try with partial handler #3} -body {
+    # warning: error message may change
+    try list on error {em opts}
+} -returnCodes error -match glob -result {wrong # args to on clause: *}
+test error-13.8 {try with multiple handlers and finally (ok)} {
+    try list on error {} {} trap {} {} {} finally {}
+} {}
+test error-13.9 {last handler body can't be a fallthrough #1} -body {
+    try list on error {} {} on break {} -
+} -returnCodes error -result {last non-finally clause must not have a body of "-"}
+test error-13.10 {last handler body can't be a fallthrough #2} -body {
+    try list on error {} {} on break {} - finally { list d e f }
+} -returnCodes error -result {last non-finally clause must not have a body of "-"}
+
+# try tests - multiple handlers (left-to-right matching, only one runs)
+
+test error-14.1 {try with multiple handlers (only one matches) #1} {
+    try { throw FOO bar } on ok {} { list a b c } trap FOO {} { list d e f }
+} {d e f}
+test error-14.2 {try with multiple handlers (only one matches) #2} {
+    try { throw FOO bar } trap FOO {} { list d e f } on ok {} { list a b c }
+} {d e f}
+test error-14.3 {try with multiple handlers (only one matches) #3} {
+    try {
+	throw FOO bar
+    } on break {} {
+	list x y z
+    } trap FOO {} {
+	list d e f
+    } on ok {} {
+	list a b c
+    }
+} {d e f}
+test error-14.4 {try with multiple matching handlers (only the first in left-to-right order runs) #1} {
+    try { throw FOO bar } on error {} { list a b c } trap FOO {} { list d e f }
+} {a b c}
+test error-14.5 {try with multiple matching handlers (only the first in left-to-right order runs) #2} {
+    try { throw FOO bar } trap FOO {} { list d e f } on error {} { list a b c }
+} {d e f}
+test error-14.6 {try with multiple matching handlers (only the first in left-to-right order runs) #3} {
+    try { throw FOO bar } trap {} {} { list d e f } on 1 {} { list a b c }
+} {d e f}
+test error-14.7 {try with multiple matching handlers (only the first in left-to-right order runs) #4} {
+    try { throw FOO bar } on 1 {} { list a b c } trap {} {} { list d e f }
+} {a b c}
+test error-14.8 {try with handler-of-last-resort "trap {}"} {
+    try { throw FOO bar } trap FOX {} { list a b c } trap {} {} { list d e f }
+} {d e f}
+test error-14.9 {try with handler-of-last-resort "on error"} {
+    try { foo } trap FOX {} { list a b c } on error {} { list d e f }
+} {d e f}
+
+# try tests - propagation (no matching handlers)
+
+test error-15.1 {try with no handler (ok result propagates)} {
+    try { list a b c }
+} {a b c}
+test error-15.2 {try with no matching handler (ok result propagates)} {
+    try { list a b c } on error {} { list d e f }
+} {a b c}
+test error-15.3 {try with no handler (error result propagates)} -body {
+    try { throw FOO bar }
+} -returnCodes error -result {bar}
+test error-15.4 {try with no matching handler (error result propagates)} -body {
+    try { throw FOO bar } trap FOX {} { list a b c }
+} -returnCodes error -result {bar}
+test error-15.5 {try with no handler (return result propagates)} -body {
+    try { return bar }
+} -returnCodes 2 -result {bar}
+test error-15.6 {try with no matching handler (break result propagates)} -body {
+    try { if {1} break } on error {} { list a b c }
+} -returnCodes 3 -result {}
+test error-15.7 {try with no matching handler (unknown integer result propagates)} -body {
+    try { return -level 0 -code 123456 } trap {} {} { list a b c }
+} -returnCodes 123456 -result {}
+
+foreach level {0 1 2 3} {
+    foreach code {0 1 2 3 4 5} {
+
+	# Following cases have different -errorinfo; avoid false alarms
+	# TODO: examine whether these difference are as they ought to be.
+	if {$level == 0 && $code == 1} continue
+
+	foreach extras {{} {-bar soom}} {
+
+test error-15.8.$level.$code.[llength $extras] {[try] coverage} {
+    set script {return -level $level -code $code {*}$extras foo}
+    catch $script m1 o1
+    catch {try $script} m2 o2
+    set o1 [lsort -stride 2 $o1]
+    set o2 [lsort -stride 2 $o2]
+    expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"}
+} ok
+
+test error-15.9.$level.$code.[llength $extras] {[try] coverage} {
+    set script {return -level $level -code $code {*}$extras foo}
+    catch $script m1 o1
+    catch {try $script finally {}} m2 o2
+    set o1 [lsort -stride 2 $o1]
+    set o2 [lsort -stride 2 $o2]
+    expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"}
+} ok
+
+test error-15.10.$level.$code.[llength $extras] {[try] coverage} {
+    set script {return -level $level -code $code {*}$extras foo}
+    catch $script m1 o1
+    catch {try $script on $code {x y} {return -options $y $x}} m2 o2
+    set o1 [lsort -stride 2 $o1]
+    set o2 [lsort -stride 2 $o2]
+    expr {$o1 eq $o2 ? "ok" : "$o1\n\tis not equal to\n$o2"}
+} ok
+
+	}
+    }
+}
+
+# try tests - propagation (exceptions in handlers, exception chaining)
+
+test error-16.1 {try with successfully executed handler} {
+    try { throw FOO bar } trap FOO {} { list a b c }
+} {a b c}
+test error-16.2 {try with exception (error) in handler} -body {
+    try { throw FOO bar } trap FOO {} { throw BAR foo }
+} -returnCodes error -result {foo}
+test error-16.3 {try with exception (return) in handler} -body {
+    try { throw FOO bar } trap FOO {} { return BAR }
+} -returnCodes 2 -result {BAR}
+test error-16.4 {try with exception (break) in handler #1} -body {
+    try { throw FOO bar } trap FOO {} { break }
+} -returnCodes 3 -result {}
+test error-16.5 {try with exception (break) in handler #2} {
+    for { set i 5 } { $i < 10 } { incr i } {
+	try { throw FOO bar } trap FOO {} { break }
+    }
+    set i
+} {5}
+test error-16.6 {try with variable assignment and propagation #1} {
+    # Ensure that the handler variables preserve the exception off the
+    # try-body, and are not modified by the exception off the handler
+    catch {
+	try { throw FOO bar } trap FOO {em} { throw BAR baz }
+    }
+    set em
+} {bar}
+test error-16.7 {try with variable assignment and propagation #2} {
+    catch {
+	try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
+    }
+    list $em [dict get $opts -errorcode]
+} {bar FOO}
+test error-16.8 {exception chaining (try=ok, handler=error)} -body {
+    #FIXME is the intent of this test correct?
+    catch {
+	try { list a b c } on ok {em opts} { throw BAR baz }
+    } tryem tryopts
+    list $opts [dict get $tryopts -during]
+} -match pairwise -result equal
+test error-16.9 {exception chaining (try=error, handler=error)} -body {
+    # The exception off the handler should chain to the exception off the
+    # try-body (using the -during option)
+    catch {
+	try { throw FOO bar } trap {} {em opts} { throw BAR baz }
+    } tryem tryopts
+    list $opts [dict get $tryopts -during]
+} -match pairwise -result equal
+test error-16.10 {no exception chaining when handler is successful} {
+    catch {
+	try { throw FOO bar } trap {} {em opts} { list d e f }
+    } tryem tryopts
+    dict exists $tryopts -during
+} {0}
+test error-16.11 {no exception chaining when handler is a non-error exception} {
+    catch {
+	try { throw FOO bar } trap {} {em opts} { break }
+    } tryem tryopts
+    dict exists $tryopts -during
+} {0}
+test error-16.12 {compiled try with successfully executed handler} {
+    apply {{} {
+	try { throw FOO bar } trap FOO {} { list a b c }
+    }}
+} {a b c}
+test error-16.13 {compiled try with exception (error) in handler} -body {
+    apply {{} {
+	try { throw FOO bar } trap FOO {} { throw BAR foo }
+    }}
+} -returnCodes error -result {foo}
+test error-16.14 {compiled try with exception (return) in handler} -body {
+    apply {{} {
+	list [catch {
+	    try { throw FOO bar } trap FOO {} { return BAR }
+	} msg] $msg
+    }}
+} -result {2 BAR}
+test error-16.15 {compiled try with exception (break) in handler} {
+    apply {{} {
+	for { set i 5 } { $i < 10 } { incr i } {
+	    try { throw FOO bar } trap FOO {} { break }
+	}
+	return $i
+    }}
+} {5}
+test error-16.16 {compiled try with exception (continue) in handler} {
+    apply {{} {
+	for { set i 5 } { $i < 10 } { incr i } {
+	    try { throw FOO bar } trap FOO {} { continue }
+	    incr i 20
+	}
+	return $i
+    }}
+} {10}
+test error-16.17 {compiled try with variable assignment and propagation #1} {
+    # Ensure that the handler variables preserve the exception off the
+    # try-body, and are not modified by the exception off the handler
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap FOO {em} { throw BAR baz }
+	}
+	return $em
+    }}
+} {bar}
+test error-16.18 {compiled try with variable assignment and propagation #2} {
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap FOO {em opts} { throw BAR baz }
+	}
+	list $em [dict get $opts -errorcode]
+    }}
+} {bar FOO}
+test error-16.19 {compiled try exception chaining (try=ok, handler=error)} -body {
+    #FIXME is the intent of this test correct?
+    apply {{} {
+	catch {
+	    try { list a b c } on ok {em opts} { throw BAR baz }
+	} tryem tryopts
+	list $opts [dict get $tryopts -during]
+    }}
+} -match pairwise -result equal
+test error-16.20 {compiled try exception chaining (try=error, handler=error)} -body {
+    # The exception off the handler should chain to the exception off the
+    # try-body (using the -during option)
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap {} {em opts} { throw BAR baz }
+	} tryem tryopts
+	list $opts [dict get $tryopts -during]
+    }}
+} -match pairwise -result equal
+test error-16.21 {compiled try exception chaining (try=error, finally=error)} {
+    # The exception off the handler should chain to the exception off the
+    # try-body (using the -during option)
+    apply {{} {
+	catch {
+	    try { throw FOO bar } finally { throw BAR baz }
+	} tryem tryopts
+	dict get $tryopts -during -errorcode
+    }}
+} FOO
+test error-16.22 {compiled try: no exception chaining when handler is successful} {
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap {} {em opts} { list d e f }
+	} tryem tryopts
+	dict exists $tryopts -during
+    }}
+} {0}
+test error-16.23 {compiled try: no exception chaining when handler is a non-error exception} {
+    apply {{} {
+	catch {
+	    try { throw FOO bar } trap {} {em opts} { break }
+	} tryem tryopts
+	dict exists $tryopts -during
+    }}
+} {0}
+test error-16.24 {compiled try exception chaining (try=ok, handler=error, finally=error)} -body {
+    apply {{} {
+	catch {
+	    try {
+		list a b c
+	    } on ok {em opts} {
+		throw BAR baz
+	    } finally {
+		throw DING dong
+	    }
+	} tryem tryopts
+	list $opts [dict get $tryopts -during -during]
+    }}
+} -match pairwise -result equal
+test error-16.25 {compiled try exception chaining (all errors)} -body {
+    apply {{} {
+	catch {
+	    try {
+		throw FOO bar
+	    } on error {em opts} {
+		throw BAR baz
+	    } finally {
+		throw DING dong
+	    }
+	} tryem tryopts
+	list $opts [dict get $tryopts -during -during]
+    }}
+} -match pairwise -result equal
+
+# try tests - finally
+
+test error-17.1 {finally always runs (try with ok result)} {
+    set RES {}
+    try { list a b c } finally { set RES done }
+    set RES
+} {done}
+test error-17.2 {finally always runs (try with error result)} {
+    set RES {}
+    catch {
+	try { throw FOO bar } finally { set RES done }
+    }
+    set RES
+} {done}
+test error-17.3 {finally always runs (try with matching handler)} {
+    set RES {}
+    try { throw FOO bar } trap FOO {} { list a b c } finally { set RES done }
+    set RES
+} {done}
+test error-17.4 {finally always runs (try with exception in handler)} {
+    set RES {}
+    catch {
+	try {
+	    throw FOO bar
+	} trap FOO {} {
+	    throw BAR baz
+	} finally {
+	    set RES done
+	}
+    }
+    set RES
+} {done}
+test error-17.5 {successful finally doesn't modify try outcome (try=ok)} {
+    try { list a b c } finally { list d e f }
+} {a b c}
+test error-17.6 {successful finally doesn't modify try outcome (try=return)} -body {
+    try { return c } finally { list d e f }
+} -returnCodes 2 -result {c}
+test error-17.7 {successful finally doesn't modify try outcome (try=error)} -body {
+    try { error bar } finally { list d e f }
+} -returnCodes 1 -result {bar}
+test error-17.8 {successful finally doesn't modify handler outcome (handler=ok)} {
+    try { throw FOO bar } trap FOO {} { list a b c } finally { list d e f }
+} {a b c}
+test error-17.9 {successful finally doesn't modify handler outcome (handler=error)} -body {
+    try { throw FOO bar } trap FOO {} { throw BAR baz } finally { list d e f }
+} -returnCodes error -result {baz}
+test error-17.10 {successful finally doesn't affect variable assignment} {
+    catch {
+	try { throw FOO bar } trap FOO {em opts} { list d e f } finally { list d e f }
+    } result
+    list $em $result
+} {bar {d e f}}
+test error-17.11 {successful finally doesn't affect variable assignment or propagation} {
+    catch {
+	try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { list d e f }
+    }
+    list $em [dict get $opts -errorcode]
+} {bar FOO}
+
+# try tests - propagation (exceptions in finally, exception chaining)
+
+test error-18.1 {try (ok) with exception in finally (error)} -body {
+    try { list a b c } finally { throw BAR foo }
+} -returnCodes error -result {foo}
+test error-18.2 {try (error) with exception in finally (break)} -body {
+    try { throw FOO bar } finally { break }
+} -returnCodes 3 -result {}
+test error-18.3 {try (ok) with handler (ok) and exception in finally (error)} -body {
+    try { list a b c } on ok {} { list d e f } finally { throw BAR foo }
+} -returnCodes error -result {foo}
+test error-18.4 {try (error) with exception in handler (error) and in finally (arb code)} -body {
+    try { throw FOO bar } on error {} { throw BAR baz } finally { return -level 0 -code 99 zing }
+} -returnCodes 99 -result {zing}
+test error-18.5 {exception in finally doesn't affect variable assignment} {
+    catch {
+	try { throw FOO bar } trap FOO {em opts} { throw BAR baz } finally { throw BAZ zing }
+    }
+    list $em [dict get $opts -errorcode]
+} {bar FOO}
+test error-18.6 {exception chaining in finally (try=ok)} -body {
+    catch {
+	list a b c
+    } em expopts
+    catch {
+	try { list a b c } finally { throw BAR foo }
+    } em opts
+    list $expopts [dict get $opts -during]
+} -match pairwise -result equal
+test error-18.7 {exception chaining in finally (try=error)} {
+    catch {
+	try { throw FOO bar } finally { throw BAR baz }
+    } em opts
+    dict get $opts -during -errorcode
+} {FOO}
+test error-18.8 {exception chaining in finally (try=ok, handler=ok)} {
+    catch {
+	try { list a b c } on ok {} { list d e f } finally { throw BAR baz }
+    } em opts
+    list [dict get $opts -during -code] [dict exists $opts -during -during]
+} {0 0}
+test error-18.9 {exception chaining in finally (try=error, handler=ok)} {
+    catch {
+	try {
+	    throw FOO bar
+	} on error {} {
+	    list d e f
+	} finally {
+	    throw BAR baz
+	}
+    } em opts
+    list [dict get $opts -during -code] [dict exists $opts -during -during]
+} {0 0}
+test error-18.10 {exception chaining in finally (try=error, handler=error)} {
+    catch {
+	try {
+	    throw FOO bar
+	} on error {} {
+	    throw BAR baz
+	} finally {
+	    throw BAR baz
+	}
+    } em opts
+    list [dict get $opts -during -errorcode] [dict get $opts -during -during -errorcode]
+} {BAR FOO}
+test error-18.11 {no exception chaining if finally produces a non-error exception} {
+    catch {
+	try { throw FOO bar } on error {} { throw BAR baz } finally { break }
+    } em opts
+    dict exists $opts -during
+} {0}
+test error-18.12 {variable assignment unaffected by exception in finally} {
+    catch {
+	try {
+	    throw FOO bar
+	} on error {em opts} {
+	    list a b c
+	} finally {
+	    throw BAR baz
+	}
+    }
+    list $em [dict get $opts -errorcode]
+} {bar FOO}
+
+# try tests - fallthough body cases
+
+test error-19.1 {try with fallthrough body #1} {
+    set RES {}
+    try { list a b c } on ok { set RES 0 } - on error {} { set RES 1 }
+    set RES
+} {1}
+test error-19.2 {try with fallthrough body #2} {
+    set RES {}
+    try {
+	throw FOO bar
+    } trap BAR {} {
+    } trap FOO {} - trap {} {} {
+	set RES foo
+    } on error {} {
+	set RES err
+    }
+    set RES
+} {foo}
+test error-19.3 {try with cascade fallthrough} {
+    set RES {}
+    try {
+	throw FOO bar
+    } trap FOO {} - trap BAR {} - trap {} {} {
+	set RES trap
+    } on error {} { set RES err }
+    set RES
+} {trap}
+test error-19.4 {multiple unrelated fallthroughs #1} {
+    set RES {}
+    try {
+	throw FOO bar
+    } trap FOO {} - trap BAR {} {
+	set RES foo
+    } trap {} {} - on error {} {
+	set RES err
+    }
+    set RES
+} {foo}
+test error-19.5 {multiple unrelated fallthroughs #2} {
+    set RES {}
+    try {
+	throw BAZ zing
+    } trap FOO {} - trap BAR {} {
+	set RES foo
+    } trap {} {} - on error {} {
+	set RES err
+    }
+    set RES
+} {err}
+proc addmsg msg {
+    variable RES
+    lappend RES $msg
+}
+test error-19.6 {compiled try executes all clauses} -setup {
+    set RES {}
+} -body {
+    apply {{} {
+	try {
+	    addmsg a
+	    throw bar hello
+	} trap bar {res opt} {
+	    addmsg b
+	} finally {
+	    addmsg c
+	}
+	addmsg d
+    } ::tcl::test::error}
+} -cleanup {
+    unset RES
+} -result {a b c d}
+test error-19.7 {compiled try executes all clauses} -setup {
+    set RES {}
+} -body {
+    apply {{} {
+	try {
+	    addmsg a
+	} on error {res opt} {
+	    addmsg b
+	} on ok {} {
+	    addmsg c
+	} finally {
+	    addmsg d
+	}
+	addmsg e
+    } ::tcl::test::error}
+} -cleanup {
+    unset RES
+} -result {a c d e}
+test error-19.8 {compiled try executes all clauses} -setup {
+    set RES {}
+} -body {
+    apply {{} {
+	try {
+	    addmsg a
+	    throw bar hello
+	} trap bar {res opt} {
+	    addmsg b
+	}
+	addmsg c
+    } ::tcl::test::error}
+} -cleanup {
+    unset RES
+} -result {a b c}
+test error-19.9 {compiled try executes all clauses} -setup {
+    set RES {}
+} -body {
+    apply {{} {
+	try {
+	    addmsg a
+	} on error {res opt} {
+	    addmsg b
+	} on ok {} {
+	    addmsg c
+	}
+	addmsg d
+    } ::tcl::test::error}
+} -cleanup {
+    unset RES
+} -result {a c d}
+test error-19.10 {compiled try with chained clauses} -setup {
+    set RES {}
+} -body {
+    list [apply {{} {
+	try {
+	    return good
+	} on return {res} - on ok {res} {
+	    addmsg ok
+	    addmsg $res
+	    return handler
+	} finally {
+	    addmsg finally
+	}
+    } ::tcl::test::error}] $RES
+} -cleanup {
+    unset RES
+} -result {handler {ok good finally}}
+test error-19.11 {compiled try and errors on variable write} -setup {
+    set RES {}
+} -body {
+    apply {{} {
+	array set foo {bar boo}
+	set bar unset
+	catch {
+	    try {
+		addmsg body
+		return a
+	    } on return {bar foo} {
+		addmsg handler
+		return b
+	    } finally {
+		addmsg finally,$bar
+	    }
+	} msg
+	addmsg $msg
+    } ::tcl::test::error}
+} -cleanup {
+    unset RES
+} -result {body finally,a {can't set "foo": variable is array}}
+test error-19.12 {interpreted try and errors on variable write} -setup {
+    set RES {}
+} -body {
+    apply {try {
+	array set foo {bar boo}
+	set bar unset
+	catch {
+	    $try {
+		addmsg body
+		return a
+	    } on return {bar foo} {
+		addmsg handler
+		return b
+	    } finally {
+		addmsg finally,$bar
+	    }
+	} msg
+	addmsg $msg
+    } ::tcl::test::error} try
+} -cleanup {
+    unset RES
+} -result {body finally,a {can't set "foo": variable is array}}
+test error-19.13 {compiled try and errors on variable write} -setup {
+    set RES {}
+} -body {
+    apply {{} {
+	array set foo {bar boo}
+	set bar unset
+	catch {
+	    try {
+		addmsg body
+		return a
+	    } on return {bar foo} - on error {bar foo} {
+		addmsg handler
+		return b
+	    } finally {
+		addmsg finally,$bar
+	    }
+	} msg
+	addmsg $msg
+    } ::tcl::test::error}
+} -cleanup {
+    unset RES
+} -result {body finally,a {can't set "foo": variable is array}}
+rename addmsg {}
+
+# FIXME test what vars get set on fallthough ... what is the correct behavior?
+# It would seem appropriate to set at least those for the matching handler and
+# the executed body; possibly for each handler we fall through as well?
+
+# negative case try tests - bad "on" handler
+
+test error-20.1 {bad code name in on handler} -body {
+    try { list a b c } on err {} {}
+} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
+test error-20.2 {bad code value in on handler} -body {
+    try { list a b c } on 34985723094872345 {} {}
+} -returnCodes error -match glob -result {bad completion code "34985723094872345": must be ok, error, return, break, continue*, or an integer}
+
+test error-21.1 {memory leaks in try: Bug 2910044} memory {
+    leaktest {
+	try {string repeat x 10} on ok {} {}
+    }
+} 0
+test error-21.2 {memory leaks in try: Bug 2910044} memory {
+    leaktest {
+	try {error [string repeat x 10]} on error {} {}
+    }
+} 0
+test error-21.3 {memory leaks in try: Bug 2910044} memory {
+    leaktest {
+	try {throw FOO [string repeat x 10]} trap FOO {} {}
+    }
+} 0
+test error-21.4 {memory leaks in try: Bug 2910044} memory {
+    leaktest {
+	try {string repeat x 10}
+    }
+} 0
+test error-21.5 {memory leaks in try: Bug 2910044} memory {
+    leaktest {
+	try {string repeat x 10} on ok {} {} finally {string repeat y 10}
+    }
+} 0
+test error-21.6 {memory leaks in try: Bug 2910044} memory {
+    leaktest {
+	try {
+	    error [string repeat x 10]
+	} on error {} {} finally {
+	    string repeat y 10
+	}
+    }
+} 0
+test error-21.7 {memory leaks in try: Bug 2910044} memory {
+    leaktest {
+	try {
+	    throw FOO [string repeat x 10]
+	} trap FOO {} {} finally {
+	    string repeat y 10
+	}
+    }
+} 0
+test error-21.8 {memory leaks in try: Bug 2910044} memory {
+    leaktest {
+	try {string repeat x 10} finally {string repeat y 10}
+    }
+} 0
+
+# negative case try tests - bad "trap" handler
+# what is the effect if we attempt to trap an errorcode that is not a list?
+# nested try
+# catch inside try
+# no tests for bad varslist?
+# -errorcode but code!=1 doesn't trap
+# throw negative case tests (no args, too many args, etc)
+
+}
+namespace delete ::tcl::test::error
 
 # cleanup
 catch {rename p ""}
 ::tcltest::cleanupTests
-return 
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/eval.test b/tests/eval.test
index 22de6af..70ceac8 100644
--- a/tests/eval.test
+++ b/tests/eval.test
@@ -1,23 +1,21 @@
 # Commands covered:  eval
 #
-# 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.
-#
-# RCS: @(#) $Id: eval.test,v 1.6 2004/05/19 12:23:13 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-
+
 test eval-1.1 {single argument} {
     eval {format 22}
 } 22
@@ -47,7 +45,7 @@ test eval-2.5 {error in eval'ed command: setting errorInfo} {
 	set a 1
 	error "test error"
     }} msg
-    set errorInfo
+    set ::errorInfo
 } "test error
     while executing
 \"error \"test error\"\"
@@ -58,6 +56,34 @@ test eval-2.5 {error in eval'ed command: setting errorInfo} {
 	error \"test error\"
     }\""
 
+test eval-3.1 {eval and pure lists} {
+    eval [list list 1 2 3 4 5]
+} {1 2 3 4 5}
+test eval-3.2 {concatenating eval and pure lists} {
+    eval [list list 1] [list 2 3 4 5]
+} {1 2 3 4 5}
+test eval-3.3 {eval and canonical lists} {
+    set cmd [list list 1 2 3 4 5]
+    # Force existance of utf-8 rep
+    set dummy($cmd) $cmd
+    unset dummy
+    eval $cmd
+} {1 2 3 4 5}
+test eval-3.4 {concatenating eval and canonical lists} {
+    set cmd  [list list 1]
+    set cmd2 [list 2 3 4 5]
+    # Force existance of utf-8 rep
+    set dummy($cmd) $cmd
+    set dummy($cmd2) $cmd2
+    unset dummy
+    eval $cmd $cmd2
+} {1 2 3 4 5}
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/event.test b/tests/event.test
index 0cf627b..0d1b06c 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -1,46 +1,54 @@
 # This file contains a collection of tests for the procedures in the file
-# tclEvent.c, which includes the "update", and "vwait" Tcl
-# commands.  Sourcing this file into Tcl runs the tests and generates
-# output for errors.  No output means no errors were found.
+# tclEvent.c, which includes the "update", and "vwait" Tcl commands.  Sourcing
+# this file into Tcl runs the tests and generates output for errors.  No
+# output means no errors were found.
 #
 # Copyright (c) 1995-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.
-#
-# RCS: @(#) $Id: event.test,v 1.20 2002/07/10 11:56:44 dgp Exp $
 
 package require tcltest 2
 namespace import -force ::tcltest::*
 
+catch {
+    ::tcltest::loadTestedCommands
+    package require -exact Tcltest [info patchlevel]
+    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
+}
+
+
 testConstraint testfilehandler [llength [info commands testfilehandler]]
 testConstraint testexithandler [llength [info commands testexithandler]]
 testConstraint testfilewait [llength [info commands testfilewait]]
-
-test event-1.1 {Tcl_CreateFileHandler, reading} {testfilehandler} {
+testConstraint exec [llength [info commands exec]]
+
+test event-1.1 {Tcl_CreateFileHandler, reading} -setup {
     testfilehandler close
+    set result ""
+} -constraints {testfilehandler} -body {
     testfilehandler create 0 readable off
     testfilehandler clear 0
     testfilehandler oneevent
-    set result ""
     lappend result [testfilehandler counts 0]
     testfilehandler fillpartial 0
     testfilehandler oneevent
     lappend result [testfilehandler counts 0]
     testfilehandler oneevent
     lappend result [testfilehandler counts 0]
+} -cleanup {
     testfilehandler close
-    set result
-} {{0 0} {1 0} {2 0}}
-test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
-    # This test is non-portable because on some systems (e.g.
-    # SunOS 4.1.3) pipes seem to be writable always.
+} -result {{0 0} {1 0} {2 0}}
+test event-1.2 {Tcl_CreateFileHandler, writing} -setup {
     testfilehandler close
+    set result ""
+} -constraints {testfilehandler nonPortable} -body {
+    # This test is non-portable because on some systems (e.g., SunOS 4.1.3)
+    # pipes seem to be writable always.
     testfilehandler create 0 off writable
     testfilehandler clear 0
     testfilehandler oneevent
-    set result ""
     lappend result [testfilehandler counts 0]
     testfilehandler fillpartial 0
     testfilehandler oneevent
@@ -48,16 +56,17 @@ test event-1.2 {Tcl_CreateFileHandler, writing} {testfilehandler nonPortable} {
     testfilehandler fill 0
     testfilehandler oneevent
     lappend result [testfilehandler counts 0]
+} -cleanup {
     testfilehandler close
-    set result
-} {{0 1} {0 2} {0 2}}
-test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
+} -result {{0 1} {0 2} {0 2}}
+test event-1.3 {Tcl_DeleteFileHandler} -setup {
     testfilehandler close
+    set result ""
+} -constraints {testfilehandler nonPortable} -body {
     testfilehandler create 2 disabled disabled
     testfilehandler create 1 readable writable
     testfilehandler create 0 disabled disabled
     testfilehandler fillpartial 1
-    set result ""
     testfilehandler oneevent
     lappend result [testfilehandler counts 1]
     testfilehandler oneevent
@@ -67,16 +76,17 @@ test event-1.3 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
     testfilehandler create 1 off off
     testfilehandler oneevent
     lappend result [testfilehandler counts 1]
+} -cleanup {
     testfilehandler close
-    set result
-} {{0 1} {1 1} {1 2} {0 0}}
+} -result {{0 1} {1 1} {1 2} {0 0}}
 
-test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
+test event-2.1 {Tcl_DeleteFileHandler} -setup {
     testfilehandler close
+    set result ""
+} -constraints {testfilehandler nonPortable} -body {
     testfilehandler create 2 disabled disabled
     testfilehandler create 1 readable writable
     testfilehandler fillpartial 1
-    set result ""
     testfilehandler oneevent
     lappend result [testfilehandler counts 1]
     testfilehandler oneevent
@@ -86,43 +96,44 @@ test event-2.1 {Tcl_DeleteFileHandler} {testfilehandler nonPortable} {
     testfilehandler create 1 off off
     testfilehandler oneevent
     lappend result [testfilehandler counts 1]
+} -cleanup {
     testfilehandler close
-    set result
-} {{0 1} {1 1} {1 2} {0 0}}
-test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} \
-	{testfilehandler nonPortable} {
+} -result {{0 1} {1 1} {1 2} {0 0}}
+test event-2.2 {Tcl_DeleteFileHandler, fd reused & events still pending} -setup {
     testfilehandler close
+    set result ""
+} -constraints {testfilehandler nonPortable} -body {
     testfilehandler create 0 readable writable
     testfilehandler fillpartial 0
-    set result ""
     testfilehandler oneevent
     lappend result [testfilehandler counts 0]
     testfilehandler close
     testfilehandler create 0 readable writable
     testfilehandler oneevent
     lappend result [testfilehandler counts 0]
+} -cleanup {
     testfilehandler close
-    set result
-} {{0 1} {0 0}}
+} -result {{0 1} {0 0}}
 
-test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off } {testfilehandler} {
+test event-3.1 {FileHandlerCheckProc, TCL_FILE_EVENTS off} -setup {
     testfilehandler close
+} -constraints {testfilehandler} -body {
     testfilehandler create 1 readable writable
     testfilehandler fillpartial 1
     testfilehandler windowevent
-    set result [testfilehandler counts 1]
+    testfilehandler counts 1
+} -cleanup {
     testfilehandler close
-    set result
-} {0 0}
+} -result {0 0}
 
-test event-4.1 {FileHandlerEventProc, race between event and disabling} \
-	{testfilehandler nonPortable} {
+test event-4.1 {FileHandlerEventProc, race between event and disabling} -setup {
     update
     testfilehandler close
+    set result ""
+} -constraints {testfilehandler nonPortable} -body {
     testfilehandler create 2 disabled disabled
     testfilehandler create 1 readable writable
     testfilehandler fillpartial 1
-    set result ""
     testfilehandler oneevent
     lappend result [testfilehandler counts 1]
     testfilehandler oneevent
@@ -132,13 +143,13 @@ test event-4.1 {FileHandlerEventProc, race between event and disabling} \
     testfilehandler create 1 disabled disabled
     testfilehandler oneevent
     lappend result [testfilehandler counts 1]
+} -cleanup {
     testfilehandler close
-    set result
-} {{0 1} {1 1} {1 2} {0 0}}
-test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
-	{testfilehandler nonPortable} {
+} -result {{0 1} {1 1} {1 2} {0 0}}
+test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} -setup {
     update
     testfilehandler close
+} -constraints {testfilehandler nonPortable} -body {
     testfilehandler create 1 readable writable
     testfilehandler create 2 readable writable
     testfilehandler fillpartial 1
@@ -148,13 +159,14 @@ test event-4.2 {FileHandlerEventProc, TCL_FILE_EVENTS off} \
     lappend result [testfilehandler counts 1] [testfilehandler counts 2]
     testfilehandler windowevent
     lappend result [testfilehandler counts 1] [testfilehandler counts 2]
+} -cleanup {
     testfilehandler close
-    set result
-} {{0 0} {0 1} {0 0} {0 1}}
+} -result {{0 0} {0 1} {0 0} {0 1}}
 update
 
-test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
+test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} -setup {
     catch {rename bgerror {}}
+} -body {
     proc bgerror msg {
 	global errorInfo errorCode x
 	lappend x [list $msg $errorInfo $errorCode]
@@ -164,18 +176,19 @@ test event-5.1 {Tcl_BackgroundError, HandleBgErrors procedures} {
     after idle {set errorInfo foobar; set errorCode xyzzy}
     set x {}
     update idletasks
+    regsub -all [file join {} non_existent] $x "non_existent"
+} -cleanup {
     rename bgerror {}
-    regsub -all [file join {} non_existent] $x "non_existent" x
-    set x
-} {{{a simple error} {a simple error
+} -result {{{a simple error} {a simple error
     while executing
 "error "a simple error""
     ("after" script)} NONE} {{couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
     while executing
 "open non_existent"
     ("after" script)} {POSIX ENOENT {no such file or directory}}}}
-test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
+test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} -setup {
     catch {rename bgerror {}}
+} -body {
     proc bgerror msg {
 	global x
 	lappend x $msg
@@ -185,14 +198,102 @@ test event-5.2 {Tcl_BackgroundError, HandleBgErrors procedures} {
     after idle {open non_existent}
     set x {}
     update idletasks
+    return $x
+} -cleanup {
+    rename bgerror {}
+} -result {{a simple error}}
+test event-5.3 {HandleBgErrors: [Bug 1670155]} -setup {
+    variable x
+    proc demo args {variable x done}
+    variable target [list [namespace which demo] x]
+    proc trial args {variable target; string length $target}
+    trace add execution demo enter [namespace code trial]
+    variable save [interp bgerror {}]
+    interp bgerror {} $target
+} -body {
+    after 0 {error bar}
+    vwait [namespace which -variable x]
+} -cleanup {
+    interp bgerror {} $save
+    unset x target save
+    rename demo {}
+    rename trial {}
+} -result {}
+test event-5.3.1 {Default [interp bgerror] handler} -body {
+    ::tcl::Bgerror
+} -returnCodes error -match glob -result {*msg options*}
+test event-5.4 {Default [interp bgerror] handler} -body {
+    ::tcl::Bgerror {}
+} -returnCodes error -match glob -result {*msg options*}
+test event-5.5 {Default [interp bgerror] handler} -body {
+    ::tcl::Bgerror {} {} {}
+} -returnCodes error -match glob -result {*msg options*}
+test event-5.6 {Default [interp bgerror] handler} -body {
+    ::tcl::Bgerror {} {}
+} -returnCodes error -match glob -result {*-level*}
+test event-5.7 {Default [interp bgerror] handler} -body {
+    ::tcl::Bgerror {} {-level foo}
+} -returnCodes error -match glob -result {*expected integer*}
+test event-5.8 {Default [interp bgerror] handler} -body {
+    ::tcl::Bgerror {} {-level 0}
+} -returnCodes error -match glob -result {*-code*}
+test event-5.9 {Default [interp bgerror] handler} -body {
+    ::tcl::Bgerror {} {-level 0 -code ok}
+} -returnCodes error -match glob -result {*expected integer*}
+test event-5.10 {Default [interp bgerror] handler} -body {
+    proc bgerror {m} {append ::res $m}
+    set ::res {}
+    ::tcl::Bgerror {} {-level 0 -code 0}
+    return $::res
+} -cleanup {
+    rename bgerror {}
+} -result {}
+test event-5.11 {Default [interp bgerror] handler} -body {
+    proc bgerror {m} {append ::res $m}
+    set ::res {}
+    ::tcl::Bgerror msg {-level 0 -code 1}
+    return $::res
+} -cleanup {
+    rename bgerror {}
+} -result {msg}
+test event-5.12 {Default [interp bgerror] handler} -body {
+    proc bgerror {m} {append ::res $m}
+    set ::res {}
+    ::tcl::Bgerror msg {-level 0 -code 2}
+    return $::res
+} -cleanup {
+    rename bgerror {}
+} -result {command returned bad code: 2}
+test event-5.13 {Default [interp bgerror] handler} -body {
+    proc bgerror {m} {append ::res $m}
+    set ::res {}
+    ::tcl::Bgerror msg {-level 0 -code 3}
+    return $::res
+} -cleanup {
+    rename bgerror {}
+} -result {invoked "break" outside of a loop}
+test event-5.14 {Default [interp bgerror] handler} -body {
+    proc bgerror {m} {append ::res $m}
+    set ::res {}
+    ::tcl::Bgerror msg {-level 0 -code 4}
+    return $::res
+} -cleanup {
     rename bgerror {}
-    set x
-} {{a simple error}}
+} -result {invoked "continue" outside of a loop}
+test event-5.15 {Default [interp bgerror] handler} -body {
+    proc bgerror {m} {append ::res $m}
+    set ::res {}
+    ::tcl::Bgerror msg {-level 0 -code 5}
+    return $::res
+} -cleanup {
+    rename bgerror {}
+} -result {command returned bad code: 5}
 
-test event-6.1 {BgErrorDeleteProc procedure} {
+test event-6.1 {BgErrorDeleteProc procedure} -setup {
     catch {interp delete foo}
     interp create foo
     set erroutfile [makeFile Unmodified err.out]
+} -body {
     foo eval [list set erroutfile $erroutfile]
     foo eval {
 	proc bgerror args {
@@ -211,102 +312,135 @@ test event-6.1 {BgErrorDeleteProc procedure} {
     set f [open $erroutfile r]
     set result [read $f]
     close $f
+    return $result
+} -cleanup {
     removeFile $erroutfile
-    set result
-} {Unmodified
+} -result {Unmodified
 }
 
 test event-7.1 {bgerror / regular} {
     set errRes {}
     proc bgerror {err} {
-	global errRes;
-	set errRes $err;
+	global errRes
+	set errRes $err
     }
     after 0 {error err1}
-    vwait errRes;
-    set errRes;
+    vwait errRes
+    return $errRes
 } err1
-
 test event-7.2 {bgerror / accumulation} {
     set errRes {}
     proc bgerror {err} {
-	global errRes;
-	lappend errRes $err;
+	global errRes
+	lappend errRes $err
     }
     after 0 {error err1}
     after 0 {error err2}
     after 0 {error err3}
     update
-    set errRes;
+    return $errRes
 } {err1 err2 err3}
-
 test event-7.3 {bgerror / accumulation / break} {
     set errRes {}
     proc bgerror {err} {
-	global errRes;
-	lappend errRes $err;
-	return -code break "skip!";
+	global errRes
+	lappend errRes $err
+	return -code break "skip!"
     }
     after 0 {error err1}
     after 0 {error err2}
     after 0 {error err3}
     update
-    set errRes;
+    return $errRes
 } err1
-
-test event-7.4 {tkerror is nothing special anymore to tcl} {
+test event-7.4 {tkerror is nothing special anymore to tcl} -body {
     set errRes {}
     # we don't just rename bgerror to empty because it could then
     # be autoloaded...
     proc bgerror {err} {
-	global errRes;
-	lappend errRes "bg:$err";
+	global errRes
+	lappend errRes "bg:$err"
     }
     proc tkerror {err} {
-	global errRes;
-	lappend errRes "tk:$err";
+	global errRes
+	lappend errRes "tk:$err"
     }
     after 0 {error err1}
     update
+    return $errRes
+} -cleanup {
     rename tkerror {}
-    set errRes
-} bg:err1
-
-testConstraint exec [llength [info commands exec]]
-
-test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} {exec} {
-    set script {
+} -result bg:err1
+test event-7.5 {correct behaviour when there is no bgerror [Bug 219142]} -body {
+    exec [interpreter] << {
 	after 1000 error hello
 	after 2000 set a 0
 	vwait a
     }
-
-    list [catch {exec [interpreter] << $script} errMsg] $errMsg
-} {1 {hello
+} -constraints {exec} -returnCodes error -result {hello
     while executing
 "error hello"
-    ("after" script)}}
-
+    ("after" script)}
+test event-7.6 {safe hidden bgerror fallback} -setup {
+    variable result {}
+    interp create -safe safe
+} -body {
+    safe alias puts puts
+    safe alias result ::append [namespace which -variable result]
+    safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
+    safe hide bgerror
+    safe eval after 0 error foo
+    update
+    return $result
+} -cleanup {
+    interp delete safe
+} -result {foo
+NONE
+foo
+    while executing
+"error foo"
+    ("after" script)
+}
+test event-7.7 {safe hidden bgerror fallback} -setup {
+    variable result {}
+    interp create -safe safe
+} -body {
+    safe alias puts puts
+    safe alias result ::append [namespace which -variable result]
+    safe eval {proc bgerror m {result $m\n$::errorCode\n$::errorInfo\n}}
+    safe hide bgerror
+    safe eval {proc bgerror m {error bar soom baz}}
+    safe eval after 0 error foo
+    update
+    return $result
+} -cleanup {
+    interp delete safe
+} -result {foo
+NONE
+foo
+    while executing
+"error foo"
+    ("after" script)
+}
 
-# someday : add a test checking that 
-# when there is no bgerror, an error msg goes to stderr
-# ideally one would use sub interp and transfer a fake stderr
-# to it, unfortunatly the current interp tcl API does not allow
-# that. the other option would be to use fork a test but it
-# then becomes more a file/exec test than a bgerror test.
+# someday : add a test checking that when there is no bgerror, an error msg
+# goes to stderr ideally one would use sub interp and transfer a fake stderr
+# to it, unfortunatly the current interp tcl API does not allow that. The
+# other option would be to use fork a test but it then becomes more a
+# file/exec test than a bgerror test.
 
 # end of bgerror tests
 catch {rename bgerror {}}
 
-
 test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
     set child [open |[list [interpreter]] r+]
+    puts $child "catch {load $::tcltestlib Tcltest}"
     puts $child "testexithandler create 41; testexithandler create 4"
     puts $child "testexithandler create 6; exit"
     flush $child
     set result [read $child]
     close $child
-    set result
+    return $result
 } {even 6
 even 4
 odd 41
@@ -314,77 +448,83 @@ odd 41
 
 test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
     set child [open |[list [interpreter]] r+]
+    puts $child "catch {load $::tcltestlib Tcltest}"
     puts $child "testexithandler create 41; testexithandler create 4"
     puts $child "testexithandler create 6; testexithandler delete 41"
     puts $child "testexithandler create 16; exit"
     flush $child
     set result [read $child]
     close $child
-    set result
+    return $result
 } {even 16
 even 6
 even 4
 }
 test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
     set child [open |[list [interpreter]] r+]
+    puts $child "catch {load $::tcltestlib Tcltest}"
     puts $child "testexithandler create 41; testexithandler create 4"
     puts $child "testexithandler create 6; testexithandler delete 4"
     puts $child "testexithandler create 16; exit"
     flush $child
     set result [read $child]
     close $child
-    set result
-    } {even 16
+    return $result
+} {even 16
 even 6
 odd 41
 }
 test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
     set child [open |[list [interpreter]] r+]
+    puts $child "catch {load $::tcltestlib Tcltest}"
     puts $child "testexithandler create 41; testexithandler create 4"
     puts $child "testexithandler create 6; testexithandler delete 6"
     puts $child "testexithandler create 16; exit"
     flush $child
     set result [read $child]
     close $child
-    set result
+    return $result
 } {even 16
 even 4
 odd 41
 }
 test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
     set child [open |[list [interpreter]] r+]
+    puts $child "catch {load $::tcltestlib Tcltest}"
     puts $child "testexithandler create 41; testexithandler delete 41"
     puts $child "testexithandler create 16; exit"
     flush $child
     set result [read $child]
     close $child
-    set result
+    return $result
 } {even 16
 }
 
 test event-10.1 {Tcl_Exit procedure} {stdio} {
     set child [open |[list [interpreter]] r+]
     puts $child "exit 3"
-    list [catch {close $child} msg] $msg [lindex $errorCode 0] \
-        [lindex $errorCode 2]
+    list [catch {close $child} msg] $msg [lindex $::errorCode 0] \
+        [lindex $::errorCode 2]
 } {1 {child process exited abnormally} CHILDSTATUS 3}
 
-test event-11.1 {Tcl_VwaitCmd procedure} {
-    list [catch {vwait} msg] $msg
-} {1 {wrong # args: should be "vwait name"}}
-test event-11.2 {Tcl_VwaitCmd procedure} {
-    list [catch {vwait a b} msg] $msg
-} {1 {wrong # args: should be "vwait name"}}
-test event-11.3 {Tcl_VwaitCmd procedure} {
+test event-11.1 {Tcl_VwaitCmd procedure} -returnCodes error -body {
+    vwait
+} -result {wrong # args: should be "vwait name"}
+test event-11.2 {Tcl_VwaitCmd procedure} -returnCodes error -body {
+    vwait a b
+} -result {wrong # args: should be "vwait name"}
+test event-11.3 {Tcl_VwaitCmd procedure} -setup {
     catch {unset x}
+} -body {
     set x 1
-    list [catch {vwait x(1)} msg] $msg
-} {1 {can't trace "x(1)": variable isn't array}}
-test event-11.4 {Tcl_VwaitCmd procedure} {} {
+    vwait x(1)
+} -returnCodes error -result {can't trace "x(1)": variable isn't array}
+test event-11.4 {Tcl_VwaitCmd procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
     after 10; update; # On Mac make sure update won't take long
+} -body {
     after 100 {set x x-done}
     after 200 {set y y-done}
     after 300 {set z z-done}
@@ -394,22 +534,22 @@ test event-11.4 {Tcl_VwaitCmd procedure} {} {
     set z before
     set q before
     list [vwait y] $x $y $z $q
-} {{} x-done y-done before q-done}
-
-foreach i [after info] {
-    after cancel $i
-}
-
-test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {socket} {
+} -cleanup {
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {{} x-done y-done before q-done}
+test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} -setup {
     set test1file [makeFile "" test1]
+} -constraints {socket} -body {
     set f1 [open $test1file w]
     proc accept {s args} {
 	puts $s foobar
 	close $s
     }
-    catch {set s1 [socket -server accept 0]}
+    set s1 [socket -server accept -myaddr 127.0.0.1 0]
     after 1000
-    catch {set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]}
+    set s2 [socket 127.0.0.1 [lindex [fconfigure $s1 -sockname] 2]]
     close $s1
     set x 0
     set y 0
@@ -421,9 +561,10 @@ test event-11.5 {Tcl_VwaitCmd procedure: round robin scheduling, 2 sources} {soc
     vwait z
     close $f1
     close $s2
-    removeFile $test1file
     list $x $y $z
-} {3 3 done}
+} -cleanup {
+    removeFile $test1file
+} -result {3 3 done}
 test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
     set test1file [makeFile "" test1]
     set test2file [makeFile "" test2]
@@ -443,17 +584,17 @@ test event-11.6 {Tcl_VwaitCmd procedure: round robin scheduling, same source} {
     list $x $y $z
 } {3 3 done}
 
-
-test event-12.1 {Tcl_UpdateCmd procedure} {
-    list [catch {update a b} msg] $msg
-} {1 {wrong # args: should be "update ?idletasks?"}}
-test event-12.2 {Tcl_UpdateCmd procedure} {
-    list [catch {update bogus} msg] $msg
-} {1 {bad option "bogus": must be idletasks}}
-test event-12.3 {Tcl_UpdateCmd procedure} {
+test event-12.1 {Tcl_UpdateCmd procedure} -returnCodes error -body {
+    update a b
+} -result {wrong # args: should be "update ?idletasks?"}
+test event-12.2 {Tcl_UpdateCmd procedure} -returnCodes error -body {
+    update bogus
+} -result {bad option "bogus": must be idletasks}
+test event-12.3 {Tcl_UpdateCmd procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     after 500 {set x after}
     after idle {set y after}
     after idle {set z "after, y = $y"}
@@ -462,11 +603,16 @@ test event-12.3 {Tcl_UpdateCmd procedure} {
     set z before
     update idletasks
     list $x $y $z
-} {before after {after, y = after}}
-test event-12.4 {Tcl_UpdateCmd procedure} {
+} -cleanup {
     foreach i [after info] {
 	after cancel $i
     }
+} -result {before after {after, y = after}}
+test event-12.4 {Tcl_UpdateCmd procedure} -setup {
+    foreach i [after info] {
+	after cancel $i
+    }
+} -body {
     after 10; update; # On Mac make sure update won't take long
     after 200 {set x x-done}
     after 600 {set y y-done}
@@ -477,118 +623,311 @@ test event-12.4 {Tcl_UpdateCmd procedure} {
     after 300
     update
     list $x $y $z
-} {x-done before z-done}
+} -cleanup {
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {x-done before z-done}
 
-test event-13.1 {Tcl_WaitForFile procedure, readable} {testfilehandler} {
+test event-13.1 {Tcl_WaitForFile procedure, readable} -setup {
     foreach i [after info] {
 	after cancel $i
     }
-    after 100 set x timeout
     testfilehandler close
+} -constraints {testfilehandler} -body {
+    after 100 set x timeout
     testfilehandler create 1 off off
     set x "no timeout"
     set result [testfilehandler wait 1 readable 0]
     update
-    testfilehandler close
     list $result $x
-} {{} {no timeout}}
-test event-13.2 {Tcl_WaitForFile procedure, readable} testfilehandler {
+} -cleanup {
+    testfilehandler close
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {{} {no timeout}}
+test event-13.2 {Tcl_WaitForFile procedure, readable} -setup {
     foreach i [after info] {
 	after cancel $i
     }
-    after 100 set x timeout
     testfilehandler close
+} -constraints testfilehandler -body {
+    after 100 set x timeout
     testfilehandler create 1 off off
     set x "no timeout"
     set result [testfilehandler wait 1 readable 100]
     update
-    testfilehandler close
     list $result $x
-} {{} timeout}
-test event-13.3 {Tcl_WaitForFile procedure, readable} testfilehandler {
+} -cleanup {
+    testfilehandler close
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {{} timeout}
+test event-13.3 {Tcl_WaitForFile procedure, readable} -setup {
     foreach i [after info] {
 	after cancel $i
     }
-    after 100 set x timeout
     testfilehandler close
+} -constraints testfilehandler -body {
+    after 100 set x timeout
     testfilehandler create 1 off off
     testfilehandler fillpartial 1
     set x "no timeout"
     set result [testfilehandler wait 1 readable 100]
     update
-    testfilehandler close
     list $result $x
-} {readable {no timeout}}
-test event-13.4 {Tcl_WaitForFile procedure, writable} \
-	{testfilehandler nonPortable} {
+} -cleanup {
+    testfilehandler close
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {readable {no timeout}}
+test event-13.4 {Tcl_WaitForFile procedure, writable} -setup {
     foreach i [after info] {
 	after cancel $i
     }
-    after 100 set x timeout
     testfilehandler close
+} -constraints {testfilehandler nonPortable} -body {
+    after 100 set x timeout
     testfilehandler create 1 off off
     testfilehandler fill 1
     set x "no timeout"
     set result [testfilehandler wait 1 writable 0]
     update
-    testfilehandler close
     list $result $x
-} {{} {no timeout}}
-test event-13.5 {Tcl_WaitForFile procedure, writable} \
-	{testfilehandler nonPortable} {
+} -cleanup {
+    testfilehandler close
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {{} {no timeout}}
+test event-13.5 {Tcl_WaitForFile procedure, writable} -setup {
     foreach i [after info] {
 	after cancel $i
     }
-    after 100 set x timeout
     testfilehandler close
+} -constraints {testfilehandler nonPortable} -body {
+    after 100 set x timeout
     testfilehandler create 1 off off
     testfilehandler fill 1
     set x "no timeout"
     set result [testfilehandler wait 1 writable 100]
     update
-    testfilehandler close
     list $result $x
-} {{} timeout}
-test event-13.6 {Tcl_WaitForFile procedure, writable} testfilehandler {
+} -cleanup {
+    testfilehandler close
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {{} timeout}
+test event-13.6 {Tcl_WaitForFile procedure, writable} -setup {
     foreach i [after info] {
 	after cancel $i
     }
-    after 100 set x timeout
     testfilehandler close
+} -constraints testfilehandler -body {
+    after 100 set x timeout
     testfilehandler create 1 off off
     set x "no timeout"
     set result [testfilehandler wait 1 writable 100]
     update
-    testfilehandler close
     list $result $x
-} {writable {no timeout}}
-test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} testfilehandler {
+} -cleanup {
+    testfilehandler close
     foreach i [after info] {
 	after cancel $i
     }
+} -result {writable {no timeout}}
+test event-13.7 {Tcl_WaitForFile procedure, don't call other event handlers} -setup {
+    foreach i [after info] {
+	after cancel $i
+    }
+    testfilehandler close
+} -constraints testfilehandler -body {
     after 100 lappend x timeout
     after idle lappend x idle
-    testfilehandler close
     testfilehandler create 1 off off
     set x ""
     set result [list [testfilehandler wait 1 readable 200] $x]
     update
-    testfilehandler close
     lappend result $x
-} {{} {} {timeout idle}}
-
+} -cleanup {
+    testfilehandler close
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {{} {} {timeout idle}}
 test event-13.8 {Tcl_WaitForFile procedure, waiting indefinitely} testfilewait {
     set f [open "|sleep 2" r]
     set result ""
     lappend result [testfilewait $f readable 100]
     lappend result [testfilewait $f readable -1]
     close $f
-    set result
+    return $result
 } {{} readable}
 
+test event-14.1 {Tcl_WaitForFile procedure, readable, big fd} -setup {
+    set chanList {}
+    for {set i 0} {$i < 32} {incr i} {
+	lappend chanList [open /dev/null r]
+    }
+    foreach i [after info] {after cancel $i}
+    testfilehandler close
+} -constraints {testfilehandler unix} -body {
+    after 100 set x timeout
+    testfilehandler create 1 off off
+    set x "no timeout"
+    set result [testfilehandler wait 1 readable 0]
+    update
+    list $result $x
+} -cleanup {
+    testfilehandler close
+    foreach chan $chanList {close $chan}
+    foreach i [after info] {after cancel $i}
+} -result {{} {no timeout}}
+test event-14.2 {Tcl_WaitForFile procedure, readable, big fd} -setup {
+    set chanList {}
+    for {set i 0} {$i < 32} {incr i} {
+	lappend chanList [open /dev/null r]
+    }
+    foreach i [after info] {after cancel $i}
+    testfilehandler close
+} -constraints {testfilehandler unix} -body {
+    after 100 set x timeout
+    testfilehandler create 1 off off
+    set x "no timeout"
+    set result [testfilehandler wait 1 readable 100]
+    update
+    list $result $x
+} -cleanup {
+    testfilehandler close
+    foreach chan $chanList {close $chan}
+    foreach i [after info] {after cancel $i}
+} -result {{} timeout}
+test event-14.3 {Tcl_WaitForFile procedure, readable, big fd} -setup {
+    set chanList {}
+    for {set i 0} {$i < 32} {incr i} {
+	lappend chanList [open /dev/null r]
+    }
+    foreach i [after info] {after cancel $i}
+    testfilehandler close
+} -constraints {testfilehandler unix} -body {
+    after 100 set x timeout
+    testfilehandler create 1 off off
+    testfilehandler fillpartial 1
+    set x "no timeout"
+    set result [testfilehandler wait 1 readable 100]
+    update
+    list $result $x
+} -cleanup {
+    testfilehandler close
+    foreach chan $chanList {close $chan}
+    foreach i [after info] {after cancel $i}
+} -result {readable {no timeout}}
+test event-14.4 {Tcl_WaitForFile procedure, writable, big fd} -setup {
+    set chanList {}
+    for {set i 0} {$i < 32} {incr i} {
+	lappend chanList [open /dev/null r]
+    }
+    foreach i [after info] {after cancel $i}
+    testfilehandler close
+} -constraints {testfilehandler unix nonPortable} -body {
+    after 100 set x timeout
+    testfilehandler create 1 off off
+    testfilehandler fill 1
+    set x "no timeout"
+    set result [testfilehandler wait 1 writable 0]
+    update
+    list $result $x
+} -cleanup {
+    testfilehandler close
+    foreach chan $chanList {close $chan}
+    foreach i [after info] {after cancel $i}
+} -result {{} {no timeout}}
+test event-14.5 {Tcl_WaitForFile procedure, writable, big fd} -setup {
+    set chanList {}
+    for {set i 0} {$i < 32} {incr i} {
+	lappend chanList [open /dev/null r]
+    }
+    foreach i [after info] {after cancel $i}
+    testfilehandler close
+} -constraints {testfilehandler unix nonPortable} -body {
+    after 100 set x timeout
+    testfilehandler create 1 off off
+    testfilehandler fill 1
+    set x "no timeout"
+    set result [testfilehandler wait 1 writable 100]
+    update
+    list $result $x
+} -cleanup {
+    testfilehandler close
+    foreach chan $chanList {close $chan}
+    foreach i [after info] {after cancel $i}
+} -result {{} timeout}
+test event-14.6 {Tcl_WaitForFile procedure, writable, big fd} -setup {
+    set chanList {}
+    for {set i 0} {$i < 32} {incr i} {
+	lappend chanList [open /dev/null r]
+    }
+    foreach i [after info] {after cancel $i}
+    testfilehandler close
+} -constraints {testfilehandler unix} -body {
+    after 100 set x timeout
+    testfilehandler create 1 off off
+    set x "no timeout"
+    set result [testfilehandler wait 1 writable 100]
+    update
+    list $result $x
+} -cleanup {
+    testfilehandler close
+    foreach chan $chanList {close $chan}
+    foreach i [after info] {after cancel $i}
+} -result {writable {no timeout}}
+test event-14.7 {Tcl_WaitForFile, don't call other event handlers, big fd} -setup {
+    set chanList {}
+    for {set i 0} {$i < 32} {incr i} {
+	lappend chanList [open /dev/null r]
+    }
+    foreach i [after info] {after cancel $i}
+    testfilehandler close
+} -constraints {testfilehandler unix} -body {
+    after 100 lappend x timeout
+    after idle lappend x idle
+    testfilehandler create 1 off off
+    set x ""
+    set result [list [testfilehandler wait 1 readable 200] $x]
+    update
+    lappend result $x
+} -cleanup {
+    testfilehandler close
+    foreach chan $chanList {close $chan}
+    foreach i [after info] {after cancel $i}
+} -result {{} {} {timeout idle}}
+test event-14.8 {Tcl_WaitForFile procedure, waiting indefinitely, big fd} -setup {
+    set chanList {}
+    for {set i 0} {$i < 32} {incr i} {
+	lappend chanList [open /dev/null r]
+    }
+} -constraints {testfilewait unix} -body {
+    set f [open "|sleep 2" r]
+    set result ""
+    lappend result [testfilewait $f readable 100]
+    lappend result [testfilewait $f readable -1]
+    close $f
+    return $result
+} -cleanup {
+    foreach chan $chanList {close $chan}
+} -result {{} readable}
+
 # cleanup
 foreach i [after info] {
     after cancel $i
 }
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/exec.test b/tests/exec.test
index a80aaeb..871c0c5 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -1,17 +1,15 @@
 # Commands covered:  exec
 #
-# 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-1994 The Regents of the University of California.
 # Copyright (c) 1994-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.
-#
-# RCS: @(#) $Id: exec.test,v 1.23 2005/07/28 10:55:37 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 package require tcltest 2
 namespace import -force ::tcltest::*
@@ -20,6 +18,8 @@ namespace import -force ::tcltest::*
 # Skip them if exec is not defined.
 testConstraint exec [llength [info commands exec]]
 unset -nocomplain path
+
+# Utilities that are like bourne shell stalwarts, but cross-platform.
 set path(echo) [makeFile {
     puts -nonewline [lindex $argv 0]
     foreach str [lrange $argv 1 end] {
@@ -28,28 +28,33 @@ set path(echo) [makeFile {
     puts {}
     exit
 } echo]
-
+set path(echo2) [makeFile {
+    puts stdout [join $argv]
+    puts stderr [lindex $argv 1]
+    exit
+} echo2]
 set path(cat) [makeFile {
-    if {$argv == {}} {
+    if {$argv eq ""} {
 	set argv -
     }
+    fconfigure stdout -translation binary
     foreach name $argv {
-	if {$name == "-"} {
+	if {$name eq "-"} {
 	    set f stdin
 	} elseif {[catch {open $name r} f] != 0} {
 	    puts stderr $f
 	    continue
 	}
+	fconfigure $f -translation binary
 	while {[eof $f] == 0} {
 	    puts -nonewline [read $f]
 	}
-	if {$f != "stdin"} {
+	if {$f ne "stdin"} {
 	    close $f
 	}
     }
     exit
 } cat]
-
 set path(wc) [makeFile {
     set data [read stdin]
     set lines [regsub -all "\n" $data {} dummy]
@@ -58,39 +63,59 @@ set path(wc) [makeFile {
     puts [format "%8.d%8.d%8.d" $lines $words $chars]
     exit
 } wc]
-
 set path(sh) [makeFile {
-    if {[lindex $argv 0] != "-c"} {
+    if {[lindex $argv 0] ne "-c"} {
 	error "sh: unexpected arguments $argv"
     }
     set cmd [lindex $argv 1]
     lappend cmd ";"
-
     set newcmd {}
-    
     foreach arg $cmd {
-	if {$arg == ";"} {
-	    eval exec >@stdout 2>@stderr [list [info nameofexecutable]] $newcmd
+	if {$arg eq ";"} {
+	    exec >@stdout 2>@stderr [info nameofexecutable] {*}$newcmd
 	    set newcmd {}
 	    continue
 	}
-	if {$arg == "1>&2"} {
+	if {$arg eq "1>&2"} {
 	    set arg >@stderr
 	}
 	lappend newcmd $arg
     }
     exit
 } sh]
-
+set path(sh2) [makeFile {
+    if {[lindex $argv 0] ne "-c"} {
+	error "sh: unexpected arguments $argv"
+    }
+    set cmd [lindex $argv 1]
+    lappend cmd ";"
+    set newcmd {}
+    foreach arg $cmd {
+	if {$arg eq ";"} {
+	    exec -ignorestderr >@stdout [info nameofexecutable] {*}$newcmd
+	    set newcmd {}
+	    continue
+	}
+	lappend newcmd $arg
+    }
+    exit
+} sh2]
 set path(sleep) [makeFile {
     after [expr $argv*1000]
     exit
 } sleep]
-
 set path(exit) [makeFile {
     exit $argv
 } exit]
 
+proc readfile filename {
+    set f [open $filename]
+    set d [read $f]
+    close $f
+    return [string trimright $d \n]
+}
+
+# ----------------------------------------------------------------------
 # Basic operations.
 
 test exec-1.1 {basic exec operation} {exec} {
@@ -127,13 +152,24 @@ test exec-2.4 {redirecting input from immediate source} {exec stdio} {
 test exec-2.5 {redirecting input from immediate source} {exec} {
     exec [interpreter] $path(cat) "<<Joined to arrows"
 } {Joined to arrows}
-test exec-2.6 {redirecting input from immediate source, with UTF} {exec} {
-    # If this fails, it may give back:
-    # "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1"
-    # If it does, this means that the UTF -> external conversion did not 
-    # occur before writing out the temp file.
-    exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"
-} "\uE9\uE0\uFC\uF1"
+test exec-2.6 {redirecting input from immediate source, with UTF} -setup {
+    set sysenc [encoding system]
+    encoding system iso8859-1
+    proc quotenonascii s {
+	regsub -all {\[|\\|\]} $s {\\&} s
+	regsub -all "\[\u007f-\uffff\]" $s \
+	    {[apply {c {format {\u%04x} [scan $c %c]}} &]} s
+	return [subst -novariables $s]
+    }
+} -constraints {exec} -body {
+    # If this fails, it may give back: "\uC3\uA9\uC3\uA0\uC3\uBC\uC3\uB1"
+    # If it does, this means that the UTF -> external conversion did not occur
+    # before writing out the temp file.
+    quotenonascii [exec [interpreter] $path(cat) << "\uE9\uE0\uFC\uF1"]
+} -cleanup {
+    encoding system $sysenc
+    rename quotenonascii {}
+} -result {\u00e9\u00e0\u00fc\u00f1}
 
 # I/O redirection: output to file.
 
@@ -182,37 +218,37 @@ test exec-3.7 {redirecting output to file} {exec} {
 file delete $path(gorp.file)
 
 test exec-4.1 {redirecting output and stderr to file} {exec} {
-    exec [interpreter] "$path(echo)" "test output" >& $path(gorp.file)
-    exec [interpreter] "$path(cat)" "$path(gorp.file)"
+    exec [interpreter] $path(echo) "test output" >& $path(gorp.file)
+    exec [interpreter] $path(cat) $path(gorp.file)
 } "test output"
 test exec-4.2 {redirecting output and stderr to file} {exec} {
-    list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" >&$path(gorp.file)] \
-	    [exec [interpreter] "$path(cat)" "$path(gorp.file)"]
+    list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" >&$path(gorp.file)] \
+	    [exec [interpreter] $path(cat) $path(gorp.file)]
 } {{} {foo bar}}
 test exec-4.3 {redirecting output and stderr to file} {exec} {
     exec [interpreter] $path(echo) "first line" > $path(gorp.file)
-    list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" >>&$path(gorp.file)] \
-	    [exec [interpreter] "$path(cat)" "$path(gorp.file)"]
+    list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" >>&$path(gorp.file)] \
+	    [exec [interpreter] $path(cat) $path(gorp.file)]
 } "{} {first line\nfoo bar}"
 test exec-4.4 {redirecting output and stderr to file} {exec} {
-    set f [open "$path(gorp.file)" w]
+    set f [open $path(gorp.file) w]
     puts $f "Line 1"
     flush $f
-    exec [interpreter] "$path(echo)" "More text" >&@ $f
-    exec [interpreter] "$path(echo)" >&@$f "Even more"
+    exec [interpreter] $path(echo) "More text" >&@ $f
+    exec [interpreter] $path(echo) >&@$f "Even more"
     puts $f "Line 3"
     close $f
-    exec [interpreter] "$path(cat)" "$path(gorp.file)"
+    exec [interpreter] $path(cat) $path(gorp.file)
 } "Line 1\nMore text\nEven more\nLine 3"
 test exec-4.5 {redirecting output and stderr to file} {exec} {
-    set f [open "$path(gorp.file)" w]
+    set f [open $path(gorp.file) w]
     puts $f "Line 1"
     flush $f
-    exec >&@ $f [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2"
-    exec >&@$f [interpreter] "$path(sh)" -c "\"$path(echo)\" xyzzy 1>&2"
+    exec >&@ $f [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2"
+    exec >&@$f [interpreter] $path(sh) -c "\"$path(echo)\" xyzzy 1>&2"
     puts $f "Line 3"
     close $f
-    exec [interpreter] "$path(cat)" "$path(gorp.file)"
+    exec [interpreter] $path(cat) $path(gorp.file)
 } "Line 1\nfoo bar\nxyzzy\nLine 3"
 
 # I/O redirection: input from file.
@@ -235,30 +271,30 @@ test exec-5.4 {redirecting input from file} {exec stdio} {
 test exec-5.5 {redirecting input from file} {exec} {
     exec [interpreter] $path(cat) <$path(gorp.file)
 } {Just a few thoughts}
-test exec-5.6 {redirecting input from file} {exec} {
+test exec-5.6 {redirecting input from file} -constraints {exec} -body {
     set f [open $path(gorp.file) r]
-    set result [exec [interpreter] $path(cat) <@ $f]
+    exec [interpreter] $path(cat) <@ $f
+} -cleanup {
     close $f
-    set result
-} {Just a few thoughts}
-test exec-5.7 {redirecting input from file} {exec} {
+} -result {Just a few thoughts}
+test exec-5.7 {redirecting input from file} -constraints {exec} -body {
     set f [open $path(gorp.file) r]
-    set result [exec <@$f [interpreter] $path(cat)]
+    exec <@$f [interpreter] $path(cat)
+} -cleanup {
     close $f
-    set result
-} {Just a few thoughts}
+} -result {Just a few thoughts}
 
 # I/O redirection: standard error through a pipeline.
 
 test exec-6.1 {redirecting stderr through a pipeline} {exec stdio} {
-    exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar" |& [interpreter] "$path(cat)"
+    exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar" |& [interpreter] $path(cat)
 } "foo bar"
 test exec-6.2 {redirecting stderr through a pipeline} {exec stdio} {
-    exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" |& [interpreter] "$path(cat)"
+    exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" |& [interpreter] $path(cat)
 } "foo bar"
 test exec-6.3 {redirecting stderr through a pipeline} {exec stdio} {
-    exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" \
-	|& [interpreter] "$path(sh)" -c "\"$path(echo)\" second msg 1>&2 ; \"$path(cat)\"" |& [interpreter] "$path(cat)"
+    exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \
+	|& [interpreter] $path(sh) -c "\"$path(echo)\" second msg 1>&2 ; \"$path(cat)\"" |& [interpreter] $path(cat)
 } "second msg\nfoo bar"
 
 # I/O redirection: combinations.
@@ -275,7 +311,6 @@ test exec-7.2 {multiple I/O redirections} {exec} {
 } {command input}
 
 # Long input to command and output from command.
-
 set a "0123456789 xxxxxxxxx abcdefghi ABCDEFGHIJK\n"
 set a [concat $a $a $a $a]
 set a [concat $a $a $a $a]
@@ -284,9 +319,7 @@ set a [concat $a $a $a $a]
 test exec-8.1 {long input and output} {exec} {
     exec [interpreter] $path(cat) << $a
 } $a
-
 # More than 20 arguments to exec.
-
 test exec-8.2 {long input and output} {exec} {
     exec [interpreter] $path(echo) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
 } {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23}
@@ -300,118 +333,120 @@ test exec-9.1 {commands returning errors} {exec} {
 test exec-9.2 {commands returning errors} {exec} {
     string tolower [list [catch {exec [interpreter] echo foo | foo123} msg] $msg $errorCode]
 } {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
-test exec-9.3 {commands returning errors} {exec stdio} {
-    list [catch {exec [interpreter] $path(sleep) 1 | [interpreter] $path(exit) 43 | [interpreter] $path(sleep) 1} msg] $msg
-} {1 {child process exited abnormally}}
-test exec-9.4 {commands returning errors} {exec stdio} {
-    list [catch {exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"} msg] $msg
-} {1 {foo bar
-child process exited abnormally}}
-test exec-9.5 {commands returning errors} {exec stdio} {
-    list [catch {exec gorp456 | [interpreter] echo a b c} msg] [string tolower $msg]
-} {1 {couldn't execute "gorp456": no such file or directory}}
-test exec-9.6 {commands returning errors} {exec} {
-    list [catch {exec [interpreter] "$path(sh)" -c "\"$path(echo)\" error msg 1>&2"} msg] $msg
-} {1 {error msg}}
-test exec-9.7 {commands returning errors} {exec stdio} {
-    list [catch {exec [interpreter] "$path(sh)" -c "\"$path(echo)\" error msg 1>&2" \
-		     | [interpreter] "$path(sh)" -c "\"$path(echo)\" error msg 1>&2"} msg] $msg
-} {1 {error msg
-error msg}}
-
+test exec-9.3 {commands returning errors} -constraints {exec stdio} -body {
+    exec [interpreter] $path(sleep) 1 | [interpreter] $path(exit) 43 | [interpreter] $path(sleep) 1
+} -returnCodes error -result {child process exited abnormally}
+test exec-9.4 {commands returning errors} -constraints {exec stdio} -body {
+    exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"
+} -returnCodes error -result {foo bar
+child process exited abnormally}
+test exec-9.5 {commands returning errors} -constraints {exec stdio} -body {
+    exec gorp456 | [interpreter] echo a b c
+} -returnCodes error -result {couldn't execute "gorp456": no such file or directory}
+test exec-9.6 {commands returning errors} -constraints {exec} -body {
+    exec [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2"
+} -returnCodes error -result {error msg}
+test exec-9.7 {commands returning errors} -constraints {exec stdio nonPortable} -body {
+    # This test can fail easily on multiprocessor machines
+    exec [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2 ; \"$path(sleep)\" 1" \
+	| [interpreter] $path(sh) -c "\"$path(echo)\" error msg 1>&2 ; \"$path(sleep)\" 1"
+} -returnCodes error -result {error msg
+error msg}
 set path(err) [makeFile {} err]
-
-test exec-9.8 {commands returning errors} {exec} {
+test exec-9.8 {commands returning errors} -constraints {exec} -setup {
     set f [open $path(err) w]
     puts $f {
 	puts stdout out
 	puts stderr err
     }
     close $f
-    list [catch {exec [interpreter] $path(err)} msg] $msg
-} {1 {out
-err}}
-
-# Errors in executing the Tcl command, as opposed to errors in the
-# processes that are invoked.
-
-test exec-10.1 {errors in exec invocation} {exec} {
-    list [catch {exec} msg] $msg
-} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
-test exec-10.2 {errors in exec invocation} {exec} {
-    list [catch {exec | cat} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.3 {errors in exec invocation} {exec} {
-    list [catch {exec cat |} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.4 {errors in exec invocation} {exec} {
-    list [catch {exec cat | | cat} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.5 {errors in exec invocation} {exec} {
-    list [catch {exec cat | |& cat} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.6 {errors in exec invocation} {exec} {
-    list [catch {exec cat |&} msg] $msg
-} {1 {illegal use of | or |& in command}}
-test exec-10.7 {errors in exec invocation} {exec} {
-    list [catch {exec cat <} msg] $msg
-} {1 {can't specify "<" as last word in command}}
-test exec-10.8 {errors in exec invocation} {exec} {
-    list [catch {exec cat >} msg] $msg
-} {1 {can't specify ">" as last word in command}}
-test exec-10.9 {errors in exec invocation} {exec} {
-    list [catch {exec cat <<} msg] $msg
-} {1 {can't specify "<<" as last word in command}}
-test exec-10.10 {errors in exec invocation} {exec} {
-    list [catch {exec cat >>} msg] $msg
-} {1 {can't specify ">>" as last word in command}}
-test exec-10.11 {errors in exec invocation} {exec} {
-    list [catch {exec cat >&} msg] $msg
-} {1 {can't specify ">&" as last word in command}}
-test exec-10.12 {errors in exec invocation} {exec} {
-    list [catch {exec cat >>&} msg] $msg
-} {1 {can't specify ">>&" as last word in command}}
-test exec-10.13 {errors in exec invocation} {exec} {
-    list [catch {exec cat >@} msg] $msg
-} {1 {can't specify ">@" as last word in command}}
-test exec-10.14 {errors in exec invocation} {exec} {
-    list [catch {exec cat <@} msg] $msg
-} {1 {can't specify "<@" as last word in command}}
-test exec-10.15 {errors in exec invocation} {exec} {
-    list [catch {exec cat < a/b/c} msg] [string tolower $msg]
-} {1 {couldn't read file "a/b/c": no such file or directory}}
-test exec-10.16 {errors in exec invocation} {exec} {
-    list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
-} {1 {couldn't write file "a/b/c": no such file or directory}}
-test exec-10.17 {errors in exec invocation} {exec} {
-    list [catch {exec cat << foo > a/b/c} msg] [string tolower $msg]
-} {1 {couldn't write file "a/b/c": no such file or directory}}
+} -body {
+    exec [interpreter] $path(err)
+} -returnCodes error -result {out
+err}
+
+# Errors in executing the Tcl command, as opposed to errors in the processes
+# that are invoked.
+
+test exec-10.1 {errors in exec invocation} -constraints {exec} -body {
+    exec
+} -returnCodes error -result {wrong # args: should be "exec ?-switch ...? arg ?arg ...?"}
+test exec-10.2 {errors in exec invocation} -constraints {exec} -body {
+    exec | cat
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.3 {errors in exec invocation} -constraints {exec} -body {
+    exec cat |
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.4 {errors in exec invocation} -constraints {exec} -body {
+    exec cat | | cat
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.5 {errors in exec invocation} -constraints {exec} -body {
+    exec cat | |& cat
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.6 {errors in exec invocation} -constraints {exec} -body {
+    exec cat |&
+} -returnCodes error -result {illegal use of | or |& in command}
+test exec-10.7 {errors in exec invocation} -constraints {exec} -body {
+    exec cat <
+} -returnCodes error -result {can't specify "<" as last word in command}
+test exec-10.8 {errors in exec invocation} -constraints {exec} -body {
+    exec cat >
+} -returnCodes error -result {can't specify ">" as last word in command}
+test exec-10.9 {errors in exec invocation} -constraints {exec} -body {
+    exec cat <<
+} -returnCodes error -result {can't specify "<<" as last word in command}
+test exec-10.10 {errors in exec invocation} -constraints {exec} -body {
+    exec cat >>
+} -returnCodes error -result {can't specify ">>" as last word in command}
+test exec-10.11 {errors in exec invocation} -constraints {exec} -body {
+    exec cat >&
+} -returnCodes error -result {can't specify ">&" as last word in command}
+test exec-10.12 {errors in exec invocation} -constraints {exec} -body {
+    exec cat >>&
+} -returnCodes error -result {can't specify ">>&" as last word in command}
+test exec-10.13 {errors in exec invocation} -constraints {exec} -body {
+    exec cat >@
+} -returnCodes error -result {can't specify ">@" as last word in command}
+test exec-10.14 {errors in exec invocation} -constraints {exec} -body {
+    exec cat <@
+} -returnCodes error -result {can't specify "<@" as last word in command}
+test exec-10.15 {errors in exec invocation} -constraints {exec} -body {
+    exec cat < a/b/c
+} -returnCodes error -result {couldn't read file "a/b/c": no such file or directory}
+test exec-10.16 {errors in exec invocation} -constraints {exec} -body {
+    exec cat << foo > a/b/c
+} -returnCodes error -result {couldn't write file "a/b/c": no such file or directory}
+test exec-10.17 {errors in exec invocation} -constraints {exec} -body {
+    exec cat << foo > a/b/c
+} -returnCodes error -result {couldn't write file "a/b/c": no such file or directory}
 set f [open $path(gorp.file) w]
-test exec-10.18 {errors in exec invocation} {exec} {
-    list [catch {exec cat <@ $f} msg] $msg
-} "1 {channel \"$f\" wasn't opened for reading}"
+test exec-10.18 {errors in exec invocation} -constraints {exec} -body {
+    exec cat <@ $f
+} -returnCodes error -result "channel \"$f\" wasn't opened for reading"
 close $f
 set f [open $path(gorp.file) r]
-test exec-10.19 {errors in exec invocation} {exec} {
-    list [catch {exec cat >@ $f} msg] $msg
-} "1 {channel \"$f\" wasn't opened for writing}"
+test exec-10.19 {errors in exec invocation} -constraints {exec} -body {
+    exec cat >@ $f
+} -returnCodes error -result "channel \"$f\" wasn't opened for writing"
 close $f
-test exec-10.20 {errors in exec invocation} {exec} {
-    list [catch {exec ~non_existent_user/foo/bar} msg] $msg
-} {1 {user "non_existent_user" doesn't exist}}
-test exec-10.21 {errors in exec invocation} {exec} {
-    list [catch {exec [interpreter] true | ~xyzzy_bad_user/x | false} msg] $msg
-} {1 {user "xyzzy_bad_user" doesn't exist}}
-
+test exec-10.20 {errors in exec invocation} -constraints {exec} -body {
+    exec ~non_existent_user/foo/bar
+} -returnCodes error -result {user "non_existent_user" doesn't exist}
+test exec-10.21 {errors in exec invocation} -constraints {exec} -body {
+    exec [interpreter] true | ~xyzzy_bad_user/x | false
+} -returnCodes error -result {user "xyzzy_bad_user" doesn't exist}
+test exec-10.22 {errors in exec invocation} -constraints exec -body {
+    exec echo test > ~non_existent_user/foo/bar
+} -returnCodes error -result {user "non_existent_user" doesn't exist}
 # Commands in background.
 
 test exec-11.1 {commands in background} {exec} {
-    set x [lindex [time {exec [interpreter] $path(sleep) 2 &}] 0]
-    expr $x<1000000
+    set time [time {exec [interpreter] $path(sleep) 2 &}]
+    expr {[lindex $time 0] < 1000000}
 } 1
-test exec-11.2 {commands in background} {exec} {
-    list [catch {exec [interpreter] $path(echo) a &b} msg] $msg
-} {0 {a &b}}
+test exec-11.2 {commands in background} -constraints {exec} -body {
+    exec [interpreter] $path(echo) a &b
+} -result {a &b}
 test exec-11.3 {commands in background} {exec} {
     llength [exec [interpreter] $path(sleep) 1 &]
 } 1
@@ -422,35 +457,33 @@ test exec-11.5 {commands in background} {exec} {
     set f [open $path(gorp.file) w]
     puts $f [list catch [list exec [info nameofexecutable] $path(echo) foo &]]
     close $f
-    string compare "foo" [exec [interpreter] $path(gorp.file)]
-} 0
+    exec [interpreter] $path(gorp.file)
+} foo
 
-# Make sure that background commands are properly reaped when
-# they eventually die.
+# Make sure that background commands are properly reaped when they
+# eventually die.
 
-if {[testConstraint exec]} {
-    exec [interpreter] $path(sleep) 3
+if {[testConstraint exec] && [testConstraint nonPortable]} {
+    after 1300
+    exec [interpreter] $path(sleep) 1
 }
-test exec-12.1 {reaping background processes} \
-	{exec unix nonPortable} {
+test exec-12.1 {reaping background processes} {exec unix nonPortable} {
     for {set i 0} {$i < 20} {incr i} {
 	exec echo foo > /dev/null &
     }
-    exec sleep 1
+    after 1000
     catch {exec ps | fgrep "echo foo" | fgrep -v fgrep | wc} msg
     lindex $msg 0
 } 0
-test exec-12.2 {reaping background processes} \
-	{exec unix nonPortable} {
+test exec-12.2 {reaping background processes} {exec unix nonPortable} {
     exec sleep 2 | sleep 2 | sleep 2 &
     catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
     set x [lindex $msg 0]
-    exec sleep 3
+    after 3000
     catch {exec ps | fgrep -i "sleep" | fgrep -i -v fgrep | wc} msg
     list $x [lindex $msg 0]
 } {3 0}
-test exec-12.3 {reaping background processes} \
-	{exec unix nonPortable} {
+test exec-12.3 {reaping background processes} {exec unix nonPortable} {
     exec sleep 1000 &
     exec sleep 1000 &
     set x [exec ps | fgrep "sleep" | fgrep -v fgrep]
@@ -463,7 +496,6 @@ test exec-12.3 {reaping background processes} \
     }
     catch {exec ps | fgrep "sleep" | fgrep -v fgrep | wc} msg
     set x [lindex $msg 0]
-
     foreach i $pids {
 	catch {exec kill -KILL $i}
     }
@@ -484,62 +516,87 @@ test exec-13.3 {setting errorCode variable} {exec} {
     list $x [string tolower $msg] [lindex $errorCode 0] \
 	    [string tolower [lrange $errorCode 2 end]]
 } {1 {couldn't execute "_weird_cmd_": no such file or directory} POSIX {{no such file or directory}}}
+test exec-13.4 {extended exit result codes} -setup {
+    set tmp [makeFile {exit 0x00000101} tmpfile.exec-13.4]
+} -constraints {win} -body {
+    list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}]
+} -cleanup {
+    removeFile $tmp
+} -result {1 {CHILDSTATUS {} 257}}
+test exec-13.5 {extended exit result codes: max value} -setup {
+    set tmp [makeFile {exit 0x3fffffff} tmpfile.exec-13.5]
+} -constraints {win} -body {
+    list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}]
+} -cleanup {
+    removeFile $tmp
+} -result {1 {CHILDSTATUS {} 1073741823}}
+test exec-13.6 {extended exit result codes: signalled} -setup {
+    set tmp [makeFile {exit 0xC0000016} tmpfile.exec-13.6]
+} -constraints {win} -body {
+    list [catch {exec [interpreter] $tmp} err] [lreplace $::errorCode 1 1 {}]
+} -cleanup {
+    removeFile $tmp
+} -result {1 {CHILDKILLED {} SIGABRT SIGABRT}}
 
 # Switches before the first argument
 
 test exec-14.1 {-keepnewline switch} {exec} {
     exec -keepnewline [interpreter] $path(echo) foo
 } "foo\n"
-test exec-14.2 {-keepnewline switch} {exec} {
-    list [catch {exec -keepnewline} msg] $msg
-} {1 {wrong # args: should be "exec ?switches? arg ?arg ...?"}}
-test exec-14.3 {unknown switch} {exec} {
-    list [catch {exec -gorp} msg] $msg
-} {1 {bad switch "-gorp": must be -keepnewline or --}}
-test exec-14.4 {-- switch} {exec} {
-    list [catch {exec -- -gorp} msg] [string tolower $msg]
-} {1 {couldn't execute "-gorp": no such file or directory}}
+test exec-14.2 {-keepnewline switch} -constraints {exec} -body {
+    exec -keepnewline
+} -returnCodes error -result {wrong # args: should be "exec ?-switch ...? arg ?arg ...?"}
+test exec-14.3 {unknown switch} -constraints {exec} -body {
+    exec -gorp
+} -returnCodes error -result {bad switch "-gorp": must be -ignorestderr, -keepnewline, or --}
+test exec-14.4 {-- switch} -constraints {exec} -body {
+    exec -- -gorp
+} -returnCodes error -result {couldn't execute "-gorp": no such file or directory}
+test exec-14.5 {-ignorestderr switch} {exec} {
+    # Alas, the use of -ignorestderr is buried here :-(
+    exec [interpreter] $path(sh2) -c [list $path(echo2) foo bar] 2>@1
+} "foo bar\nbar"
 
 # Redirecting standard error separately from standard output
 
 test exec-15.1 {standard error redirection} {exec} {
-    exec [interpreter] "$path(echo)" "First line" > "$path(gorp.file)"
-    list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2> "$path(gorp.file)"] \
-	    [exec [interpreter] "$path(cat)" "$path(gorp.file)"]
+    exec [interpreter] $path(echo) "First line" > $path(gorp.file)
+    list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" 2> $path(gorp.file)] \
+	    [exec [interpreter] $path(cat) $path(gorp.file)]
 } {{} {foo bar}}
 test exec-15.2 {standard error redirection} {exec stdio} {
-    list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" \
-		| [interpreter] "$path(echo)" biz baz >$path(gorp.file) 2> "$path(gorp.file2)"] \
-	    [exec [interpreter] "$path(cat)" "$path(gorp.file)"] \
-	    [exec [interpreter] "$path(cat)" "$path(gorp.file2)"]
+    list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \
+	      | [interpreter] $path(echo) biz baz >$path(gorp.file) 2> $path(gorp.file2)] \
+	[exec [interpreter] $path(cat) $path(gorp.file)] \
+	[exec [interpreter] $path(cat) $path(gorp.file2)]
 } {{} {biz baz} {foo bar}}
 test exec-15.3 {standard error redirection} {exec stdio} {
-    list [exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" \
-	        | [interpreter] "$path(echo)" biz baz 2>$path(gorp.file) > "$path(gorp.file2)"] \
-	    [exec [interpreter] "$path(cat)" "$path(gorp.file)"] \
-	    [exec [interpreter] "$path(cat)" "$path(gorp.file2)"]
+    list [exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" \
+	      | [interpreter] $path(echo) biz baz 2>$path(gorp.file) > $path(gorp.file2)] \
+	[exec [interpreter] $path(cat) $path(gorp.file)] \
+	[exec [interpreter] $path(cat) $path(gorp.file2)]
 } {{} {foo bar} {biz baz}}
 test exec-15.4 {standard error redirection} {exec} {
-    set f [open "$path(gorp.file)" w]
+    set f [open $path(gorp.file) w]
     puts $f "Line 1"
     flush $f
-    exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>@ $f
+    exec [interpreter] $path(sh) -c "\"$path(echo)\" foo bar 1>&2" 2>@ $f
     puts $f "Line 3"
     close $f
-    exec [interpreter] "$path(cat)" "$path(gorp.file)"
+    readfile $path(gorp.file)
 } {Line 1
 foo bar
 Line 3}
 test exec-15.5 {standard error redirection} {exec} {
-    exec [interpreter] "$path(echo)" "First line" > "$path(gorp.file)"
+    exec [interpreter] $path(echo) "First line" > "$path(gorp.file)"
     exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" 2>> "$path(gorp.file)"
-    exec [interpreter] "$path(cat)" "$path(gorp.file)"
+    readfile $path(gorp.file)
 } {First line
 foo bar}
 test exec-15.6 {standard error redirection} {exec stdio} {
     exec [interpreter] "$path(sh)" -c "\"$path(echo)\" foo bar 1>&2" > "$path(gorp.file2)" 2> "$path(gorp.file)" \
-	    >& "$path(gorp.file)" 2> "$path(gorp.file2)" | [interpreter] "$path(echo)" biz baz
-    list [exec [interpreter] "$path(cat)" "$path(gorp.file)"] [exec [interpreter] "$path(cat)" "$path(gorp.file2)"]
+	    >& "$path(gorp.file)" 2> "$path(gorp.file2)" | [interpreter] $path(echo) biz baz
+    list [readfile $path(gorp.file)] [readfile $path(gorp.file2)]
 } {{biz baz} {foo bar}}
 test exec-15.7 {standard error redirection 2>@1} {exec stdio} {
     # This redirects stderr output into normal result output from exec
@@ -552,7 +609,7 @@ test exec-16.1 {flush output before exec} {exec} {
     exec [interpreter] $path(echo) "Second line" >@ $f
     puts $f "Third line"
     close $f
-    exec [interpreter] $path(cat) $path(gorp.file)
+    readfile $path(gorp.file)
 } {First line
 Second line
 Third line}
@@ -562,78 +619,81 @@ test exec-16.2 {flush output before exec} {exec} {
     exec [interpreter] << {puts stderr {Second line}} >&@ $f > $path(gorp.file2)
     puts $f "Third line"
     close $f
-    exec [interpreter] $path(cat) $path(gorp.file)
+    readfile $path(gorp.file)
 } {First line
 Second line
 Third line}
 
-set path(script) [makeFile {} script]
-
-test exec-17.1 { inheriting standard I/O } {exec} {
+test exec-17.1 {inheriting standard I/O} -constraints {exec} -setup {
+    set path(script) [makeFile {} script]
     set f [open $path(script) w]
-    puts -nonewline $f {close stdout
-	set f [}
-    puts $f [list open $path(gorp.file) w]]
-    puts $f [list catch \
-	    [list exec [info nameofexecutable] $path(echo) foobar &]]
-    puts $f [list exec [info nameofexecutable] $path(sleep) 2]
-    puts $f {close $f}
+    puts $f [list lassign [list \
+	    [info nameofexecutable] $path(gorp.file) $path(echo) $path(sleep) \
+        ] exe file echo sleep]
+    puts $f {
+	close stdout
+	set f [open $file w]
+	catch {exec $exe $echo foobar &}
+	exec $exe $sleep 2
+	close $f
+    }
     close $f
+} -body {
     catch {exec [interpreter] $path(script)} result
-    set f [open $path(gorp.file) r]
-    lappend result [read $f]
-    close $f
-    set result
-} {{foobar
-}}
-
-test exec-18.1 { exec cat deals with weird file names} {exec tempNotWin} {
+    list $result [readfile $path(gorp.file)]
+} -cleanup {
+    removeFile $path(script)
+} -result {{} foobar}
+
+test exec-18.1 {exec deals with weird file names} -body {
+    set path(fooblah) [makeFile {contents} "foo\[\{blah"]
+    exec [interpreter] $path(cat) $path(fooblah)
+} -constraints {exec} -cleanup {
+    removeFile $path(fooblah)
+} -result contents
+test exec-18.2 {exec cat deals with weird file names} -body {
     # This is cross-platform, but the cat isn't predictably correct on
     # Windows.
-    set f "foo\[\{blah"
-    set path(fooblah) [makeFile {} $f]
-    set fout [open $path(fooblah) w]
-    puts $fout "contents"
-    close $fout
-    set res [list [catch {exec cat $path(fooblah)} msg] $msg]
-    removeFile $f
-    set res
-} {0 contents}
+    set path(fooblah) [makeFile {contents} "foo\[\{blah"]
+    exec cat $path(fooblah)
+} -constraints {exec tempNotWin} -cleanup {
+    removeFile $path(fooblah)
+} -result contents
 
 # Note that this test cannot be adapted to work on Windows; that platform has
-# no kernel support for an analog of O_APPEND.
-test exec-19.1 {exec >> uses O_APPEND} {
-    -constraints {exec unix}
-    -setup {
-	set tmpfile [makeFile {0} tmpfile.exec-19.1]
-    }
-    -body {
-	# Note that we have to allow for the current contents of the
-	# temporary file, which is why the result is 14 and not 12
-	exec /bin/sh -c \
+# no kernel support for an analog of O_APPEND. OTOH, that means we can assume
+# that there is a POSIX shell...
+test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
+    set tmpfile [makeFile {0} tmpfile.exec-19.1]
+} -body {
+    # Note that we have to allow for the current contents of the temporary
+    # file, which is why the result is 14 and not 12
+    exec /bin/sh -c \
 	    {for a in 1 2 3; do sleep 1; echo $a; done} >>$tmpfile &
-	exec /bin/sh -c \
+    exec /bin/sh -c \
 	    {for a in a b c; do sleep 1; echo $a; done} >>$tmpfile &
-	# The above two shell invokations take about 3 seconds to
-	# finish, so allow 5s (in case the machine is busy)
-	after 5000
-	# Check that no bytes have got lost through mixups with
-	# overlapping appends, which is only guaranteed to work when
-	# we set O_APPEND on the file descriptor in the [exec >>...]
-	file size $tmpfile
-    }
-    -cleanup {
-	removeFile $tmpfile
-    }
-    -result 14
-}
-
+    # The above two shell invokations take about 3 seconds to finish, so allow
+    # 5s (in case the machine is busy)
+    after 5000
+    # Check that no bytes have got lost through mixups with overlapping
+    # appends, which is only guaranteed to work when we set O_APPEND on the
+    # file descriptor in the [exec >>...]
+    file size $tmpfile
+} -cleanup {
+    removeFile $tmpfile
+} -result 14
+
+# ----------------------------------------------------------------------
 # cleanup
 
-foreach file {script gorp.file gorp.file2 echo cat wc sh sleep exit err} {
+foreach file {gorp.file gorp.file2 echo echo2 cat wc sh sh2 sleep exit err} {
     removeFile $file
 }
 unset -nocomplain path
 
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/execute.test b/tests/execute.test
index 0f02e01..94af158 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -1,41 +1,42 @@
-# This file contains tests for the tclExecute.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 execution-
-# related tests appear in several other test files including
-# namespace.test, basic.test, eval.test, for.test, etc.
+# This file contains tests for the tclExecute.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 execution-related tests appear in
+# several other test files including namespace.test, basic.test, eval.test,
+# for.test, etc.
 #
-# 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.
-#
-# RCS: @(#) $Id: execute.test,v 1.19 2004/10/28 17:21:25 msofer Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+catch {namespace delete {*}[namespace children :: test_ns_*]}
 catch {rename foo ""}
 catch {unset x}
 catch {unset y}
 catch {unset msg}
 
-::tcltest::testConstraint testobj \
-	[expr {[info commands testobj] != {} \
-	&& [info commands testdoubleobj] != {} \
-	&& [info commands teststringobj] != {} \
-	&& [info commands testobj] != {}}]
-
-::tcltest::testConstraint longIs32bit \
-	[expr {int(0x80000000) < 0}]
+testConstraint testobj [expr {
+    [llength [info commands testobj]]
+    && [llength [info commands testdoubleobj]]
+    && [llength [info commands teststringobj]]
+}]
 
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint testexprlongobj [llength [info commands testexprlongobj]]
+
 # Tests for the omnibus TclExecuteByteCode function:
 
 # INST_DONE not tested
@@ -43,14 +44,12 @@ catch {unset msg}
 # INST_PUSH4 not tested
 # INST_POP not tested
 # INST_DUP not tested
-# INST_CONCAT1 not tested
 # INST_INVOKE_STK4 not tested
 # INST_INVOKE_STK1 not tested
 # INST_EVAL_STK not tested
 # INST_EXPR_STK not tested
 
 # INST_LOAD_SCALAR1
-
 test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} {
     proc foo {} {
 	set x 1
@@ -68,7 +67,6 @@ test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} {
 	set y 1
 	return $y
     }
-
     proc foo {} $body
     foo
 } 1
@@ -81,9 +79,7 @@ test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} {
     list [catch {foo} msg] $msg
 } {1 {can't read "x": no such variable}}
 
-
 # INST_LOAD_SCALAR4
-
 test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
     set body {}
     for {set i 0} {$i < 256} {incr i} {
@@ -93,7 +89,6 @@ test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} {
 	set y 1
 	return $y
     }
-
     proc foo {} $body
     foo
 } 1
@@ -107,12 +102,10 @@ test execute-2.2 {TclExecuteByteCode, INST_LOAD_SCALAR4, error} {
 	unset y
 	return $y
     }
-
     proc foo {} $body
     list [catch {foo} msg] $msg
 } {1 {can't read "y": no such variable}}
 
-
 # INST_LOAD_SCALAR_STK not tested
 # INST_LOAD_ARRAY4 not tested
 # INST_LOAD_ARRAY1 not tested
@@ -506,10 +499,11 @@ test execute-3.77 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is non-numeri
 # INST_PUSH_RESULT not tested
 # INST_PUSH_RETURN_CODE not tested
 
-test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
-    catch {unset x}
-    catch {unset y}
+test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    unset -nocomplain x
+    unset -nocomplain y
+} -body {
     namespace eval test_ns_1 {
         namespace export cmd1
         proc cmd1 {args} {return "cmd1: $args"}
@@ -523,11 +517,12 @@ test execute-4.1 {Tcl_GetCommandFromObj, convert to tclCmdNameType} {
     list [namespace which -command ${x}${y}cmd1] \
          [catch {namespace which -command ${x}${y}cmd2} msg] $msg \
          [catch {namespace which -command ${x}${y}:cmd2} msg] $msg
-} {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
-test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {::test_ns_1::test_ns_2::cmd1 0 {} 0 {}}
+test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is invalid} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename foo ""}
-    catch {unset l}
+    unset -nocomplain l
+} -body {
     proc foo {} {
         return "global foo"
     }
@@ -544,11 +539,11 @@ test execute-4.2 {Tcl_GetCommandFromObj, check if cached tclCmdNameType is inval
         }
     }
     lappend l [test_ns_1::whichFoo]
-    set l
-} {::foo ::test_ns_1::foo}
-test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {::foo ::test_ns_1::foo}
+test execute-4.3 {Tcl_GetCommandFromObj, command never found} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename foo ""}
+} -body {
     namespace eval test_ns_1 {
         proc foo {} {
             return "namespace foo"
@@ -562,17 +557,18 @@ test execute-4.3 {Tcl_GetCommandFromObj, command never found} {
     list [namespace eval test_ns_1 {namespace which -command foo}] \
          [rename test_ns_1::foo ""] \
          [catch {namespace eval test_ns_1 {namespace which -command foo}} msg] $msg
-} {::test_ns_1::foo {} 0 {}}
+} -result {::test_ns_1::foo {} 0 {}}
 
-test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
-    catch {unset l}
+test execute-5.1 {SetCmdNameFromAny, set cmd name to empty heap string if NULL} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+    unset -nocomplain l
+} -body {
     proc {} {} {return {}}
     {}
     set l {}
     lindex {} 0
     {}
-} {}
+} -result {}
 
 test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName object} {
     proc {} {} {}
@@ -585,137 +581,325 @@ test execute-6.1 {UpdateStringOfCmdName: called for duplicate of empty cmdName o
     }
     p
 } {}
-
 test execute-6.2 {Evaluate an expression in a variable; compile the first time, do not the second} {
     set w {3*5}
     proc a {obj} {expr $obj}
     set res "[a $w]:[a $w]"
 } {15:15}
+test execute-6.3 {Tcl_ExprObj: don't use cached script bytecode [Bug 1899164]} -setup {
+    proc 0+0 {} {return SCRIPT}
+} -body {
+    set e { 0+0 }
+    if 1 $e
+    if 1 {expr $e}
+} -cleanup {
+    rename 0+0 {}
+} -result 0
+test execute-6.4 {TclCompEvalObj: don't use cached expr bytecode [Bug 1899164]} -setup {
+    proc 0+0 {} {return SCRIPT}
+} -body {
+    set e { 0+0 }
+    if 1 {expr $e}
+    if 1 $e
+} -cleanup {
+    rename 0+0 {}
+} -result SCRIPT
+test execute-6.5 {TclCompEvalObj: bytecode epoch validation} -body {
+    set script { llength {} }
+    set result {}
+    lappend result [if 1 $script]
+    set origName [namespace which llength]
+    rename $origName llength.orig
+    proc $origName {args} {return AHA!}
+    lappend result [if 1 $script]
+} -cleanup {
+    rename $origName {}
+    rename llength.orig $origName
+} -result {0 AHA!}
+test execute-6.6 {TclCompEvalObj: proc-body bytecode invalid for script} -body {
+    proc foo {} {set a 1}
+    set a untouched
+    set result {}
+    lappend result [foo] $a
+    lappend result [if 1 [info body foo]] $a
+} -cleanup {
+    rename foo {}
+} -result {1 untouched 1 1}
+test execute-6.7 {TclCompEvalObj: bytecode context validation} -setup {
+    namespace eval foo {}
+} -body {
+    set script { llength {} }
+    namespace eval foo {
+	proc llength {args} {return AHA!}
+    }
+    set result {}
+    lappend result [if 1 $script]
+    lappend result [namespace eval foo $script]
+} -cleanup {
+    namespace delete foo
+} -result {0 AHA!}
+test execute-6.8 {TclCompEvalObj: bytecode name resolution epoch validation} -setup {
+    namespace eval foo {}
+} -body {
+    set script { llength {} }
+    set result {}
+    lappend result [namespace eval foo $script]
+    namespace eval foo {
+	proc llength {args} {return AHA!}
+    }
+    lappend result [namespace eval foo $script]
+} -cleanup {
+    namespace delete foo
+} -result {0 AHA!}
+test execute-6.9 {TclCompEvalObj: bytecode interp validation} -setup {
+    interp create slave
+} -body {
+    set script { llength {} }
+    slave eval {proc llength args {return AHA!}}
+    set result {}
+    lappend result [if 1 $script]
+    lappend result [slave eval $script]
+} -cleanup {
+    interp delete slave
+} -result {0 AHA!}
+test execute-6.10 {TclCompEvalObj: bytecode interp validation} -body {
+    set script { llength {} }
+    interp create slave
+    set result {}
+    lappend result [slave eval $script]
+    interp delete slave
+    interp create slave
+    lappend result [slave eval $script]
+} -cleanup {
+    catch {interp delete slave}
+} -result {0 0}
+test execute-6.11 {Tcl_ExprObj: exprcode interp validation} -setup {
+    interp create slave
+} -constraints testexprlongobj -body {
+    set e { [llength {}]+1 }
+    set result {}
+    load {} Tcltest slave
+    interp alias {} e slave testexprlongobj
+    lappend result [e $e]
+    interp delete slave
+    interp create slave
+    load {} Tcltest slave
+    interp alias {} e slave testexprlongobj
+    lappend result [e $e]
+} -cleanup {
+    interp delete slave
+} -result {{This is a result: 1} {This is a result: 1}}
+test execute-6.12 {Tcl_ExprObj: exprcode interp validation} -setup {
+    interp create slave
+} -body {
+    set e { [llength {}]+1 }
+    set result {}
+    interp alias {} e slave expr
+    lappend result [e $e]
+    interp delete slave
+    interp create slave
+    interp alias {} e slave expr 
+    lappend result [e $e]
+} -cleanup {
+    interp delete slave
+} -result {1 1}
+test execute-6.13 {Tcl_ExprObj: exprcode epoch validation} -body {
+    set e { [llength {}]+1 }
+    set result {}
+    lappend result [expr $e]
+    set origName [namespace which llength]
+    rename $origName llength.orig
+    proc $origName {args} {return 1}
+    lappend result [expr $e]
+} -cleanup {
+    rename $origName {}
+    rename llength.orig $origName
+} -result {1 2}
+test execute-6.14 {Tcl_ExprObj: exprcode context validation} -setup {
+    namespace eval foo {}
+} -body {
+    set e { [llength {}]+1 }
+    namespace eval foo {
+	proc llength {args} {return 1}
+    }
+    set result {}
+    lappend result [expr $e]
+    lappend result [namespace eval foo {expr $e}]
+} -cleanup {
+    namespace delete foo
+} -result {1 2}
+test execute-6.15 {Tcl_ExprObj: exprcode name resolution epoch validation} -setup {
+    namespace eval foo {}
+} -body {
+    set e { [llength {}]+1 }
+    set result {}
+    lappend result [namespace eval foo {expr $e}]
+    namespace eval foo {
+	proc llength {args} {return 1}
+    }
+    lappend result [namespace eval foo {expr $e}]
+} -cleanup {
+    namespace delete foo
+} -result {1 2}
+test execute-6.16 {Tcl_ExprObj: exprcode interp validation} -setup {
+    interp create slave
+} -body {
+    set e { [llength {}]+1 }
+    interp alias {} e slave expr
+    slave eval {proc llength args {return 1}}
+    set result {}
+    lappend result [expr $e]
+    lappend result [e $e]
+} -cleanup {
+    interp delete slave
+} -result {1 2}
+test execute-6.17 {Tcl_ExprObj: exprcode context validation} -body {
+    proc foo e {set v 0; expr $e}
+    proc bar e {set v 1; expr $e}
+    set e { $v }
+    set result {}
+    lappend result [foo $e]
+    lappend result [bar $e]
+} -cleanup {
+    rename foo {}
+    rename bar {}
+} -result {0 1}
+test execute-6.18 {Tcl_ExprObj: exprcode context validation} -body {
+    proc foo e {set v {}; expr $e}
+    proc bar e {set v v; expr $e}
+    set e { [llength $v] }
+    set result {}
+    lappend result [foo $e]
+    lappend result [bar $e]
+} -cleanup {
+    rename foo {}
+    rename bar {}
+} -result {0 1}
 
-test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.0 {Wide int handling in INST_JUMP_FALSE/LAND} {
     set x 0x100000000
     expr {$x && 1}
 } 1
-test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.1 {Wide int handling in INST_JUMP_FALSE/LAND} {
     expr {0x100000000 && 1}
 } 1
-test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.2 {Wide int handling in INST_JUMP_FALSE/LAND} {
     expr {1 && 0x100000000}
 } 1
-test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.3 {Wide int handling in INST_JUMP_FALSE/LAND} {
     expr {wide(0x100000000) && 1}
 } 1
-test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {longIs32bit} {
+test execute-7.4 {Wide int handling in INST_JUMP_FALSE/LAND} {
     expr {1 && wide(0x100000000)}
 } 1
-test execute-7.5 {Wide int handling in INST_EQ} {longIs32bit} {
+test execute-7.5 {Wide int handling in INST_EQ} {
     expr {4 == (wide(1)+wide(3))}
 } 1
-test execute-7.6 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
+test execute-7.6 {Wide int handling in INST_EQ and [incr]} {
     set x 399999999999
     expr {400000000000 == [incr x]}
 } 1
 # wide ints have more bits of precision than doubles, but we convert anyway
-test execute-7.7 {Wide int handling in INST_EQ and [incr]} {longIs32bit} {
+test execute-7.7 {Wide int handling in INST_EQ and [incr]} {
     set x [expr {wide(1)<<62}]
     set y [expr {$x+1}]
     expr {double($x) == double($y)}
 } 1
-test execute-7.8 {Wide int conversions can change sign} {longIs32bit} {
+test execute-7.8 {Wide int conversions can change sign} longIs32bit {
     set x 0x80000000
     expr {int($x) < wide($x)}
 } 1
-test execute-7.9 {Wide int handling in INST_MOD} {longIs32bit} {
+test execute-7.9 {Wide int handling in INST_MOD} {
     expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
 } 316659348800185
-test execute-7.10 {Wide int handling in INST_MOD} {longIs32bit} {
+test execute-7.10 {Wide int handling in INST_MOD} {
     expr {((wide(1)<<60)-1) % 0x400000000}
 } 17179869183
-test execute-7.11 {Wide int handling in INST_LSHIFT} {longIs32bit} {
+test execute-7.11 {Wide int handling in INST_LSHIFT} {
     expr wide(42)<<30
 } 45097156608
-test execute-7.12 {Wide int handling in INST_LSHIFT} {longIs32bit} {
+test execute-7.12 {Wide int handling in INST_LSHIFT} {
     expr 12345678901<<3
 } 98765431208
-test execute-7.13 {Wide int handling in INST_RSHIFT} {longIs32bit} {
+test execute-7.13 {Wide int handling in INST_RSHIFT} {
     expr 0x543210febcda9876>>7
 } 47397893236700464
-test execute-7.14 {Wide int handling in INST_RSHIFT} {longIs32bit} {
-    expr 0x9876543210febcda>>7
+test execute-7.14 {Wide int handling in INST_RSHIFT} {
+    expr wide(0x9876543210febcda)>>7
 } -58286587177206407
-test execute-7.15 {Wide int handling in INST_BITOR} {longIs32bit} {
-    expr 0x9876543210febcda | 0x543210febcda9876
+test execute-7.15 {Wide int handling in INST_BITOR} {
+    expr wide(0x9876543210febcda) | 0x543210febcda9876
 } -2560765885044310786
-test execute-7.16 {Wide int handling in INST_BITXOR} {longIs32bit} {
-    expr 0x9876543210febcda ^ 0x543210febcda9876
+test execute-7.16 {Wide int handling in INST_BITXOR} {
+    expr wide(0x9876543210febcda) ^ 0x543210febcda9876
 } -3727778945703861076
-test execute-7.17 {Wide int handling in INST_BITAND} {longIs32bit} {
-    expr 0x9876543210febcda & 0x543210febcda9876
+test execute-7.17 {Wide int handling in INST_BITAND} {
+    expr wide(0x9876543210febcda) & 0x543210febcda9876
 } 1167013060659550290
-test execute-7.18 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.18 {Wide int handling in INST_ADD} {
     expr wide(0x7fffffff)+wide(0x7fffffff)
 } 4294967294
-test execute-7.19 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.19 {Wide int handling in INST_ADD} {
     expr 0x7fffffff+wide(0x7fffffff)
 } 4294967294
-test execute-7.20 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.20 {Wide int handling in INST_ADD} {
     expr wide(0x7fffffff)+0x7fffffff
 } 4294967294
-test execute-7.21 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.21 {Wide int handling in INST_ADD} {
     expr double(0x7fffffff)+wide(0x7fffffff)
 } 4294967294.0
-test execute-7.22 {Wide int handling in INST_ADD} {longIs32bit} {
+test execute-7.22 {Wide int handling in INST_ADD} {
     expr wide(0x7fffffff)+double(0x7fffffff)
 } 4294967294.0
-test execute-7.23 {Wide int handling in INST_SUB} {longIs32bit} {
+test execute-7.23 {Wide int handling in INST_SUB} {
     expr 0x123456789a-0x20406080a
 } 69530054800
-test execute-7.24 {Wide int handling in INST_MULT} {longIs32bit} {
+test execute-7.24 {Wide int handling in INST_MULT} {
     expr 0x123456789a*193
 } 15090186251290
-test execute-7.25 {Wide int handling in INST_DIV} {longIs32bit} {
+test execute-7.25 {Wide int handling in INST_DIV} {
     expr 0x123456789a/193
 } 405116546
-test execute-7.26 {Wide int handling in INST_UPLUS} {longIs32bit} {
+test execute-7.26 {Wide int handling in INST_UPLUS} {
     set x 0x123456871234568
     expr {+ $x}
 } 81985533099853160
-test execute-7.27 {Wide int handling in INST_UMINUS} {longIs32bit} {
+test execute-7.27 {Wide int handling in INST_UMINUS} {
     set x 0x123456871234568
     expr {- $x}
 } -81985533099853160
-test execute-7.28 {Wide int handling in INST_LNOT} {longIs32bit} {
+test execute-7.28 {Wide int handling in INST_LNOT} {
     set x 0x123456871234568
     expr {! $x}
 } 0
-test execute-7.29 {Wide int handling in INST_BITNOT} {longIs32bit} {
+test execute-7.29 {Wide int handling in INST_BITNOT} {
     set x 0x123456871234568
     expr {~ $x}
 } -81985533099853161
-test execute-7.30 {Wide int handling in function call} {longIs32bit} {
+test execute-7.30 {Wide int handling in function call} {
     set x 0x12345687123456
     incr x
     expr {log($x) == log(double($x))}
 } 1
-test execute-7.31 {Wide int handling in abs()} {longIs32bit} {
+test execute-7.31 {Wide int handling in abs()} {
     set x 0xa23456871234568
     incr x
     set y 0x123456871234568
     concat [expr {abs($x)}] [expr {abs($y)}]
 } {730503879441204585 81985533099853160}
-test execute-7.32 {Wide int handling} {longIs32bit} {
-    expr {1024 * 1024 * 1024 * 1024}
+test execute-7.32 {Wide int handling} longIs32bit {
+    expr {int(1024 * 1024 * 1024 * 1024)}
 } 0
-test execute-7.33 {Wide int handling} {longIs32bit} {
-    expr {0x1 * 1024 * 1024 * 1024 * 1024}
+test execute-7.33 {Wide int handling} longIs32bit {
+    expr {int(0x1 * 1024 * 1024 * 1024 * 1024)}
 } 0
-test execute-7.34 {Wide int handling} {longIs32bit} {
+test execute-7.34 {Wide int handling} {
     expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
 } 1099511627776
 
 test execute-8.1 {Stack protection} -setup {
-    # If [Bug #804681] has not been properly
-    # taken care of, this should segfault
+    # If [Bug #804681] has not been properly taken care of, this should
+    # segfault
     proc whatever args {llength $args}
     trace add variable ::errorInfo {write unset} whatever
 } -body {
@@ -724,48 +908,147 @@ test execute-8.1 {Stack protection} -setup {
     trace remove variable ::errorInfo {write unset} whatever
     rename whatever {}
 } -returnCodes error -match glob -result *
-
-test execute-8.2 {Stack restoration} -body {
-    # Test for [Bug #816641], correct restoration
-    # of the stack top after the stack is grown
-     proc f {args} { f bee bop }
-     catch f msg
-     set msg
- } -setup {
+test execute-8.2 {Stack restoration} -setup {
     # Avoid crashes when system stack size is limited (thread-enabled!)
-     set limit [interp recursionlimit {}]
-     interp recursionlimit {} 100
- } -cleanup {
-     interp recursionlimit {} $limit
- } -result {too many nested evaluations (infinite loop?)}
-
-test execute-8.3 {Stack restoration} -body {
-    # Test for [Bug #1055676], correct restoration
-    # of the stack top after the epoch is bumped and 
-    # the stack is grown in a call from a nested evaluation
-     set arglst [string repeat "a " 1000]
-     proc f {args} "f $arglst"
-     proc run {} {
-	 # bump the interp's epoch
-	 rename ::set ::dummy
-	 rename ::dummy ::set
-	 catch f msg
-	 set msg
-     }
-     run
- } -setup {
+    set limit [interp recursionlimit {}]
+    interp recursionlimit {} 100
+} -body {
+    # Test for [Bug #816641], correct restoration of the stack top after the
+    # stack is grown
+    proc f {args} { f bee bop }
+    catch f msg
+    set msg
+} -cleanup {
+    interp recursionlimit {} $limit
+} -result {too many nested evaluations (infinite loop?)}
+test execute-8.3 {Stack restoration} -setup {
     # Avoid crashes when system stack size is limited (thread-enabled!)
-     set limit [interp recursionlimit {}]
-     interp recursionlimit {} 100
- } -cleanup {
-     interp recursionlimit {} $limit
- } -result {too many nested evaluations (infinite loop?)}
+    set limit [interp recursionlimit {}]
+    interp recursionlimit {} 100
+} -body {
+    # Test for [Bug #1055676], correct restoration of the stack top after the
+    # epoch is bumped and the stack is grown in a call from a nested
+    # evaluation
+    set arglst [string repeat "a " 1000]
+    proc f {args} "f $arglst"
+    proc run {} {
+	# bump the interp's epoch
+	rename ::set ::dummy
+	rename ::dummy ::set
+	catch f msg
+	set msg
+    }
+    run
+} -cleanup {
+    interp recursionlimit {} $limit
+} -result {too many nested evaluations (infinite loop?)}
+test execute-8.4 {Compile epoch bump effect on stack trace} -setup {
+    proc foo {} {
+	error bar
+    }
+    proc FOO {} {
+	catch {error bar} m o
+	rename ::set ::dummy
+	rename ::dummy ::set
+	return -options $o $m
+    }
+} -body {
+    catch foo m o
+    set stack1 [dict get $o -errorinfo]
+    catch FOO m o
+    set stack2 [string map {FOO foo} [dict get $o -errorinfo]]
+    expr {$stack1 eq $stack2 ? {} : "These differ:\n$stack1\n$stack2"}
+} -cleanup {
+    rename foo {}
+    rename FOO {}
+    unset -nocomplain m o stack1 stack2
+} -result {}
+test execute-8.5 {Bug 2038069} -setup {
+    proc demo {} {
+	catch [list error FOO] m o
+	return $o
+    }
+} -body {
+    demo
+} -cleanup {
+    rename demo {}
+} -match glob -result {-code 1 -level 0 -errorstack * -errorcode NONE -errorinfo {FOO
+    while executing
+"error FOO"
+    invoked from within
+"catch \[list error FOO\] m o"} -errorline 2}
+
+test execute-9.1 {Interp result resetting [Bug 1522803]} {
+    set c 0
+    catch {
+	catch {set foo}
+	expr {1/$c}
+    }
+    if {[string match *foo* $::errorInfo]} {
+	set result "Bad errorInfo: $::errorInfo"
+    } else {
+	set result SUCCESS
+    }
+    set result
+} SUCCESS
 
+test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} {
+    apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130
+} {48 {304 304}}
+test execute-10.2 {Bug 2802881} -setup {
+    interp create slave
+} -body {
+    # If [Bug 2802881] is not fixed, this will segfault
+    slave eval {
+	trace add variable ::errorInfo write {expr {$foo} ;#}
+	proc demo {} {a {}{}}
+	demo
+    }
+} -cleanup {
+    interp delete slave
+} -returnCodes error -match glob -result *
+test execute-10.3 {Bug 3072640} -setup {
+    proc generate {n} {
+	for {set i 0} {$i < $n} {incr i} {
+	    yield $i
+	}
+    }
+    proc t {args} { 
+	incr ::foo 
+    }
+    trace add execution ::generate enterstep ::t
+} -body {
+    coroutine coro generate 5
+    trace remove execution ::generate enterstep ::t
+    set ::foo
+} -cleanup {
+    unset ::foo
+    rename generate {}
+    rename t {}
+    rename coro {}
+} -result 4
+
+test execute-11.1 {Bug 3142026: GrowEvaluationStack off-by-one} -setup {
+    interp create slave
+} -body {
+    slave eval {
+	set x [lrepeat 1320 199]
+	for {set i 0} {$i < 20} {incr i} {
+	    lappend x $i
+	    lsort -integer $x
+	}
+	# Crashes on failure
+	return ok
+    }
+} -cleanup {
+    interp delete slave
+} -result ok
+
 # cleanup
 if {[info commands testobj] != {}} {
    testobj freeallvars
 }
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
+catch {namespace delete {*}[namespace children :: test_ns_*]}
 catch {rename foo ""}
 catch {rename p ""}
 catch {rename {} ""}
@@ -775,3 +1058,8 @@ catch {unset y}
 catch {unset msg}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 1817e9a..06a00ba 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -12,15 +12,19 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: expr-old.test,v 1.26 2005/07/28 18:42:28 dgp Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2.1
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2.1
+namespace import ::tcltest::*
 
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testexprlong   [llength [info commands testexprlong]]
+testConstraint testexprdouble [llength [info commands testexprdouble]]
+testConstraint testexprstring [llength [info commands testexprstring]]
+testConstraint longIs32bit    [expr {int(0x80000000) < 0}]
+
+if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
     testConstraint testmathfunctions 0
 } else {
     testConstraint testmathfunctions 1
@@ -82,7 +86,7 @@ proc testIEEE {} {
 	}
     }
 }
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
 
 # First, test all of the integer operators individually.
 
@@ -139,7 +143,7 @@ test expr-old-1.50 {integer operators} {expr +36} 36
 test expr-old-1.51 {integer operators} {expr +--++36} 36
 test expr-old-1.52 {integer operators} {expr +36%+5} 1
 test expr-old-1.53 {integer operators} {
-    catch {unset x}
+    unset -nocomplain x
     set x yes
     list [expr {1 && $x}] [expr {$x && 1}] \
          [expr {0 || $x}] [expr {$x || 0}]
@@ -447,7 +451,7 @@ test expr-old-23.3 {double quotes} {
 test expr-old-23.4 {double quotes} {expr {"11\}\}22"}} 11}}22
 test expr-old-23.5 {double quotes} {expr {"\*bc"}} {*bc}
 test expr-old-23.6 {double quotes} {
-    catch {unset bogus__}
+    unset -nocomplain bogus__
     list [catch {expr {"$bogus__"}} msg] $msg
 } {1 {can't read "bogus__": no such variable}}
 test expr-old-23.7 {double quotes} {
@@ -460,7 +464,7 @@ test expr-old-23.8 {double quotes} {
 # Numbers in various bases.
 
 test expr-old-24.1 {numbers in different bases} {expr 0x20} 32
-test expr-old-24.2 {numbers in different bases} {expr 015} 13
+test expr-old-24.2 {numbers in different bases} {expr 0o15} 13
 
 # Conversions between various data types.
 
@@ -490,13 +494,13 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0
 test expr-old-26.1 {error conditions} {
     list [catch {expr 2+"a"} msg] $msg
 } {1 {can't use non-numeric string as operand of "+"}}
-test expr-old-26.2 {error conditions} {
-    list [catch {expr 2+4*} msg] $msg
-} {1 {syntax error in expression "2+4*": premature end of expression}}
-test expr-old-26.3 {error conditions} {
-    list [catch {expr 2+4*(} msg] $msg
-} {1 {syntax error in expression "2+4*(": premature end of expression}}
-catch {unset _non_existent_}
+test expr-old-26.2 {error conditions} -body {
+    expr 2+4*
+} -returnCodes error -match glob -result *
+test expr-old-26.3 {error conditions} -body {
+    expr 2+4*(
+} -returnCodes error -match glob -result *
+unset -nocomplain _non_existent_
 test expr-old-26.4 {error conditions} {
     list [catch {expr 2+$_non_existent_} msg] $msg
 } {1 {can't read "_non_existent_": no such variable}}
@@ -507,9 +511,9 @@ test expr-old-26.5 {error conditions} {
 test expr-old-26.6 {error conditions} {
     list [catch {expr {2+[set a]}} msg] $msg
 } {1 {can't use non-numeric string as operand of "+"}}
-test expr-old-26.7 {error conditions} {
-    list [catch {expr {2+(4}} msg] $msg
-} {1 {syntax error in expression "2+(4": looking for close parenthesis}}
+test expr-old-26.7 {error conditions} -body {
+    expr {2+(4}
+} -returnCodes error -match glob -result *
 test expr-old-26.8 {error conditions} {
     list [catch {expr 2/0} msg] $msg $errorCode
 } {1 {divide by zero} {ARITH DIVZERO {divide by zero}}}
@@ -522,33 +526,33 @@ test expr-old-26.10a {error conditions} !ieeeFloatingPoint {
 test expr-old-26.10b {error conditions} ieeeFloatingPoint {
     list [catch {expr 2.0/0.0} msg] $msg
 } {0 Inf}
-test expr-old-26.11 {error conditions} {
-    list [catch {expr 2#} msg] $msg
-} {1 {syntax error in expression "2#": extra tokens at end of expression}}
+test expr-old-26.11 {error conditions} -body {
+    expr 2#
+} -returnCodes error -match glob -result *
 test expr-old-26.12 {error conditions} -body {
-    list [catch {expr a.b} msg] $msg
-} -match glob -result {1 {syntax error in expression "a.b": * preceding $*}}
+    expr a.b
+} -returnCodes error -match glob -result *
 test expr-old-26.13 {error conditions} {
     list [catch {expr {"a"/"b"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "/"}}
-test expr-old-26.14 {error conditions} {
-    list [catch {expr 2:3} msg] $msg
-} {1 {syntax error in expression "2:3": extra tokens at end of expression}}
+test expr-old-26.14 {error conditions} -body {
+    expr 2:3
+} -returnCodes error -match glob -result *
 test expr-old-26.15 {error conditions} -body {
-    list [catch {expr a@b} msg] $msg
-} -match glob -result {1 {syntax error in expression "a@b": * preceding $*}}
+    expr a@b
+} -returnCodes error -match glob -result *
 test expr-old-26.16 {error conditions} {
     list [catch {expr a[b} msg] $msg
 } {1 {missing close-bracket}}
 test expr-old-26.17 {error conditions} -body {
-    list [catch {expr a`b} msg] $msg
-} -match glob -result {1 {syntax error in expression "a`b": * preceding $*}}
-test expr-old-26.18 {error conditions} {
-    list [catch {expr \"a\"\{b} msg] $msg
-} {1 syntax\ error\ in\ expression\ \"\"a\"\{b\":\ extra\ tokens\ at\ end\ of\ expression}
+    expr a`b
+} -returnCodes error -match glob -result *
+test expr-old-26.18 {error conditions} -body {
+    expr \"a\"\{b
+} -returnCodes error -match glob -result *
 test expr-old-26.19 {error conditions} -body {
-    list [catch {expr a} msg] $msg
-} -match glob -result {1 {syntax error in expression "a": * preceding $*}}
+    expr a
+} -returnCodes error -match glob -result *
 test expr-old-26.20 {error conditions} {
     list [catch expr msg] $msg
 } {1 {wrong # args: should be "expr arg ?arg ...?"}}
@@ -575,7 +579,7 @@ test expr-old-27.4 {cancelled evaluation} {
     expr {1?2:[set a 2]}
     set a
 } 1
-catch {unset x}
+unset -nocomplain x
 test expr-old-27.5 {cancelled evaluation} {
     list [catch {expr {[info exists x] && $x}} msg] $msg
 } {0 0}
@@ -597,11 +601,11 @@ test expr-old-27.10 {cancelled evaluation} {
     list [catch {expr {($x > 0) ? round(log($x)) : 0}} msg] $msg
 } {0 0}
 test expr-old-27.11 {cancelled evaluation} -body {
-    list [catch {expr {0 && foo}} msg] $msg
-} -match glob -result {1 {syntax error in expression "0 && foo": * preceding $*}}
+    expr {0 && foo}
+} -returnCodes error -match glob -result *
 test expr-old-27.12 {cancelled evaluation} -body {
-    list [catch {expr {0 ? 1 : foo}} msg] $msg
-} -match glob -result {1 {syntax error in expression "0 ? 1 : foo": * preceding $*}}
+    expr {0 ? 1 : foo}
+} -returnCodes error -match glob -result *
 
 # Tcl_ExprBool as used in "if" statements
 
@@ -673,12 +677,12 @@ test expr-old-28.14 {Tcl_ExprBool usage} {
 # Operands enclosed in braces
 
 test expr-old-29.1 {braces} {expr {{abc}}} abc
-test expr-old-29.2 {braces} {expr {{00010}}} 8
+test expr-old-29.2 {braces} {expr {{0o0010}}} 8
 test expr-old-29.3 {braces} {expr {{3.1200000}}} 3.12
 test expr-old-29.4 {braces} {expr {{a{b}{1 {2 3}}c}}} "a{b}{1 {2 3}}c"
-test expr-old-29.5 {braces} {
-    list [catch {expr "\{abc"} msg] $msg
-} {1 {missing close-brace}}
+test expr-old-29.5 {braces} -body {
+    expr "\{abc"
+} -returnCodes error -match glob -result *
 
 # Very long values
 
@@ -699,15 +703,15 @@ test expr-old-30.2 {long values} {
 test expr-old-31.1 {multiple arguments to expr command} {
     expr 4 + ( 6 *12) -3
 } 73
-test expr-old-31.2 {multiple arguments to expr command} {
-    list [catch {expr 2 + (3 + 4} msg] $msg
-} {1 {syntax error in expression "2 + (3 + 4": looking for close parenthesis}}
-test expr-old-31.3 {multiple arguments to expr command} {
-    list [catch {expr 2 + 3 +} msg] $msg
-} {1 {syntax error in expression "2 + 3 +": premature end of expression}}
-test expr-old-31.4 {multiple arguments to expr command} {
-    list [catch {expr 2 + 3 )} msg] $msg
-} {1 {syntax error in expression "2 + 3 )": extra tokens at end of expression}}
+test expr-old-31.2 {multiple arguments to expr command} -body {
+    expr 2 + (3 + 4
+} -returnCodes error -match glob -result *
+test expr-old-31.3 {multiple arguments to expr command} -body {
+    expr 2 + 3 +
+} -returnCodes error -match glob -result *
+test expr-old-31.4 {multiple arguments to expr command} -body {
+    expr 2 + 3 )
+} -returnCodes error -match glob -result *
 
 # Math functions
 
@@ -785,8 +789,8 @@ test expr-old-32.24 {math functions in expressions} {
 } {66}
 
 test expr-old-32.25a {math functions in expressions} {
-    list [catch {expr abs(0x8000000000000000)} msg] $msg
-} {1 {integer value too large to represent}}
+    expr abs(0x8000000000000000)
+} [expr 1<<63]
 
 test expr-old-32.25b {math functions in expressions} {
     expr abs(0x80000000)
@@ -814,11 +818,11 @@ test expr-old-32.32 {math functions in expressions} {
     expr int(-1.6)
 } {-1}
 test expr-old-32.33 {math functions in expressions} {
-    list [catch {expr int(1e60)} msg] $msg
-} {1 {integer value too large to represent}}
+    expr int(1e60)
+} 0
 test expr-old-32.34 {math functions in expressions} {
-    list [catch {expr int(-1e60)} msg] $msg
-} {1 {integer value too large to represent}}
+    expr int(-1e60)
+} 0
 test expr-old-32.35 {math functions in expressions} {
     expr round(1.49)
 } {1}
@@ -832,11 +836,11 @@ test expr-old-32.38 {math functions in expressions} {
     expr round(-1.51)
 } {-2}
 test expr-old-32.39 {math functions in expressions} {
-    list [catch {expr round(1e60)} msg] $msg
-} {1 {integer value too large to represent}}
+    expr round(1e60)
+} 999999999999999949387135297074018866963645011013410073083904
 test expr-old-32.40 {math functions in expressions} {
-    list [catch {expr round(-1e60)} msg] $msg
-} {1 {integer value too large to represent}}
+    expr round(-1e60)
+} -999999999999999949387135297074018866963645011013410073083904
 test expr-old-32.41 {math functions in expressions} {
     list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
 } {0 16.0}
@@ -858,12 +862,12 @@ test expr-old-32.46 {math functions in expressions} -body {
 test expr-old-32.47 {math functions in expressions} -body {
     list [catch {expr srand()} msg] $msg
 } -match glob -result {1 {too few arguments for math function*}}
-test expr-old-32.48 {math functions in expressions} {
-    list [catch {expr srand(3.79)} msg] $msg
-} {1 {can't use floating-point value as argument to srand}}
-test expr-old-32.49 {math functions in expressions} {
-    list [catch {expr srand("")} msg] $msg
-} {1 {argument to math function didn't have numeric value}}
+test expr-old-32.48 {math functions in expressions} -body {
+    expr srand(3.79)
+} -returnCodes error -match glob -result *
+test expr-old-32.49 {math functions in expressions} -body {
+    expr srand("")
+} -returnCodes error -match glob -result *
 test expr-old-32.50 {math functions in expressions} {
     set result [expr round(srand(12345) * 1000)]
     for {set i 0} {$i < 10} {incr i} {
@@ -871,11 +875,11 @@ test expr-old-32.50 {math functions in expressions} {
     }
     set result
 } {97 834 948 36 12 51 766 585 914 784 333}
-test expr-old-32.51 {math functions in expressions} {
-    list [catch {expr {srand([lindex "6ty" 0])}} msg] $msg
-} {1 {argument to math function didn't have numeric value}}
+test expr-old-32.51 {math functions in expressions} -body {
+    expr {srand([lindex "6ty" 0])}
+} -returnCodes error -match glob -result *
 test expr-old-32.52 {math functions in expressions} {
-    expr {srand(1<<37) < 1}
+    expr {srand(int(1<<37)) < 1}
 } {1}
 test expr-old-32.53 {math functions in expressions} {
     expr {srand((1<<31) - 1) > 0}
@@ -898,20 +902,20 @@ test expr-old-34.1 {errors in math functions} -body {
     list [catch {expr func_2(1.0)} msg] $msg
 } -match glob -result {1 {* "*func_2"}}
 test expr-old-34.2 {errors in math functions} -body {
-    list [catch {expr func|(1.0)} msg] $msg
-} -match glob -result {1 {syntax error in expression "func|(1.0)": * preceding $*}}
+    expr func|(1.0)
+} -returnCodes error -match glob -result *
 test expr-old-34.3 {errors in math functions} {
     list [catch {expr {hypot("a b", 2.0)}} msg] $msg
 } {1 {expected floating-point number but got "a b"}}
-test expr-old-34.4 {errors in math functions} {
-    list [catch {expr hypot(1.0 2.0)} msg] $msg
-} {1 {syntax error in expression "hypot(1.0 2.0)": missing close parenthesis at end of function call}}
-test expr-old-34.5 {errors in math functions} {
-    list [catch {expr hypot(1.0, 2.0} msg] $msg
-} {1 {syntax error in expression "hypot(1.0, 2.0": missing close parenthesis at end of function call}}
-test expr-old-34.6 {errors in math functions} {
-    list [catch {expr hypot(1.0 ,} msg] $msg
-} {1 {syntax error in expression "hypot(1.0 ,": premature end of expression}}
+test expr-old-34.4 {errors in math functions} -body {
+    expr hypot(1.0 2.0)
+} -returnCodes error -match glob -result *
+test expr-old-34.5 {errors in math functions} -body {
+    expr hypot(1.0, 2.0
+} -returnCodes error -match glob -result *
+test expr-old-34.6 {errors in math functions} -body {
+    expr hypot(1.0 ,
+} -returnCodes error -match glob -result *
 test expr-old-34.7 {errors in math functions} -body {
     list [catch {expr hypot(1.0)} msg] $msg
 } -match glob -result {1 {too few arguments for math function*}}
@@ -937,27 +941,27 @@ test expr-old-34.12b {errors in math functions} ieeeFloatingPoint {
     list [catch {expr -14.0*exp(100000)} msg] $msg
 } {0 -Inf}
 test expr-old-34.13 {errors in math functions} {
-    list [catch {expr int(1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+    expr wide(1.0e30)
+} 5076964154930102272
 test expr-old-34.14 {errors in math functions} {
-    list [catch {expr int(-1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+    expr wide(-1.0e30)
+} -5076964154930102272
 test expr-old-34.15 {errors in math functions} {
-    list [catch {expr round(1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+    expr round(1.0e30)
+} 1000000000000000019884624838656
 test expr-old-34.16 {errors in math functions} {
-    list [catch {expr round(-1.0e30)} msg] $msg $errorCode
-} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
+    expr round(-1.0e30)
+} -1000000000000000019884624838656
 test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \
     -body {
         list [catch {expr T1(4)} msg] $msg
     } -match glob -result {1 {too many arguments for math function*}}
 
 test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
-    expr 0289
+    expr 0o289
 } -returnCodes error -match glob -result {*invalid octal number*}
 test expr-old-36.2 {ExprLooksLikeInt procedure} {
-    set x 0289
+    set x 0o289
     list [catch {expr {$x+1}} msg] $msg
 } {1 {can't use invalid octal number as operand of "+"}}
 test expr-old-36.3 {ExprLooksLikeInt procedure} {
@@ -986,14 +990,14 @@ test expr-old-36.9 {ExprLooksLikeInt procedure} {
 } {0 240.0}
 test expr-old-36.10 {ExprLooksLikeInt procedure} -body {
     expr 78e
-} -returnCodes error -match glob -result {syntax error in expression "78e"*}
+} -returnCodes error -match glob -result *
 
 # test for [Bug #542588]
 test expr-old-36.11 {ExprLooksLikeInt procedure} {
     # define a "too large integer"; this one works also for 64bit arith
     set x 665802003400000000000000
-    list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use integer value too large to represent as operand of "+"}}
+    expr {$x+1}
+} 665802003400000000000001
 
 # tests for [Bug #587140]
 test expr-old-36.12 {ExprLooksLikeInt procedure} {
@@ -1006,19 +1010,16 @@ test expr-old-36.13 {ExprLooksLikeInt procedure} {
 } {1 {can't use non-numeric string as operand of "+"}}
 test expr-old-36.14 {ExprLooksLikeInt procedure} {
     set x "123456789012345678901234567890 "
-    list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use integer value too large to represent as operand of "+"}}
+    expr {$x+1}
+} 123456789012345678901234567891
 test expr-old-36.15 {ExprLooksLikeInt procedure} {
-    set x "099 "
+    set x "0o99 "
     list [catch {expr {$x+1}} msg] $msg
 } {1 {can't use invalid octal number as operand of "+"}}
 test expr-old-36.16 {ExprLooksLikeInt procedure} {
     set x " 0xffffffffffffffffffffffffffffffffffffff  "
-    list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use integer value too large to represent as operand of "+"}}
-
-testConstraint testexprlong   [llength [info commands testexprlong]]
-testConstraint testexprstring [llength [info commands testexprstring]]
+    expr {$x+1}
+} [expr 0x100000000000000000000000000000000000000]
 
 test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong {
     testexprlong 4+1
@@ -1028,10 +1029,102 @@ test expr-old-37.2 {Tcl_ExprLong handles wide ints gracefully} testexprlong {
     testexprlong wide(1)+2
 } {This is a result: 3}
 
-test expr-old-38.1 {Verify Tcl_ExprString's basic operation} testexprstring {
+test expr-old-37.3 {Tcl_ExprLong on the empty string} testexprlong {
+    testexprlong ""
+} {This is a result: 0}
+test expr-old-37.4 {Tcl_ExprLong coerces doubles} testexprlong {
+    testexprlong 3+.14159
+} {This is a result: 3}
+test expr-old-37.5 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+    testexprlong 0x80000000
+} {This is a result: -2147483648}
+test expr-old-37.6 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+    testexprlong 0xffffffff
+} {This is a result: -1}
+test expr-old-37.7 {Tcl_ExprLong handles overflows} \
+    -constraints {testexprlong longIs32bit} \
+    -match glob \
+    -body {
+	list [catch {testexprlong 0x100000000} result] $result
+    } \
+    -result {1 {integer value too large to represent*}}
+test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong {
+    testexprlong -0x80000000
+} {This is a result: -2147483648}
+test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+    testexprlong -0xffffffff
+} {This is a result: 1}
+test expr-old-37.10 {Tcl_ExprLong handles overflows} \
+    -constraints {testexprlong longIs32bit} \
+    -match glob \
+    -body {
+	list [catch {testexprlong -0x100000000} result] $result
+    } \
+    -result {1 {integer value too large to represent*}}
+test expr-old-37.11 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit}  {
+    testexprlong 2147483648.
+} {This is a result: -2147483648}
+test expr-old-37.12 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+    testexprlong 4294967295.
+} {This is a result: -1}
+test expr-old-37.13 {Tcl_ExprLong handles overflows} \
+    -constraints {testexprlong longIs32bit} \
+    -match glob \
+    -body {
+	list [catch {testexprlong 4294967296.} result] $result
+    } \
+    -result {1 {integer value too large to represent*}}
+test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong {
+    testexprlong -2147483648.
+} {This is a result: -2147483648}
+test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
+    testexprlong -4294967295.
+} {This is a result: 1}
+test expr-old-37.16 {Tcl_ExprLong handles overflows} \
+    -constraints {testexprlong longIs32bit} \
+    -match glob \
+    -body {
+	list [catch {testexprlong 4294967296.} result] $result
+    } \
+    -result {1 {integer value too large to represent*}}
+
+test expr-old-37.17 {Check that Tcl_ExprDouble doesn't modify interpreter result if no error} testexprdouble {
+    testexprdouble 4.+1.
+} {This is a result: 5.0}
+#Check for [Bug 1109484]
+test expr-old-37.18 {Tcl_ExprDouble on the empty string} testexprdouble {
+    testexprdouble ""
+} {This is a result: 0.0}
+test expr-old-37.19 {Tcl_ExprDouble coerces wides} testexprdouble {
+    testexprdouble 1[string repeat 0 17]
+} {This is a result: 1e+17}
+test expr-old-37.20 {Tcl_ExprDouble coerces bignums} testexprdouble {
+    testexprdouble 1[string repeat 0 38]
+} {This is a result: 1e+38}
+test expr-old-37.21 {Tcl_ExprDouble handles overflows} testexprdouble {
+    testexprdouble 17976931348623157[string repeat 0 292].
+} {This is a result: 1.7976931348623157e+308}
+test expr-old-37.22 {Tcl_ExprDouble handles overflows that look like int} \
+    testexprdouble {
+	testexprdouble 17976931348623157[string repeat 0 292]
+    } {This is a result: 1.7976931348623157e+308}
+test expr-old-37.23 {Tcl_ExprDouble handles overflows} \
+    ieeeFloatingPoint&&testexprdouble {
+	testexprdouble 17976931348623165[string repeat 0 292].
+    } {This is a result: Inf}
+test expr-old-37.24 {Tcl_ExprDouble handles overflows that look like int} \
+    ieeeFloatingPoint&&testexprdouble {
+	testexprdouble 17976931348623165[string repeat 0 292]
+    } {This is a result: Inf}
+test expr-old-37.25 {Tcl_ExprDouble and NaN} \
+    {ieeeFloatingPoint testexprdouble} {
+	list [catch {testexprdouble 0.0/0.0} result] $result
+    } {1 {domain error: argument not in valid range}}
+    
+test expr-old-38.1 {Verify Tcl_ExprString's basic operation} -constraints {testexprstring} -body {
     list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
 	    [catch {testexprstring "1+"} msg] $msg
-} {5 10.2 1 {syntax error in expression "1+": premature end of expression}}
+} -match glob -result {5 10.2 1 *}
 test expr-old-38.2 {Tcl_ExprString} testexprstring {
     # This one is "magical"
     testexprstring {}
@@ -1055,6 +1148,48 @@ test expr-old-39.1 {Rounding with wide result} {
 } {1 1}
 unset -nocomplain x y
 
+#
+# TIP #255 min and max math functions
+#
+
+test expr-old-40.1 {min math function} -body {
+    expr {min(0)}
+} -result 0
+test expr-old-40.2 {min math function} -body {
+    expr {min(0.0)}
+} -result 0.0
+test expr-old-40.3 {min math function} -body {
+    list [catch {expr {min()}} msg] $msg
+} -result {1 {too few arguments to math function "min"}}
+test expr-old-40.4 {min math function} -body {
+    expr {min(wide(-1) << 30, 4.5, -10)}
+} -result [expr {wide(-1) << 30}]
+test expr-old-40.5 {min math function} -body {
+    expr {min("a", 0)}
+} -returnCodes error -match glob -result *
+test expr-old-40.6 {min math function} -body {
+    expr {min(300, "0xFF")}
+} -result 255
+
+test expr-old-41.1 {max math function} -body {
+    expr {max(0)}
+} -result 0
+test expr-old-41.2 {max math function} -body {
+    expr {max(0.0)}
+} -result 0.0
+test expr-old-41.3 {max math function} -body {
+    list [catch {expr {max()}} msg] $msg
+} -result {1 {too few arguments to math function "max"}}
+test expr-old-41.4 {max math function} -body {
+    expr {max(wide(1) << 30, 4.5, -10)}
+} -result [expr {wide(1) << 30}]
+test expr-old-41.5 {max math function} -body {
+    expr {max("a", 0)}
+} -returnCodes error -match glob -result *
+test expr-old-41.6 {max math function} -body {
+    expr {max(200, "0xFF")}
+} -result 255
+
 # Special test for Pentium arithmetic bug of 1994:
 
 if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
@@ -1067,3 +1202,7 @@ if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} {
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/expr.test b/tests/expr.test
index 1aad141..6ad7208 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -9,16 +9,17 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: expr.test,v 1.37 2005/07/28 18:42:28 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testmathfunctions [expr {
-    ([catch {expr T1()} msg] != 1) || ($msg ne {unknown math function "T1"})
+    ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
 }]
 
 # Determine if "long int" type is a 32 bit number and if the wide
@@ -26,7 +27,8 @@ testConstraint testmathfunctions [expr {
 
 testConstraint longIs32bit [expr {int(0x80000000) < 0}]
 testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-testConstraint wideIs64bit [expr {(0x80000000 > 0) && (0x8000000000000000 < 0)}]
+testConstraint wideIs64bit \
+	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
 
 # Big test for correct ordering of data in [expr]
 
@@ -54,6 +56,8 @@ proc testIEEE {} {
 		ieeeValues(+Infinity)
 	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
 		ieeeValues(NaN)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \
+		ieeeValues(-NaN)
 	    set ieeeValues(littleEndian) 1
 	    return 1
 	}
@@ -76,6 +80,8 @@ proc testIEEE {} {
 		ieeeValues(+Infinity)
 	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
 		ieeeValues(NaN)
+	    binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-NaN)
 	    set ieeeValues(littleEndian) 0
 	    return 1
 	}
@@ -198,56 +204,49 @@ test expr-1.15 {TclCompileExprCmd: second level of substitutions in expr with co
 test expr-2.1 {TclCompileExpr: are builtin functions registered?} {
     expr double(5*[llength "6 2"])
 } 10.0
-test expr-2.2 {TclCompileExpr: error in expr} {
-    catch {expr 2***3} msg
-    set msg
-} {syntax error in expression "2***3": unexpected operator *}
-test expr-2.3 {TclCompileExpr: junk after legal expr} {
-    catch {expr 7*[llength "a b"]foo} msg
-    set msg
-} {syntax error in expression "7*2foo": extra tokens at end of expression}
+test expr-2.2 {TclCompileExpr: error in expr} -body {
+    expr 2***3
+} -returnCodes error -match glob -result *
+test expr-2.3 {TclCompileExpr: junk after legal expr} -body {
+    expr 7*[llength "a b"]foo
+} -returnCodes error -match glob -result *
 test expr-2.4 {TclCompileExpr: numeric expr string rep == formatted int rep} {
     expr {0001}
 } 1
 
 test expr-3.1 {CompileCondExpr: just lor expr} {expr 3||0} 1
 test expr-3.2 {CompileCondExpr: error in lor expr} -body {
-    catch {expr x||3} msg
-    set msg
-} -match glob -result {syntax error in expression "x||3": * preceding $*}
+    expr x||3
+} -returnCodes error -match glob -result *
 test expr-3.3 {CompileCondExpr: test true arm} {expr 3>2?44:66} 44
-test expr-3.4 {CompileCondExpr: error compiling true arm} {
-    catch {expr 3>2?2***3:66} msg
-    set msg
-} {syntax error in expression "3>2?2***3:66": unexpected operator *}
+test expr-3.4 {CompileCondExpr: error compiling true arm} -body {
+    expr 3>2?2***3:66
+} -returnCodes error -match glob -result *
 test expr-3.5 {CompileCondExpr: test false arm} {expr 2>3?44:66} 66
-test expr-3.6 {CompileCondExpr: error compiling false arm} {
-    catch {expr 2>3?44:2***3} msg
-    set msg
-} {syntax error in expression "2>3?44:2***3": unexpected operator *}
+test expr-3.6 {CompileCondExpr: error compiling false arm} -body {
+    expr 2>3?44:2***3
+} -returnCodes error -match glob -result *
 test expr-3.7 {CompileCondExpr: long arms & nested cond exprs} {
     hello_world
 } {Hello world}
-test expr-3.8 {CompileCondExpr: long arms & nested cond exprs} {
+test expr-3.8 {CompileCondExpr: long arms & nested cond exprs} unix {
+    # Fails with a stack overflow on threaded Windows builds
     do_twelve_days
 } 2358
 
 test expr-4.1 {CompileLorExpr: just land expr} {expr 1.3&&3.3} 1
 test expr-4.2 {CompileLorExpr: error in land expr} -body {
-    catch {expr x&&3} msg
-    set msg
-} -match glob -result {syntax error in expression "x&&3": *preceding $*} 
+    expr x&&3
+} -returnCodes error -match glob -result *
 test expr-4.3 {CompileLorExpr: simple lor exprs} {expr 0||1.0} 1
 test expr-4.4 {CompileLorExpr: simple lor exprs} {expr 3.0||0.0} 1
 test expr-4.5 {CompileLorExpr: simple lor exprs} {expr 0||0||1} 1
-test expr-4.6 {CompileLorExpr: error compiling lor arm} {
-    catch {expr 2***3||4.0} msg
-    set msg
-} {syntax error in expression "2***3||4.0": unexpected operator *}
-test expr-4.7 {CompileLorExpr: error compiling lor arm} {
-    catch {expr 1.3||2***3} msg
-    set msg
-} {syntax error in expression "1.3||2***3": unexpected operator *}
+test expr-4.6 {CompileLorExpr: error compiling lor arm} -body {
+    expr 2***3||4.0
+} -returnCodes error -match glob -result *
+test expr-4.7 {CompileLorExpr: error compiling lor arm} -body {
+    expr 1.3||2***3
+} -returnCodes error -match glob -result *
 test expr-4.8 {CompileLorExpr: error compiling lor arms} {
     list [catch {expr {"a"||"b"}} msg] $msg
 } {1 {expected boolean value but got "a"}}
@@ -268,21 +267,18 @@ test expr-4.12 {CompileLorExpr: error compiling land arms} {
 
 test expr-5.1 {CompileLandExpr: just bitor expr} {expr 7|0x13} 23
 test expr-5.2 {CompileLandExpr: error in bitor expr} -body {
-    catch {expr x|3} msg
-    set msg
-} -match glob -result {syntax error in expression "x|3": * preceding $*} 
+    expr x|3
+} -returnCodes error -match glob -result *
 test expr-5.3 {CompileLandExpr: simple land exprs} {expr 0&&1.0} 0
 test expr-5.4 {CompileLandExpr: simple land exprs} {expr 0&&0} 0
 test expr-5.5 {CompileLandExpr: simple land exprs} {expr 3.0&&1.2} 1
 test expr-5.6 {CompileLandExpr: simple land exprs} {expr 1&&1&&2} 1
-test expr-5.7 {CompileLandExpr: error compiling land arm} {
-    catch {expr 2***3&&4.0} msg
-    set msg
-} {syntax error in expression "2***3&&4.0": unexpected operator *}
-test expr-5.8 {CompileLandExpr: error compiling land arm} {
-    catch {expr 1.3&&2***3} msg
-    set msg
-} {syntax error in expression "1.3&&2***3": unexpected operator *}
+test expr-5.7 {CompileLandExpr: error compiling land arm} -body {
+    expr 2***3&&4.0
+} -returnCodes error -match glob -result *
+test expr-5.8 {CompileLandExpr: error compiling land arm} -body {
+    expr 1.3&&2***3
+} -returnCodes error -match glob -result *
 test expr-5.9 {CompileLandExpr: error compiling land arm} {
     list [catch {expr {"a"&&"b"}} msg] $msg
 } {1 {expected boolean value but got "a"}}
@@ -294,21 +290,18 @@ test expr-5.10 {CompileLandExpr: long land arms} {
 
 test expr-6.1 {CompileBitXorExpr: just bitand expr} {expr 7&0x13} 3
 test expr-6.2 {CompileBitXorExpr: error in bitand expr} -body {
-    catch {expr x|3} msg
-    set msg
-} -match glob -result {syntax error in expression "x|3": * preceding $*} 
+    expr x|3
+} -returnCodes error -match glob -result *
 test expr-6.3 {CompileBitXorExpr: simple bitxor exprs} {expr 7^0x13} 20
 test expr-6.4 {CompileBitXorExpr: simple bitxor exprs} {expr 3^0x10} 19
 test expr-6.5 {CompileBitXorExpr: simple bitxor exprs} {expr 0^7} 7
 test expr-6.6 {CompileBitXorExpr: simple bitxor exprs} {expr -1^7} -8
-test expr-6.7 {CompileBitXorExpr: error compiling bitxor arm} {
-    catch {expr 2***3|6} msg
-    set msg
-} {syntax error in expression "2***3|6": unexpected operator *}
+test expr-6.7 {CompileBitXorExpr: error compiling bitxor arm} -body {
+    expr 2***3|6
+} -returnCodes error -match glob -result *
 test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
-    catch {expr 2^x} msg
-    set msg
-} -match glob -result {syntax error in expression "2^x": * preceding $**}
+    expr 2^x
+} -returnCodes error -match glob -result *
 test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
     list [catch {expr {24.0^3}} msg] $msg
 } {1 {can't use floating-point value as operand of "^"}}
@@ -321,21 +314,18 @@ test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
 test expr-7.3 {CompileBitAndExpr: just equality expr} {expr 3.2!=2.2} 1
 test expr-7.4 {CompileBitAndExpr: just equality expr} {expr {"abc" == "abd"}} 0
 test expr-7.5 {CompileBitAndExpr: error in equality expr} -body {
-    catch {expr x==3} msg
-    set msg
-} -match glob -result {syntax error in expression "x==3": * preceding $*}
+    expr x==3
+} -returnCodes error -match glob -result *
 test expr-7.6 {CompileBitAndExpr: simple bitand exprs} {expr 7&0x13} 3
 test expr-7.7 {CompileBitAndExpr: simple bitand exprs} {expr 0xf2&0x53} 82
 test expr-7.8 {CompileBitAndExpr: simple bitand exprs} {expr 3&6} 2
 test expr-7.9 {CompileBitAndExpr: simple bitand exprs} {expr -1&-7} -7
-test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} {
-    catch {expr 2***3&6} msg
-    set msg
-} {syntax error in expression "2***3&6": unexpected operator *}
+test expr-7.10 {CompileBitAndExpr: error compiling bitand arm} -body {
+    expr 2***3&6
+} -returnCodes error -match glob -result *
 test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
-    catch {expr 2&x} msg
-    set msg
-} -match glob -result {syntax error in expression "2&x": * preceding $*}
+    expr 2&x
+} -returnCodes error -match glob -result *
 test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
     list [catch {expr {24.0&3}} msg] $msg
 } {1 {can't use floating-point value as operand of "&"}}
@@ -345,32 +335,28 @@ test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
 test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
 test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
 test expr-7.20 {CompileBitAndExpr: error in equality expr} -body {
-    catch {expr xne3} msg
-    set msg
-} -match glob -result {syntax error in expression "xne3": * preceding $*} 
+    expr xne3
+} -returnCodes error -match glob -result *
 
 test expr-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
 test expr-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
 test expr-8.3 {CompileEqualityExpr: just relational expr} {expr 3.2>"2.2"} 1
 test expr-8.4 {CompileEqualityExpr: just relational expr} {expr {"0y"<"0x12"}} 0
 test expr-8.5 {CompileEqualityExpr: error in relational expr} -body {
-    catch {expr x>3} msg
-    set msg
-} -match glob -result {syntax error in expression "x>3": * preceding $*}
+    expr x>3
+} -returnCodes error -match glob -result *
 test expr-8.6 {CompileEqualityExpr: simple equality exprs} {expr 7==0x13} 0
 test expr-8.7 {CompileEqualityExpr: simple equality exprs} {expr -0xf2!=0x53} 1
 test expr-8.8 {CompileEqualityExpr: simple equality exprs} {expr {"12398712938788234-1298379" != ""}} 1
 test expr-8.9 {CompileEqualityExpr: simple equality exprs} {expr -1!="abc"} 1
-test expr-8.10 {CompileEqualityExpr: error compiling equality arm} {
-    catch {expr 2***3==6} msg
-    set msg
-} {syntax error in expression "2***3==6": unexpected operator *}
+test expr-8.10 {CompileEqualityExpr: error compiling equality arm} -body {
+    expr 2***3==6
+} -returnCodes error -match glob -result *
 test expr-8.11 {CompileEqualityExpr: error compiling equality arm} -body {
-    catch {expr 2!=x} msg
-    set msg
-} -match glob -result {syntax error in expression "2!=x": * preceding $*}
+    expr 2!=x
+} -returnCodes error -match glob -result *
 test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1
-test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq "ü"}} 1
+test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq [set s \u00fc]}} 1
 test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
 test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0
 test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1
@@ -378,22 +364,18 @@ test expr-8.17 {CompileBitAndExpr: equality expr} {expr 01eq1} 0
 test expr-8.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
 test expr-8.19 {CompileBitAndExpr: equality expr} {expr {"abc" ne "abd"}} 1
 test expr-8.20 {CompileBitAndExpr: error in equality expr} -body {
-    catch {expr x ne3} msg
-    set msg
-} -match glob -result {syntax error in expression "x ne3": * preceding $*} 
+    expr x ne3
+} -returnCodes error -match glob -result *
 test expr-8.21 {CompileBitAndExpr: error in equality expr} -body {
     # These should be ""ed to avoid the error
-    catch {expr a eq b} msg
-    set msg
-} -match glob -result {syntax error in expression "a eq b": * preceding $*}
-test expr-8.22 {CompileBitAndExpr: error in equality expr} {
-    catch {expr {false eqfalse}} msg
-    set msg
-} {syntax error in expression "false eqfalse": extra tokens at end of expression}
-test expr-8.23 {CompileBitAndExpr: error in equality expr} {
-    catch {expr {false nefalse}} msg
-    set msg
-} {syntax error in expression "false nefalse": extra tokens at end of expression}
+    expr a eq b
+} -returnCodes error -match glob -result *
+test expr-8.22 {CompileBitAndExpr: error in equality expr} -body {
+    expr {false eqfalse}
+} -returnCodes error -match glob -result *
+test expr-8.23 {CompileBitAndExpr: error in equality expr} -body {
+    expr {false nefalse}
+} -returnCodes error -match glob -result *
 test expr-8.24 {CompileEqualityExpr: simple equality exprs} {
     set x 12398712938788234
     expr {$x == 100}
@@ -419,68 +401,59 @@ test expr-8.29 {CompileEqualityExpr: just relational expr} {
 test expr-8.30 {CompileEqualityExpr: simple equality exprs} {
     expr {"fake" != "bob"}
 } 1
-test expr-8.31 {expr edge cases} {
-    list [catch {expr {1e}} err] $err
-} {1 {syntax error in expression "1e": extra tokens at end of expression}}
-test expr-8.32 {expr edge cases} {
-    list [catch {expr {1E}} err] $err
-} {1 {syntax error in expression "1E": extra tokens at end of expression}}
-test expr-8.33 {expr edge cases} {
-    list [catch {expr {1e+}} err] $err
-} {1 {syntax error in expression "1e+": extra tokens at end of expression}}
-test expr-8.34 {expr edge cases} {
-    list [catch {expr {1E+}} err] $err
-} {1 {syntax error in expression "1E+": extra tokens at end of expression}}
-test expr-8.35 {expr edge cases} {
-    list [catch {expr {1ea}} err] $err
-} {1 {syntax error in expression "1ea": extra tokens at end of expression}}
+test expr-8.31 {expr edge cases} -body {
+    expr {1e}
+} -returnCodes error -match glob -result *
+test expr-8.32 {expr edge cases} -body {
+    expr {1E}
+} -returnCodes error -match glob -result *
+test expr-8.33 {expr edge cases} -body {
+    expr {1e+}
+} -returnCodes error -match glob -result *
+test expr-8.34 {expr edge cases} -body {
+    expr {1E+}
+} -returnCodes error -match glob -result *
+test expr-8.35 {expr edge cases} -body {
+    expr {1ea}
+} -returnCodes error -match glob -result *
 
 test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
 test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
 test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
 test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
-
 test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
-    expr {1<<63}
+    expr {int(1<<63)}
 } -9223372036854775808
-
 test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
-    expr {1<<31}
+    expr {int(1<<31)}
 } -2147483648
-
 test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
-    catch {expr x>>3} msg
-    set msg
-} -match glob -result {syntax error in expression "x>>3": * preceding $*}
+    expr x>>3
+} -returnCodes error -match glob -result *
 test expr-9.7 {CompileRelationalExpr: simple relational exprs} {expr 0xff>=+0x3} 1
 test expr-9.8 {CompileRelationalExpr: simple relational exprs} {expr -0xf2<0x3} 1
-test expr-9.9 {CompileRelationalExpr: error compiling relational arm} {
-    catch {expr 2***3>6} msg
-    set msg
-} {syntax error in expression "2***3>6": unexpected operator *}
+test expr-9.9 {CompileRelationalExpr: error compiling relational arm} -body {
+    expr 2***3>6
+} -returnCodes error -match glob -result *
 test expr-9.10 {CompileRelationalExpr: error compiling relational arm} -body {
-    catch {expr 2<x} msg
-    set msg
-} -match glob -result {syntax error in expression "2<x": * preceding $*}
+    expr 2<x
+} -returnCodes error -match glob -result *
 
 test expr-10.1 {CompileShiftExpr: just add expr} {expr 4+-2} 2
 test expr-10.2 {CompileShiftExpr: just add expr} {expr 0xff-2} 253
 test expr-10.3 {CompileShiftExpr: just add expr} {expr -1--2} 1
-test expr-10.4 {CompileShiftExpr: just add expr} {expr 1-0123} -82
+test expr-10.4 {CompileShiftExpr: just add expr} {expr 1-0o123} -82
 test expr-10.5 {CompileShiftExpr: error in add expr} -body {
-    catch {expr x+3} msg
-    set msg
-} -match glob -result {syntax error in expression "x+3": * preceding $*}
+    expr x+3
+} -returnCodes error -match glob -result *
 test expr-10.6 {CompileShiftExpr: simple shift exprs} {expr 0xff>>0x3} 31
 test expr-10.7 {CompileShiftExpr: simple shift exprs} {expr -0xf2<<0x3} -1936
-test expr-10.8 {CompileShiftExpr: error compiling shift arm} {
-    catch {expr 2***3>>6} msg
-    set msg
-} {syntax error in expression "2***3>>6": unexpected operator *}
+test expr-10.8 {CompileShiftExpr: error compiling shift arm} -body {
+    expr 2***3>>6
+} -returnCodes error -match glob -result *
 test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body {
-    catch {expr 2<<x} msg
-    set msg
-} -match glob -result {syntax error in expression "2<<x": * preceding $*}
+    expr 2<<x
+} -returnCodes error -match glob -result *
 test expr-10.10 {CompileShiftExpr: runtime error} {
     list [catch {expr {24.0>>43}} msg] $msg
 } {1 {can't use floating-point value as operand of ">>"}}
@@ -491,21 +464,18 @@ test expr-10.11 {CompileShiftExpr: runtime error} {
 test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
 test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
 test expr-11.3 {CompileAddExpr: just multiply expr} {expr -1/2} -1
-test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0123} 6
+test expr-11.4 {CompileAddExpr: just multiply expr} {expr 7891%0o123} 6
 test expr-11.5 {CompileAddExpr: error in multiply expr} -body {
-    catch {expr x*3} msg
-    set msg
-} -match glob -result {syntax error in expression "x*3": * preceding $*}
+    expr x*3
+} -returnCodes error -match glob -result *
 test expr-11.6 {CompileAddExpr: simple add exprs} {expr 0xff++0x3} 258
 test expr-11.7 {CompileAddExpr: simple add exprs} {expr -0xf2--0x3} -239
-test expr-11.8 {CompileAddExpr: error compiling add arm} {
-    catch {expr 2***3+6} msg
-    set msg
-} {syntax error in expression "2***3+6": unexpected operator *}
+test expr-11.8 {CompileAddExpr: error compiling add arm} -body {
+    expr 2***3+6
+} -returnCodes error -match glob -result *
 test expr-11.9 {CompileAddExpr: error compiling add arm} -body {
-    catch {expr 2-x} msg
-    set msg
-} -match glob -result {syntax error in expression "2-x": * preceding $*}
+    expr 2-x
+} -returnCodes error -match glob -result *
 test expr-11.10 {CompileAddExpr: runtime error} {
     list [catch {expr {24.0+"xx"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "+"}}
@@ -527,19 +497,16 @@ test expr-12.2 {CompileMultiplyExpr: just unary expr} {expr --5} 5
 test expr-12.3 {CompileMultiplyExpr: just unary expr} {expr !27} 0
 test expr-12.4 {CompileMultiplyExpr: just unary expr} {expr ~0xff00ff} -16711936
 test expr-12.5 {CompileMultiplyExpr: error in unary expr} -body {
-    catch {expr ~x} msg
-    set msg
-} -match glob -result {syntax error in expression "~x": * preceding $*}
+    expr ~x
+} -returnCodes error -match glob -result *
 test expr-12.6 {CompileMultiplyExpr: simple multiply exprs} {expr 0xff*0x3} 765
 test expr-12.7 {CompileMultiplyExpr: simple multiply exprs} {expr -0xf2%-0x3} -2
-test expr-12.8 {CompileMultiplyExpr: error compiling multiply arm} {
-    catch {expr 2*3%%6} msg
-    set msg
-} {syntax error in expression "2*3%%6": unexpected operator %}
+test expr-12.8 {CompileMultiplyExpr: error compiling multiply arm} -body {
+    expr 2*3%%6
+} -returnCodes error -match glob -result *
 test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
-    catch {expr 2*x} msg
-    set msg
-} -match glob -result {syntax error in expression "2*x": * preceding $*}
+    expr 2*x
+} -returnCodes error -match glob -result *
 test expr-12.10 {CompileMultiplyExpr: runtime error} {
     list [catch {expr {24.0*"xx"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "*"}}
@@ -548,20 +515,18 @@ test expr-12.11 {CompileMultiplyExpr: runtime error} {
 } {1 {can't use non-numeric string as operand of "/"}}
 
 test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
-test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +000123} 83
+test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
 test expr-13.3 {CompileUnaryExpr: unary exprs} {expr +--++36} 36
 test expr-13.4 {CompileUnaryExpr: unary exprs} {expr !2} 0
 test expr-13.5 {CompileUnaryExpr: unary exprs} {expr +--+-62.0} -62.0
 test expr-13.6 {CompileUnaryExpr: unary exprs} {expr !0.0} 1
 test expr-13.7 {CompileUnaryExpr: unary exprs} {expr !0xef} 0
 test expr-13.8 {CompileUnaryExpr: error compiling unary expr} -body {
-    catch {expr ~x} msg
-    set msg
-} -match glob -result {syntax error in expression "~x": * preceding $*}
-test expr-13.9 {CompileUnaryExpr: error compiling unary expr} {
-    catch {expr !1.x} msg
-    set msg
-} {syntax error in expression "!1.x": extra tokens at end of expression}
+    expr ~x
+} -returnCodes error -match glob -result *
+test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
+    expr !1.x
+} -returnCodes error -match glob -result *
 test expr-13.10 {CompileUnaryExpr: runtime error} {
     list [catch {expr {~"xx"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "~"}}
@@ -589,7 +554,7 @@ test expr-13.17 {CompileUnaryExpr: negating non-numeric boolean literals} {
 test expr-14.1 {CompilePrimaryExpr: literal primary} {expr 1} 1
 test expr-14.2 {CompilePrimaryExpr: literal primary} {expr 123} 123
 test expr-14.3 {CompilePrimaryExpr: literal primary} {expr 0xff} 255
-test expr-14.4 {CompilePrimaryExpr: literal primary} {expr 00010} 8
+test expr-14.4 {CompilePrimaryExpr: literal primary} {expr 0o0010} 8
 test expr-14.5 {CompilePrimaryExpr: literal primary} {expr 62.0} 62.0
 test expr-14.6 {CompilePrimaryExpr: literal primary} {
     expr 3.1400000
@@ -627,14 +592,11 @@ test expr-14.15 {CompilePrimaryExpr: var reference primary} {
     set msg
 } 123.2
 test expr-14.16 {CompilePrimaryExpr: error compiling var reference primary} -body {
-    catch {expr {$a(foo}} msg
-    set errorInfo
-} -match glob -result {missing )
-    while *ing
-"expr {$a(foo}"}
-test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} {
+    expr {$a(foo}
+} -returnCodes error -match glob -result *
+test expr-14.17 {CompilePrimaryExpr: string primary that looks like var ref} -body {
     expr $
-} $
+} -returnCodes error -match glob -result *
 test expr-14.18 {CompilePrimaryExpr: quoted string primary} {
     expr "21"
 } 21
@@ -657,16 +619,13 @@ test expr-14.22 {CompilePrimaryExpr: subcommand primary} {
 } 123
 test expr-14.23 {CompilePrimaryExpr: error in subcommand primary} -body {
     catch {expr {[set]}} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
 test expr-14.24 {CompilePrimaryExpr: error in subcommand primary} -body {
-    catch {expr {[set i}} msg
-    set errorInfo
-} -match glob -result {missing close-bracket
-    while *ing
-"expr {\[set i}"}
+    expr {[set i}
+} -returnCodes error -match glob -result *
 test expr-14.25 {CompilePrimaryExpr: math function primary} {
     format %.6g [expr exp(1.0)]
 } 2.71828
@@ -674,73 +633,58 @@ test expr-14.26 {CompilePrimaryExpr: math function primary} {
     format %.6g [expr pow(2.0+0.1,3.0+0.1)]
 } 9.97424
 test expr-14.27 {CompilePrimaryExpr: error in math function primary} -body {
-    catch {expr sinh::(2.0)} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "sinh::(2.0)": * function arguments*
-    while *ing
-"expr sinh::(2.0)"}
+    expr sinh::(2.0)
+} -returnCodes error -match glob -result *
 test expr-14.28 {CompilePrimaryExpr: subexpression primary} {
     expr 2+(3*4)
 } 14
 test expr-14.29 {CompilePrimaryExpr: error in subexpression primary} -body {
     catch {expr 2+(3*[set])} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
 test expr-14.30 {CompilePrimaryExpr: missing paren in subexpression primary} -body {
-    catch {expr 2+(3*(4+5)} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "2+(3*(4+5)": looking for close parenthesis
-    while *ing
-"expr 2+(3*(4+5)"}
+    expr 2+(3*(4+5)
+} -returnCodes error -match glob -result *
 test expr-14.31 {CompilePrimaryExpr: just var ref in subexpression primary} {
     set i "5+10"
     list "[expr $i] == 15" "[expr ($i)] == 15" "[eval expr ($i)] == 15"
 } {{15 == 15} {15 == 15} {15 == 15}}
 test expr-14.32 {CompilePrimaryExpr: unexpected token} -body {
-    catch {expr @} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "@": character not legal in expressions
-    while *ing
-"expr @"}
+    expr @
+} -returnCodes error -match glob -result *
 
 test expr-15.1 {CompileMathFuncCall: missing parenthesis} -body {
-    catch {expr sinh2.0)} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "sinh2.0)": * preceding $*
-    while *ing
-"expr sinh2.0)"}
+    expr sinh2.0)
+} -returnCodes error -match glob -result *
 test expr-15.2 {CompileMathFuncCall: unknown math function} -body {
     catch {expr whazzathuh(1)} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {* "*whazzathuh"
     while *ing
 "expr whazzathuh(1)"}
 test expr-15.3 {CompileMathFuncCall: too many arguments} -body {
     catch {expr sin(1,2,3)} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {too many arguments for math function*
     while *ing
 "expr sin(1,2,3)"}
 test expr-15.4 {CompileMathFuncCall: ')' found before last required arg} -body {
     catch {expr sin()} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {too few arguments for math function*
     while *ing
 "expr sin()"}
 test expr-15.5 {CompileMathFuncCall: too few arguments} -body {
     catch {expr pow(1)} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {too few arguments for math function*
     while *ing
 "expr pow(1)"}
 test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
-    catch {expr sin(1} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "sin(1": missing close parenthesis at end of function call
-    while *ing
-"expr sin(1"}
+    expr sin(1
+} -returnCodes error -match glob -result *
 test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
     expr 2*T1()
 } 246
@@ -768,9 +712,15 @@ test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunct
 test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
     expr T3(21.0, wide(37))
 } 37.0
-test expr=15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
+test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
     expr T3(wide(21), 37.0)
 } 37.0
+test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints {
+    testmathfunctions
+} -body {
+    expr T3(0,"a")
+} -returnCodes error -result {argument to math function didn't have numeric value}
+
 
 test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
     catch {unset a}
@@ -838,7 +788,7 @@ test expr-20.1 {wrong brace matching} {
     set cmd "expr $l$q|$q == $q$r$q$r"
     list [catch $cmd a] $a
 } {1 {extra characters after close-brace}}
-test expr-20.2 {double invocation of variable traces} {
+test expr-20.2 {double invocation of variable traces} -body {
     set exprtracecounter 0
     proc exprtraceproc {args} {
        upvar #0 exprtracecounter counter
@@ -856,7 +806,7 @@ test expr-20.2 {double invocation of variable traces} {
     list [catch {expr "$exprtracevar + 20"} a] $a \
         [catch {expr "$exprtracevar + 20"} b] $b \
         [unset exprtracevar exprtracecounter]
-} {1 {syntax error in expression "1 oops 10 + 20": extra tokens at end of expression} 0 32 {}}
+} -match glob -result {1 * 0 32 {}}
 test expr-20.3 {broken substitution of integer digits} {
     # fails with 8.0.x, but not 8.1b2
     list [set a 000; expr 0x1$a] [set a 1; expr ${a}000]
@@ -889,9 +839,9 @@ test expr-21.9 	{non-numeric boolean literals} {expr !off  } 1
 test expr-21.10 {non-numeric boolean literals} {expr !on   } 0
 test expr-21.11 {non-numeric boolean literals} {expr !no   } 1
 test expr-21.12 {non-numeric boolean literals} {expr !yes  } 0
-test expr-21.13 {non-numeric boolean literals} {
-    list [catch {expr !truef} err] $err
-} {1 {syntax error in expression "!truef": the word "truef" requires a preceding $ if it's a variable or function arguments if it's a function}}
+test expr-21.13 {non-numeric boolean literals} -body {
+    expr !truef
+} -returnCodes error -match glob -result *
 test expr-21.14 {non-numeric boolean literals} {
     list [catch {expr !"truef"} err] $err
 } {1 {can't use non-numeric string as operand of "!"}}
@@ -967,18 +917,15 @@ test expr-23.2 {CompileExponentialExpr: just exponential expr} {expr 0xff**2} 65
 test expr-23.3 {CompileExponentialExpr: just exponential expr} {expr -1**2} 1
 test expr-23.4 {CompileExponentialExpr: just exponential expr} {expr 18**07} 612220032
 test expr-23.5 {CompileExponentialExpr: error in exponential expr} -body {
-    catch {expr x**3} msg
-    set msg
-} -match glob -result {syntax error in expression "x**3": * preceding $*}
+    expr x**3
+} -returnCodes error -match glob -result *
 test expr-23.6 {CompileExponentialExpr: simple expo exprs} {expr 0xff**0x3} 16581375
-test expr-23.7 {CompileExponentialExpr: error compiling expo arm} {
-    catch {expr (-3-)**6} msg
-    set msg
-} {syntax error in expression "(-3-)**6": unexpected close parenthesis}
+test expr-23.7 {CompileExponentialExpr: error compiling expo arm} -body {
+    expr (-3-)**6
+} -returnCodes error -match glob -result *
 test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body {
-    catch {expr 2**x} msg
-    set msg
-} -match glob -result {syntax error in expression "2**x": * preceding $*}
+    expr 2**x
+} -returnCodes error -match glob -result *
 test expr-23.9 {CompileExponentialExpr: runtime error} {
     list [catch {expr {24.0**"xx"}} msg] $msg
 } {1 {can't use non-numeric string as operand of "**"}}
@@ -1016,19 +963,486 @@ test expr-23.32 {INST_EXPON: special cases} {expr {wide(1)**wide(1234567)}} 1
 test expr-23.33 {INST_EXPON: special cases} {expr {wide(2)**wide(-2)}} 0
 test expr-23.34 {INST_EXPON: special cases} {expr {2**0}} 1
 test expr-23.35 {INST_EXPON: special cases} {expr {wide(2)**0}} 1
+test expr-23.36 {INST_EXPON: big integer} {expr {10**17}} 1[string repeat 0 17]
+test expr-23.37 {INST_EXPON: big integer} {expr {10**18}} 1[string repeat 0 18]
+test expr-23.38 {INST_EXPON: big integer} {expr {10**19}} 1[string repeat 0 19]
+test expr-23.39 {INST_EXPON: big integer} {
+    expr 1[string repeat 0 30]**2
+} 1[string repeat 0 60]
+test expr-23.40 {INST_EXPON: overflow to big integer} {expr {(-10)**3}} -1000
+test expr-23.41 {INST_EXPON: overflow to big integer} {expr 2**64} [expr 1<<64]
+test expr-23.42 {INST_EXPON: overflow to big integer} {expr 4**32} [expr 1<<64]
+test expr-23.43 {INST_EXPON: overflow to big integer} {expr 16**16} [expr 1<<64]
+test expr-23.44 {INST_EXPON: overflow to big integer} {expr 256**8} [expr 1<<64]
+test expr-23.45 {INST_EXPON: Bug 1555371} {expr 2**1} 2
+test expr-23.46 {INST_EXPON: Bug 1561260} -body {
+    expr 5**28
+} -match glob -result *5
+test expr-23.47 {INST_EXPON: Bug 1561260} {
+    expr 2**32*5**32
+} 1[string repeat 0 32]
+test expr-23.48 {INST_EXPON: TIP 274: right assoc} {
+expr 2**3**4
+} 2417851639229258349412352
+test expr-23.49 {INST_EXPON: optimize powers of 2} {
+    set trouble {test powers of 2}
+    for {set tval 0} {$tval <= 66} {incr tval} {
+	set is [expr {2 ** $tval}]
+	set sb [expr {1 << $tval}]
+	if {$is != $sb} {
+	    append trouble \n "2**" $tval " is " $is " should be " $sb
+	}
+	if {$tval >= 1} {
+	    set is [expr {-2 ** $tval}]
+	    set sb [expr {1 << $tval}]
+	    if {$tval & 1} {
+		set sb [expr {-$sb}]
+	    }
+	    if {$is != $sb} {
+		append trouble \n "-2**" $tval " is " $is " should be " $sb
+	    }
+	}
+    }
+    set trouble
+} {test powers of 2}
+test expr-23.50 {INST_EXPON: small powers of 32-bit integers} {
+    set trouble {test small powers of 32-bit ints}
+    for {set base 3} {$base <= 45} {incr base} {
+	set sb $base
+	set sbm [expr {-$base}]
+	for {set expt 2} {$expt <= 8} {incr expt} {
+	    set sb [expr {$sb * $base}]
+	    set is [expr {$base ** $expt}]
+	    if {$sb != $is} {
+		append trouble \n $base ** $expt " is " $is " should be " $sb
+	    }
+	    set sbm [expr {-$sbm * $base}]
+	    set ism [expr {(-$base) ** $expt}]
+	    if {$sbm != $ism} {
+		append trouble \n - $base ** $expt " is " $ism \
+		    " should be " $sbm
+	    }
+	}
+    }
+    set trouble
+} {test small powers of 32-bit ints}
+test expr-23.51 {INST_EXPON: intermediate powers of 32-bit integers} {
+    set trouble {test intermediate powers of 32-bit ints}
+    for {set base 3} {$base <= 11} {incr base} {
+	set sb [expr {$base ** 8}]
+	set sbm $sb
+	for {set expt 9} {$expt <= 21} {incr expt} {
+	    set sb [expr {$sb * $base}]
+	    set sbm [expr {$sbm * -$base}]
+	    set is [expr {$base ** $expt}]
+	    set ism [expr {-$base ** $expt}]
+	    if {$sb != $is} {
+		append trouble \n $base ** $expt " is " $is " should be " $sb
+	    }
+	    if {$sbm != $ism} {
+		append trouble \n - $base ** $expt " is " $ism  \
+		    " should be " $sbm
+	    }
+	}
+    }
+    set trouble
+} {test intermediate powers of 32-bit ints}
+test expr-23.52 {INST_EXPON: small integer powers with 64-bit results} {
+    set trouble {test small int powers with 64-bit results}
+    for {set exp 2} {$exp <= 16} {incr exp} {
+	set base [expr {entier(pow(double(0x7fffffffffffffff),(1.0/$exp)))}]
+	set sb 1
+	set sbm 1
+	for {set i 0} {$i < $exp} {incr i} {
+	    set sb [expr {$sb * $base}]
+	    set sbm [expr {$sbm * -$base}]
+	}
+	set is [expr {$base ** $exp}]
+	set ism [expr {-$base ** $exp}]
+	if {$sb != $is} {
+	    append trouble \n $base ** $exp " is " $is " should be " $sb
+	}
+	if {$sbm != $ism} {
+	    append trouble \n - $base ** $exp " is " $ism " should be " $sbm
+	}
+	incr base
+	set sb 1
+	set sbm 1
+	for {set i 0} {$i < $exp} {incr i} {
+	    set sb [expr {$sb * $base}]
+	    set sbm [expr {$sbm * -$base}]
+	}
+	set is [expr {$base ** $exp}]
+	set ism [expr {-$base ** $exp}]
+	if {$sb != $is} {
+	    append trouble \n $base ** $exp " is " $is " should be " $sb
+	}
+	if {$sbm != $ism} {
+	    append trouble \n - $base ** $exp " is " $ism " should be " $sbm
+	}
+    }
+    set trouble
+} {test small int powers with 64-bit results}
+test expr-23.53 {INST_EXPON: intermediate powers of 64-bit integers} {
+    set trouble {test intermediate powers of 64-bit ints}
+    for {set base 3} {$base <= 13} {incr base} {
+	set sb [expr {$base ** 15}]
+	set sbm [expr {-$sb}]
+	for {set expt 16} {$expt <= 39} {incr expt} {
+	    set sb [expr {$sb * $base}]
+	    set sbm [expr {$sbm * -$base}]
+	    set is [expr {$base ** $expt}]
+	    set ism [expr {-$base ** $expt}]
+	    if {$sb != $is} {
+		append trouble \n $base ** $expt " is " $is " should be " $sb
+	    }
+	    if {$sbm != $ism} {
+		append trouble \n - $base ** $expt " is " $ism  \
+		    " should be " $sbm
+	    }
+	}
+    }
+    set trouble
+} {test intermediate powers of 64-bit ints}
+test expr-23.54.0 {INST_EXPON: Bug 2798543} {
+    expr {3**9 == 3**65545}
+} 0
+test expr-23.54.1 {INST_EXPON: Bug 2798543} {
+    expr {3**10 == 3**65546}
+} 0
+test expr-23.54.2 {INST_EXPON: Bug 2798543} {
+    expr {3**11 == 3**65547}
+} 0
+test expr-23.54.3 {INST_EXPON: Bug 2798543} {
+    expr {3**12 == 3**65548}
+} 0
+test expr-23.54.4 {INST_EXPON: Bug 2798543} {
+    expr {3**13 == 3**65549}
+} 0
+test expr-23.54.5 {INST_EXPON: Bug 2798543} {
+    expr {3**14 == 3**65550}
+} 0
+test expr-23.54.6 {INST_EXPON: Bug 2798543} {
+    expr {3**15 == 3**65551}
+} 0
+test expr-23.54.7 {INST_EXPON: Bug 2798543} {
+    expr {3**16 == 3**65552}
+} 0
+test expr-23.54.8 {INST_EXPON: Bug 2798543} {
+    expr {3**17 == 3**65553}
+} 0
+test expr-23.54.9 {INST_EXPON: Bug 2798543} {
+    expr {3**18 == 3**65554}
+} 0
+test expr-23.54.10 {INST_EXPON: Bug 2798543} {
+    expr {3**19 == 3**65555}
+} 0
+test expr-23.54.11 {INST_EXPON: Bug 2798543} {
+    expr {3**9 == 3**131081}
+} 0
+test expr-23.54.12 {INST_EXPON: Bug 2798543} -body {
+    expr {3**9 == 3**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.54.13 {INST_EXPON: Bug 2798543} {
+    expr {(-3)**9 == (-3)**65545}
+} 0
+test expr-23.55.0 {INST_EXPON: Bug 2798543} {
+    expr {4**9 == 4**65545}
+} 0
+test expr-23.55.1 {INST_EXPON: Bug 2798543} {
+    expr {4**15 == 4**65551}
+} 0
+test expr-23.55.2 {INST_EXPON: Bug 2798543} {
+    expr {4**9 == 4**131081}
+} 0
+test expr-23.55.3 {INST_EXPON: Bug 2798543} -body {
+    expr {4**9 == 4**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.55.4 {INST_EXPON: Bug 2798543} {
+    expr {(-4)**9 == (-4)**65545}
+} 0
+test expr-23.56.0 {INST_EXPON: Bug 2798543} {
+    expr {5**9 == 5**65545}
+} 0
+test expr-23.56.1 {INST_EXPON: Bug 2798543} {
+    expr {5**13 == 5**65549}
+} 0
+test expr-23.56.2 {INST_EXPON: Bug 2798543} {
+    expr {5**9 == 5**131081}
+} 0
+test expr-23.56.3 {INST_EXPON: Bug 2798543} -body {
+    expr {5**9 == 5**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.56.4 {INST_EXPON: Bug 2798543} {
+    expr {(-5)**9 == (-5)**65545}
+} 0
+test expr-23.57.0 {INST_EXPON: Bug 2798543} {
+    expr {6**9 == 6**65545}
+} 0
+test expr-23.57.1 {INST_EXPON: Bug 2798543} {
+    expr {6**11 == 6**65547}
+} 0
+test expr-23.57.2 {INST_EXPON: Bug 2798543} {
+    expr {6**9 == 6**131081}
+} 0
+test expr-23.57.3 {INST_EXPON: Bug 2798543} -body {
+    expr {6**9 == 6**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.57.4 {INST_EXPON: Bug 2798543} {
+    expr {(-6)**9 == (-6)**65545}
+} 0
+test expr-23.58.0 {INST_EXPON: Bug 2798543} {
+    expr {7**9 == 7**65545}
+} 0
+test expr-23.58.1 {INST_EXPON: Bug 2798543} {
+    expr {7**11 == 7**65547}
+} 0
+test expr-23.58.2 {INST_EXPON: Bug 2798543} {
+    expr {7**9 == 7**131081}
+} 0
+test expr-23.58.3 {INST_EXPON: Bug 2798543} -body {
+    expr {7**9 == 7**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.58.4 {INST_EXPON: Bug 2798543} {
+    expr {(-7)**9 == (-7)**65545}
+} 0
+test expr-23.59.0 {INST_EXPON: Bug 2798543} {
+    expr {8**9 == 8**65545}
+} 0
+test expr-23.59.1 {INST_EXPON: Bug 2798543} {
+    expr {8**10 == 8**65546}
+} 0
+test expr-23.59.2 {INST_EXPON: Bug 2798543} {
+    expr {8**9 == 8**131081}
+} 0
+test expr-23.59.3 {INST_EXPON: Bug 2798543} -body {
+    expr {8**9 == 8**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.59.4 {INST_EXPON: Bug 2798543} {
+    expr {(-8)**9 == (-8)**65545}
+} 0
+test expr-23.60.0 {INST_EXPON: Bug 2798543} {
+    expr {9**9 == 9**65545}
+} 0
+test expr-23.60.1 {INST_EXPON: Bug 2798543} {
+    expr {9**9 == 9**131081}
+} 0
+test expr-23.60.2 {INST_EXPON: Bug 2798543} -body {
+    expr {9**9 == 9**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.60.3 {INST_EXPON: Bug 2798543} {
+    expr {(-9)**9 == (-9)**65545}
+} 0
+test expr-23.61.0 {INST_EXPON: Bug 2798543} {
+    expr {10**9 == 10**65545}
+} 0
+test expr-23.61.1 {INST_EXPON: Bug 2798543} {
+    expr {10**9 == 10**131081}
+} 0
+test expr-23.61.2 {INST_EXPON: Bug 2798543} -body {
+    expr {10**9 == 10**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.61.3 {INST_EXPON: Bug 2798543} {
+    expr {(-10)**9 == (-10)**65545}
+} 0
+test expr-23.62.0 {INST_EXPON: Bug 2798543} {
+    expr {11**9 == 11**65545}
+} 0
+test expr-23.62.1 {INST_EXPON: Bug 2798543} {
+    expr {11**9 == 11**131081}
+} 0
+test expr-23.62.2 {INST_EXPON: Bug 2798543} -body {
+    expr {11**9 == 11**268435465}
+} -returnCodes error -result {exponent too large}
+test expr-23.62.3 {INST_EXPON: Bug 2798543} {
+    expr {(-11)**9 == (-11)**65545}
+} 0
+test expr-23.63.0 {INST_EXPON: Bug 2798543} {
+    expr {3**20 == 3**65556}
+} 0
+test expr-23.63.1 {INST_EXPON: Bug 2798543} {
+    expr {3**39 == 3**65575}
+} 0
+test expr-23.63.2 {INST_EXPON: Bug 2798543} {
+    expr {3**20 == 3**131092}
+} 0
+test expr-23.63.3 {INST_EXPON: Bug 2798543} -body {
+    expr {3**20 == 3**268435476}
+} -returnCodes error -result {exponent too large}
+test expr-23.63.4 {INST_EXPON: Bug 2798543} {
+    expr {(-3)**20 == (-3)**65556}
+} 0
+test expr-23.64.0 {INST_EXPON: Bug 2798543} {
+    expr {4**17 == 4**65553}
+} 0
+test expr-23.64.1 {INST_EXPON: Bug 2798543} {
+    expr {4**31 == 4**65567}
+} 0
+test expr-23.64.2 {INST_EXPON: Bug 2798543} {
+    expr {4**17 == 4**131089}
+} 0
+test expr-23.64.3 {INST_EXPON: Bug 2798543} -body {
+    expr {4**17 == 4**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.64.4 {INST_EXPON: Bug 2798543} {
+    expr {(-4)**17 == (-4)**65553}
+} 0
+test expr-23.65.0 {INST_EXPON: Bug 2798543} {
+    expr {5**17 == 5**65553}
+} 0
+test expr-23.65.1 {INST_EXPON: Bug 2798543} {
+    expr {5**27 == 5**65563}
+} 0
+test expr-23.65.2 {INST_EXPON: Bug 2798543} {
+    expr {5**17 == 5**131089}
+} 0
+test expr-23.65.3 {INST_EXPON: Bug 2798543} -body {
+    expr {5**17 == 5**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.65.4 {INST_EXPON: Bug 2798543} {
+    expr {(-5)**17 == (-5)**65553}
+} 0
+test expr-23.66.0 {INST_EXPON: Bug 2798543} {
+    expr {6**17 == 6**65553}
+} 0
+test expr-23.66.1 {INST_EXPON: Bug 2798543} {
+    expr {6**24 == 6**65560}
+} 0
+test expr-23.66.2 {INST_EXPON: Bug 2798543} {
+    expr {6**17 == 6**131089}
+} 0
+test expr-23.66.3 {INST_EXPON: Bug 2798543} -body {
+    expr {6**17 == 6**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.66.4 {INST_EXPON: Bug 2798543} {
+    expr {(-6)**17 == (-6)**65553}
+} 0
+test expr-23.67.0 {INST_EXPON: Bug 2798543} {
+    expr {7**17 == 7**65553}
+} 0
+test expr-23.67.1 {INST_EXPON: Bug 2798543} {
+    expr {7**22 == 7**65558}
+} 0
+test expr-23.67.2 {INST_EXPON: Bug 2798543} {
+    expr {7**17 == 7**131089}
+} 0
+test expr-23.67.3 {INST_EXPON: Bug 2798543} -body {
+    expr {7**17 == 7**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.67.4 {INST_EXPON: Bug 2798543} {
+    expr {(-7)**17 == (-7)**65553}
+} 0
+test expr-23.68.0 {INST_EXPON: Bug 2798543} {
+    expr {8**17 == 8**65553}
+} 0
+test expr-23.68.1 {INST_EXPON: Bug 2798543} {
+    expr {8**20 == 8**65556}
+} 0
+test expr-23.68.2 {INST_EXPON: Bug 2798543} {
+    expr {8**17 == 8**131089}
+} 0
+test expr-23.68.3 {INST_EXPON: Bug 2798543} -body {
+    expr {8**17 == 8**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.68.4 {INST_EXPON: Bug 2798543} {
+    expr {(-8)**17 == (-8)**65553}
+} 0
+test expr-23.69.0 {INST_EXPON: Bug 2798543} {
+    expr {9**17 == 9**65553}
+} 0
+test expr-23.69.1 {INST_EXPON: Bug 2798543} {
+    expr {9**19 == 9**65555}
+} 0
+test expr-23.69.2 {INST_EXPON: Bug 2798543} {
+    expr {9**17 == 9**131089}
+} 0
+test expr-23.69.3 {INST_EXPON: Bug 2798543} -body {
+    expr {9**17 == 9**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.69.4 {INST_EXPON: Bug 2798543} {
+    expr {(-9)**17 == (-9)**65553}
+} 0
+test expr-23.70.0 {INST_EXPON: Bug 2798543} {
+    expr {10**17 == 10**65553}
+} 0
+test expr-23.70.1 {INST_EXPON: Bug 2798543} {
+    expr {10**18 == 10**65554}
+} 0
+test expr-23.70.2 {INST_EXPON: Bug 2798543} {
+    expr {10**17 == 10**131089}
+} 0
+test expr-23.70.3 {INST_EXPON: Bug 2798543} -body {
+    expr {10**17 == 10**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.70.4 {INST_EXPON: Bug 2798543} {
+    expr {(-10)**17 == (-10)**65553}
+} 0
+test expr-23.71.0 {INST_EXPON: Bug 2798543} {
+    expr {11**17 == 11**65553}
+} 0
+test expr-23.71.1 {INST_EXPON: Bug 2798543} {
+    expr {11**18 == 11**65554}
+} 0
+test expr-23.71.2 {INST_EXPON: Bug 2798543} {
+    expr {11**17 == 11**131089}
+} 0
+test expr-23.71.3 {INST_EXPON: Bug 2798543} -body {
+    expr {11**17 == 11**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.71.4 {INST_EXPON: Bug 2798543} {
+    expr {(-11)**17 == (-11)**65553}
+} 0
+test expr-23.72.0 {INST_EXPON: Bug 2798543} {
+    expr {12**17 == 12**65553}
+} 0
+test expr-23.72.1 {INST_EXPON: Bug 2798543} {
+    expr {12**17 == 12**131089}
+} 0
+test expr-23.72.2 {INST_EXPON: Bug 2798543} -body {
+    expr {12**17 == 12**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.72.3 {INST_EXPON: Bug 2798543} {
+    expr {(-12)**17 == (-12)**65553}
+} 0
+test expr-23.73.0 {INST_EXPON: Bug 2798543} {
+    expr {13**17 == 13**65553}
+} 0
+test expr-23.73.1 {INST_EXPON: Bug 2798543} {
+    expr {13**17 == 13**131089}
+} 0
+test expr-23.73.2 {INST_EXPON: Bug 2798543} -body {
+    expr {13**17 == 13**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.73.3 {INST_EXPON: Bug 2798543} {
+    expr {(-13)**17 == (-13)**65553}
+} 0
+test expr-23.74.0 {INST_EXPON: Bug 2798543} {
+    expr {14**17 == 14**65553}
+} 0
+test expr-23.74.1 {INST_EXPON: Bug 2798543} {
+    expr {14**17 == 14**131089}
+} 0
+test expr-23.74.2 {INST_EXPON: Bug 2798543} -body {
+    expr {14**17 == 14**268435473}
+} -returnCodes error -result {exponent too large}
+test expr-23.74.3 {INST_EXPON: Bug 2798543} {
+    expr {(-14)**17 == (-14)**65553}
+} 0
 
-
+	
 # Some compilers get this wrong; ensure that we work around it correctly
 test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
 test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
 test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
 test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
-test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5)<<32} 0
-test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5)<<63} 0
+test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
+test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
 test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
-test expr-24.8 {expr edge cases; shifting} {expr wide(10)<<63} 0
+test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
 test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0
 
+test expr-24.10 {INST_LSHIFT: Bug 1567222} {expr 500000000000000<<28} 134217728000000000000000
+
 # List membership tests
 test expr-25.1 {'in' operator} {expr {"a" in "a b c"}} 1
 test expr-25.2 {'in' operator} {expr {"a" in "b a c"}} 1
@@ -1048,7 +1462,6 @@ test expr-26.7 {'ni' operator} {expr {"" ni ""}} 1
 
 foreach op {< <= == != > >=} {
     proc test$op {a b} [list expr "\$a $op \$b"]
-
 }
 
 test expr-27.1 {expr - correct ordering - not compiled} ieeeFloatingPoint {
@@ -1076,7 +1489,6 @@ test expr-27.1 {expr - correct ordering - not compiled} ieeeFloatingPoint {
     }
     set problems
 } {}
-
 test expr-27.2 {expr - correct ordering - compiled} ieeeFloatingPoint {
     set problems {}
     # Ordering should be: -Infinity < -Normal < Subnormal < -0
@@ -1102,7 +1514,6 @@ test expr-27.2 {expr - correct ordering - compiled} ieeeFloatingPoint {
     }
     set problems
 } {}
-
 test expr-27.3 {expr - NaN is unordered - not compiled} {
     set problems {}
     set names {
@@ -1122,7 +1533,6 @@ test expr-27.3 {expr - NaN is unordered - not compiled} {
     }
     set problems
 } {}
-
 test expr-27.4 {expr - NaN is unordered - compiled} {
     set problems {}
     set names {
@@ -5329,7 +5739,6 @@ test expr-31.15 {boolean conversion} -body {
     expr bool("fred")
 } -returnCodes error -match glob -result *
 
-
 test expr-32.1 {expr mod basics} {
     set mod_nums [list \
         {-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
@@ -5408,7 +5817,20 @@ test expr-32.2 {expr div basics} {
     -3 -2 -1 -1 -1 \
     ]
 
-test expr-33.1 {parse largest long value} {longIs32bit} {
+test expr-32.3 {Bug 1585704} {
+    expr 1%(1<<63)
+} 1
+test expr-32.4 {Bug 1585704} {
+    expr -1%(1<<63)
+} [expr (1<<63)-1]
+test expr-32.5 {Bug 1585704} {
+    expr (1<<32)%(1<<63)
+} [expr 1<<32]
+test expr-32.6 {Bug 1585704} {
+    expr -(1<<32)%(1<<63)
+} [expr (1<<63)-(1<<32)]
+
+test expr-33.1 {parse largest long value} longIs32bit {
     set max_long_str 2147483647
     set max_long_hex "0x7FFFFFFF "
 
@@ -5422,11 +5844,10 @@ test expr-33.1 {parse largest long value} {longIs32bit} {
         [expr {$max_long + 0}] \
         [expr {2147483647 + 0}] \
         [expr {$max_long == $max_long_hex}] \
-        [expr {(2147483647 + 1) < 0}] \
+        [expr {int(2147483647 + 1) < 0}] \
 
 } {2147483647 2147483647 2147483647 2147483647 1 1}
-
-test expr-33.2 {parse smallest long value} {longIs32bit} {
+test expr-33.2 {parse smallest long value} longIs32bit {
     set min_long_str -2147483648
     set min_long_hex "-0x80000000 "
 
@@ -5443,11 +5864,10 @@ test expr-33.2 {parse smallest long value} {longIs32bit} {
         [expr {$min_long + 0}] \
         [expr {-2147483648 + 0}] \
         [expr {$min_long == $min_long_hex}] \
-        [expr {(-2147483648 - 1) == 0x7FFFFFFF}] \
+        [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \
 
 } {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
-
-test expr-33.3 {parse largest wide value} {wideIs64bit} {
+test expr-33.3 {parse largest wide value} wideIs64bit {
     set max_wide_str 9223372036854775807
     set max_wide_hex "0x7FFFFFFFFFFFFFFF "
 
@@ -5461,11 +5881,10 @@ test expr-33.3 {parse largest wide value} {wideIs64bit} {
         [expr {$max_wide + 0}] \
         [expr {9223372036854775807 + 0}] \
         [expr {$max_wide == $max_wide_hex}] \
-        [expr {(9223372036854775807 + 1) < 0}] \
+        [expr {wide(9223372036854775807 + 1) < 0}] \
 
 } {9223372036854775807 9223372036854775807 9223372036854775807 9223372036854775807 1 1}
-
-test expr-33.4 {parse smallest wide value} {wideIs64bit} {
+test expr-33.4 {parse smallest wide value} wideIs64bit {
     set min_wide_str -9223372036854775808
     set min_wide_hex "-0x8000000000000000 "
 
@@ -5482,450 +5901,351 @@ test expr-33.4 {parse smallest wide value} {wideIs64bit} {
         [expr {$min_wide + 0}] \
         [expr {-9223372036854775808 + 0}] \
         [expr {$min_wide == $min_wide_hex}] \
-        [expr {(-9223372036854775808 - 1) == 0x7FFFFFFFFFFFFFFF}] \
+        [expr {wide(-9223372036854775808 - 1) == 0x7FFFFFFFFFFFFFFF}] \
 
 } {-9223372036854775808 -9223372036854775808 -9223372036854775808 -9223372036854775808 1 1}
 
-
 set min -2147483648
 set max 2147483647
 
-test expr-34.1 {expr edge cases} {longIs32bit} {
+test expr-34.1 {expr edge cases} {
     expr {$min / $min}
 } {1}
-
-test expr-34.2 {expr edge cases} {longIs32bit} {
+test expr-34.2 {expr edge cases} {
     expr {$min % $min}
 } {0}
-
-test expr-34.3 {expr edge cases} {longIs32bit} {
+test expr-34.3 {expr edge cases} {
     expr {$min / ($min + 1)}
 } {1}
-
-test expr-34.4 {expr edge cases} {longIs32bit} {
+test expr-34.4 {expr edge cases} {
     expr {$min % ($min + 1)}
 } {-1}
-
-test expr-34.5 {expr edge cases} {longIs32bit} {
+test expr-34.5 {expr edge cases} {
     expr {$min / ($min + 2)}
 } {1}
-
-test expr-34.6 {expr edge cases} {longIs32bit} {
+test expr-34.6 {expr edge cases} {
     expr {$min % ($min + 2)}
 } {-2}
-
-test expr-34.7 {expr edge cases} {longIs32bit} {
+test expr-34.7 {expr edge cases} {
     expr {$min / ($min + 3)}
 } {1}
-
-test expr-34.8 {expr edge cases} {longIs32bit} {
+test expr-34.8 {expr edge cases} {
     expr {$min % ($min + 3)}
 } {-3}
-
-test expr-34.9 {expr edge cases} {longIs32bit} {
+test expr-34.9 {expr edge cases} {
     expr {$min / -3}
 } {715827882}
-
-test expr-34.10 {expr edge cases} {longIs32bit} {
+test expr-34.10 {expr edge cases} {
     expr {$min % -3}
 } {-2}
-
-test expr-34.11 {expr edge cases} {longIs32bit} {
+test expr-34.11 {expr edge cases} {
     expr {$min / -2}
 } {1073741824}
-
-test expr-34.12 {expr edge cases} {longIs32bit} {
+test expr-34.12 {expr edge cases} {
     expr {$min % -2}
 } {0}
-
-test expr-34.13 {expr edge cases} {longIs32bit} {
-    expr {$min / -1}
+test expr-34.13 {expr edge cases} longIs32bit {
+    expr {int($min / -1)}
 } {-2147483648}
-
-test expr-34.14 {expr edge cases} {longIs32bit} {
+test expr-34.14 {expr edge cases} {
     expr {$min % -1}
 } {0}
-
-test expr-34.15 {expr edge cases} {longIs32bit} {
-    expr {$min * -1}
+test expr-34.15 {expr edge cases} longIs32bit {
+    expr {int($min * -1)}
 } $min
-
-test expr-34.16 {expr edge cases} {longIs32bit} {
-    expr {-$min}
+test expr-34.16 {expr edge cases} longIs32bit {
+    expr {int(-$min)}
 } $min
-
-test expr-34.17 {expr edge cases} {longIs32bit} {
+test expr-34.17 {expr edge cases} {
     expr {$min / 1}
 } $min
-
-test expr-34.18 {expr edge cases} {longIs32bit} {
+test expr-34.18 {expr edge cases} {
     expr {$min % 1}
 } {0}
-
-test expr-34.19 {expr edge cases} {longIs32bit} {
+test expr-34.19 {expr edge cases} {
     expr {$min / 2}
 } {-1073741824}
-
-test expr-34.20 {expr edge cases} {longIs32bit} {
+test expr-34.20 {expr edge cases} {
     expr {$min % 2}
 } {0}
-
-test expr-34.21 {expr edge cases} {longIs32bit} {
+test expr-34.21 {expr edge cases} {
     expr {$min / 3}
 } {-715827883}
-
-test expr-34.22 {expr edge cases} {longIs32bit} {
+test expr-34.22 {expr edge cases} {
     expr {$min % 3}
 } {1}
-
-test expr-34.23 {expr edge cases} {longIs32bit} {
+test expr-34.23 {expr edge cases} {
     expr {$min / ($max - 3)}
 } {-2}
-
-test expr-34.24 {expr edge cases} {longIs32bit} {
+test expr-34.24 {expr edge cases} {
     expr {$min % ($max - 3)}
 } {2147483640}
-
-test expr-34.25 {expr edge cases} {longIs32bit} {
+test expr-34.25 {expr edge cases} {
     expr {$min / ($max - 2)}
 } {-2}
-
-test expr-34.26 {expr edge cases} {longIs32bit} {
+test expr-34.26 {expr edge cases} {
     expr {$min % ($max - 2)}
 } {2147483642}
-
-test expr-34.27 {expr edge cases} {longIs32bit} {
+test expr-34.27 {expr edge cases} {
     expr {$min / ($max - 1)}
 } {-2}
-
-test expr-34.28 {expr edge cases} {longIs32bit} {
+test expr-34.28 {expr edge cases} {
     expr {$min % ($max - 1)}
 } {2147483644}
-
-test expr-34.29 {expr edge cases} {longIs32bit} {
+test expr-34.29 {expr edge cases} {
     expr {$min / $max}
 } {-2}
-
-test expr-34.30 {expr edge cases} {longIs32bit} {
+test expr-34.30 {expr edge cases} {
     expr {$min % $max}
 } {2147483646}
-
-test expr-34.31 {expr edge cases} {longIs32bit} {
+test expr-34.31 {expr edge cases} {
     expr {$max / $max}
 } {1}
-
-test expr-34.32 {expr edge cases} {longIs32bit} {
+test expr-34.32 {expr edge cases} {
     expr {$max % $max}
 } {0}
-
-test expr-34.33 {expr edge cases} {longIs32bit} {
+test expr-34.33 {expr edge cases} {
     expr {$max / ($max - 1)}
 } {1}
-
-test expr-34.34 {expr edge cases} {longIs32bit} {
+test expr-34.34 {expr edge cases} {
     expr {$max % ($max - 1)}
 } {1}
-
-test expr-34.35 {expr edge cases} {longIs32bit} {
+test expr-34.35 {expr edge cases} {
     expr {$max / ($max - 2)}
 } {1}
-
-test expr-34.36 {expr edge cases} {longIs32bit} {
+test expr-34.36 {expr edge cases} {
     expr {$max % ($max - 2)}
 } {2}
-
-test expr-34.37 {expr edge cases} {longIs32bit} {
+test expr-34.37 {expr edge cases} {
     expr {$max / ($max - 3)}
 } {1}
-
-test expr-34.38 {expr edge cases} {longIs32bit} {
+test expr-34.38 {expr edge cases} {
     expr {$max % ($max - 3)}
 } {3}
-
-test expr-34.39 {expr edge cases} {longIs32bit} {
+test expr-34.39 {expr edge cases} {
     expr {$max / 3}
 } {715827882}
-
-test expr-34.40 {expr edge cases} {longIs32bit} {
+test expr-34.40 {expr edge cases} {
     expr {$max % 3}
 } {1}
-
-test expr-34.41 {expr edge cases} {longIs32bit} {
+test expr-34.41 {expr edge cases} {
     expr {$max / 2}
 } {1073741823}
-
-test expr-34.42 {expr edge cases} {longIs32bit} {
+test expr-34.42 {expr edge cases} {
     expr {$max % 2}
 } {1}
-
-test expr-34.43 {expr edge cases} {longIs32bit} {
+test expr-34.43 {expr edge cases} {
     expr {$max / 1}
 } $max
-
-test expr-34.44 {expr edge cases} {longIs32bit} {
+test expr-34.44 {expr edge cases} {
     expr {$max % 1}
 } {0}
-
-test expr-34.45 {expr edge cases} {longIs32bit} {
+test expr-34.45 {expr edge cases} {
     expr {$max / -1}
 } "-$max"
-
-test expr-34.46 {expr edge cases} {longIs32bit} {
+test expr-34.46 {expr edge cases} {
     expr {$max % -1}
 } {0}
-
-test expr-34.47 {expr edge cases} {longIs32bit} {
+test expr-34.47 {expr edge cases} {
     expr {$max / -2}
 } {-1073741824}
-
-test expr-34.48 {expr edge cases} {longIs32bit} {
+test expr-34.48 {expr edge cases} {
     expr {$max % -2}
 } {-1}
-
-test expr-34.49 {expr edge cases} {longIs32bit} {
+test expr-34.49 {expr edge cases} {
     expr {$max / -3}
 } {-715827883}
-
-test expr-34.50 {expr edge cases} {longIs32bit} {
+test expr-34.50 {expr edge cases} {
     expr {$max % -3}
 } {-2}
-
-test expr-34.51 {expr edge cases} {longIs32bit} {
+test expr-34.51 {expr edge cases} {
     expr {$max / ($min + 3)}
 } {-2}
-
-test expr-34.52 {expr edge cases} {longIs32bit} {
+test expr-34.52 {expr edge cases} {
     expr {$max % ($min + 3)}
 } {-2147483643}
-
-test expr-34.53 {expr edge cases} {longIs32bit} {
+test expr-34.53 {expr edge cases} {
     expr {$max / ($min + 2)}
 } {-2}
-
-test expr-34.54 {expr edge cases} {longIs32bit} {
+test expr-34.54 {expr edge cases} {
     expr {$max % ($min + 2)}
 } {-2147483645}
-
-test expr-34.55 {expr edge cases} {longIs32bit} {
+test expr-34.55 {expr edge cases} {
     expr {$max / ($min + 1)}
 } {-1}
-
-test expr-34.56 {expr edge cases} {longIs32bit} {
+test expr-34.56 {expr edge cases} {
     expr {$max % ($min + 1)}
 } {0}
-
-test expr-34.57 {expr edge cases} {longIs32bit} {
+test expr-34.57 {expr edge cases} {
     expr {$max / $min}
 } {-1}
-
-test expr-34.58 {expr edge cases} {longIs32bit} {
+test expr-34.58 {expr edge cases} {
     expr {$max % $min}
 } {-1}
-
-test expr-34.59 {expr edge cases} {longIs32bit} {
+test expr-34.59 {expr edge cases} {
     expr {($min + 1) / ($max - 1)}
 } {-2}
-
-test expr-34.60 {expr edge cases} {longIs32bit} {
+test expr-34.60 {expr edge cases} {
     expr {($min + 1) % ($max - 1)}
 } {2147483645}
-
-test expr-34.61 {expr edge cases} {longIs32bit} {
+test expr-34.61 {expr edge cases} {
     expr {($max - 1) / ($min + 1)}
 } {-1}
-
-test expr-34.62 {expr edge cases} {longIs32bit} {
+test expr-34.62 {expr edge cases} {
     expr {($max - 1) % ($min + 1)}
 } {-1}
-
-test expr-34.63 {expr edge cases} {longIs32bit} {
+test expr-34.63 {expr edge cases} {
     expr {($max - 1) / $min}
 } {-1}
-
-test expr-34.64 {expr edge cases} {longIs32bit} {
+test expr-34.64 {expr edge cases} {
     expr {($max - 1) % $min}
 } {-2}
-
-test expr-34.65 {expr edge cases} {longIs32bit} {
+test expr-34.65 {expr edge cases} {
     expr {($max - 2) / $min}
 } {-1}
-
-test expr-34.66 {expr edge cases} {longIs32bit} {
+test expr-34.66 {expr edge cases} {
     expr {($max - 2) % $min}
 } {-3}
-
-test expr-34.67 {expr edge cases} {longIs32bit} {
+test expr-34.67 {expr edge cases} {
     expr {($max - 3) / $min}
 } {-1}
-
-test expr-34.68 {expr edge cases} {longIs32bit} {
+test expr-34.68 {expr edge cases} {
     expr {($max - 3) % $min}
 } {-4}
-
-test expr-34.69 {expr edge cases} {longIs32bit} {
+test expr-34.69 {expr edge cases} {
     expr {-3 / $min}
 } {0}
-
-test expr-34.70 {expr edge cases} {longIs32bit} {
+test expr-34.70 {expr edge cases} {
     expr {-3 % $min}
 } {-3}
-
-test expr-34.71 {expr edge cases} {longIs32bit} {
+test expr-34.71 {expr edge cases} {
     expr {-2 / $min}
 } {0}
-
-test expr-34.72 {expr edge cases} {longIs32bit} {
+test expr-34.72 {expr edge cases} {
     expr {-2 % $min}
 } {-2}
-
-test expr-34.73 {expr edge cases} {longIs32bit} {
+test expr-34.73 {expr edge cases} {
     expr {-1 / $min}
 } {0}
-
-test expr-34.74 {expr edge cases} {longIs32bit} {
+test expr-34.74 {expr edge cases} {
     expr {-1 % $min}
 } {-1}
-
-test expr-34.75 {expr edge cases} {longIs32bit} {
+test expr-34.75 {expr edge cases} {
     expr {0 / $min}
 } {0}
-
-test expr-34.76 {expr edge cases} {longIs32bit} {
+test expr-34.76 {expr edge cases} {
     expr {0 % $min}
 } {0}
-
-test expr-34.77 {expr edge cases} {longIs32bit} {
+test expr-34.77 {expr edge cases} {
     expr {0 / ($min + 1)}
 } {0}
-
-test expr-34.78 {expr edge cases} {longIs32bit} {
+test expr-34.78 {expr edge cases} {
     expr {0 % ($min + 1)}
 } {0}
-
-test expr-34.79 {expr edge cases} {longIs32bit} {
+test expr-34.79 {expr edge cases} {
     expr {1 / $min}
 } {-1}
-
-test expr-34.80 {expr edge cases} {longIs32bit} {
+test expr-34.80 {expr edge cases} {
     expr {1 % $min}
 } {-2147483647}
-
-test expr-34.81 {expr edge cases} {longIs32bit} {
+test expr-34.81 {expr edge cases} {
     expr {1 / ($min + 1)}
 } {-1}
-
-test expr-34.82 {expr edge cases} {longIs32bit} {
+test expr-34.82 {expr edge cases} {
     expr {1 % ($min + 1)}
 } {-2147483646}
-
-test expr-34.83 {expr edge cases} {longIs32bit} {
+test expr-34.83 {expr edge cases} {
     expr {2 / $min}
 } {-1}
-
-test expr-34.84 {expr edge cases} {longIs32bit} {
+test expr-34.84 {expr edge cases} {
     expr {2 % $min}
 } {-2147483646}
-
-test expr-34.85 {expr edge cases} {longIs32bit} {
+test expr-34.85 {expr edge cases} {
     expr {2 / ($min + 1)}
 } {-1}
-
-test expr-34.86 {expr edge cases} {longIs32bit} {
+test expr-34.86 {expr edge cases} {
     expr {2 % ($min + 1)}
 } {-2147483645}
-
-test expr-34.87 {expr edge cases} {longIs32bit} {
+test expr-34.87 {expr edge cases} {
     expr {3 / $min}
 } {-1}
-
-test expr-34.88 {expr edge cases} {longIs32bit} {
+test expr-34.88 {expr edge cases} {
     expr {3 % $min}
 } {-2147483645}
-
-test expr-34.89 {expr edge cases} {longIs32bit} {
+test expr-34.89 {expr edge cases} {
     expr {3 / ($min + 1)}
 } {-1}
-
-test expr-34.90 {expr edge cases} {longIs32bit} {
+test expr-34.90 {expr edge cases} {
     expr {3 % ($min + 1)}
 } {-2147483644}
 
 # Euclidean property:
 # quotient * divisor + remainder = dividend
 
-test expr-35.1 {expr edge cases} {longIs32bit} {
+test expr-35.1 {expr edge cases} {
     set dividend $max
     set divisor 2
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($divisor * $q) + $r}]
 } {1073741823 * 2 + 1 = 2147483647}
-
-test expr-35.2 {expr edge cases} {longIs32bit} {
+test expr-35.2 {expr edge cases} {
     set dividend [expr {$max - 1}]
     set divisor 2
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {1073741823 * 2 + 0 = 2147483646}
-
-test expr-35.3 {expr edge cases} {longIs32bit} {
+test expr-35.3 {expr edge cases} {
     set dividend [expr {$max - 2}]
     set divisor 2
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {1073741822 * 2 + 1 = 2147483645}
-
-test expr-35.4 {expr edge cases} {longIs32bit} {
+test expr-35.4 {expr edge cases} {
     set dividend $max
     set divisor 3
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {715827882 * 3 + 1 = 2147483647}
-
-test expr-35.5 {expr edge cases} {longIs32bit} {
+test expr-35.5 {expr edge cases} {
     set dividend [expr {$max - 1}]
     set divisor 3
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {715827882 * 3 + 0 = 2147483646}
-
-test expr-35.6 {expr edge cases} {longIs32bit} {
+test expr-35.6 {expr edge cases} {
     set dividend [expr {$max - 2}]
     set divisor 3
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {715827881 * 3 + 2 = 2147483645}
-
-test expr-35.7 {expr edge cases} {longIs32bit} {
+test expr-35.7 {expr edge cases} {
     set dividend $min
     set divisor 2
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {-1073741824 * 2 + 0 = -2147483648}
-
-test expr-35.8 {expr edge cases} {longIs32bit} {
+test expr-35.8 {expr edge cases} {
     set dividend [expr {$min + 1}]
     set divisor 2
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {-1073741824 * 2 + 1 = -2147483647}
-
-test expr-35.9 {expr edge cases} {longIs32bit} {
+test expr-35.9 {expr edge cases} {
     set dividend [expr {$min + 2}]
     set divisor 2
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {-1073741823 * 2 + 0 = -2147483646}
-
-test expr-35.10 {expr edge cases} {longIs32bit} {
+test expr-35.10 {expr edge cases} {
     # Two things could happen here. The multiplication
     # could overflow a 32 bit type, so that when
     # 1 is added it overflows again back to min.
@@ -5938,32 +6258,28 @@ test expr-35.10 {expr edge cases} {longIs32bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {-715827883 * 3 + 1 = -2147483648}
-
-test expr-35.11 {expr edge cases} {longIs32bit} {
+test expr-35.11 {expr edge cases} {
     set dividend $min
     set divisor -3
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {715827882 * -3 + -2 = -2147483648}
-
-test expr-35.12 {expr edge cases} {longIs32bit} {
+test expr-35.12 {expr edge cases} {
     set dividend $min
     set divisor $min
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {1 * -2147483648 + 0 = -2147483648}
-
-test expr-35.13 {expr edge cases} {longIs32bit} {
+test expr-35.13 {expr edge cases} {
     set dividend $min
     set divisor [expr {$min + 1}]
     set q [expr {$dividend / $divisor}]
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {1 * -2147483647 + -1 = -2147483648}
-
-test expr-35.14 {expr edge cases} {longIs32bit} {
+test expr-35.14 {expr edge cases} {
     set dividend $min
     set divisor [expr {$min + 2}]
     set q [expr {$dividend / $divisor}]
@@ -5979,364 +6295,274 @@ set max 9223372036854775807
 test expr-36.1 {expr edge cases} {wideIs64bit} {
     expr {$min / $min}
 } {1}
-
 test expr-36.2 {expr edge cases} {wideIs64bit} {
     expr {$min % $min}
 } {0}
-
 test expr-36.3 {expr edge cases} {wideIs64bit} {
     expr {$min / ($min + 1)}
 } {1}
-
 test expr-36.4 {expr edge cases} {wideIs64bit} {
     expr {$min % ($min + 1)}
 } {-1}
-
 test expr-36.5 {expr edge cases} {wideIs64bit} {
     expr {$min / ($min + 2)}
 } {1}
-
 test expr-36.6 {expr edge cases} {wideIs64bit} {
     expr {$min % ($min + 2)}
 } {-2}
-
 test expr-36.7 {expr edge cases} {wideIs64bit} {
     expr {$min / ($min + 3)}
 } {1}
-
 test expr-36.8 {expr edge cases} {wideIs64bit} {
     expr {$min % ($min + 3)}
 } {-3}
-
 test expr-36.9 {expr edge cases} {wideIs64bit} {
     expr {$min / -3}
 } {3074457345618258602}
-
 test expr-36.10 {expr edge cases} {wideIs64bit} {
     expr {$min % -3}
 } {-2}
-
 test expr-36.11 {expr edge cases} {wideIs64bit} {
     expr {$min / -2}
 } {4611686018427387904}
-
 test expr-36.12 {expr edge cases} {wideIs64bit} {
     expr {$min % -2}
 } {0}
-
-test expr-36.13 {expr edge cases} {wideIs64bit} {
-    expr {$min / -1}
+test expr-36.13 {expr edge cases} wideIs64bit {
+    expr {wide($min / -1)}
 } $min
-
 test expr-36.14 {expr edge cases} {wideIs64bit} {
     expr {$min % -1}
 } {0}
-
-test expr-36.15 {expr edge cases} {wideIs64bit} {
-    expr {$min * -1}
+test expr-36.15 {expr edge cases} wideIs64bit {
+    expr {wide($min * -1)}
 } $min
-
-test expr-36.16 {expr edge cases} {wideIs64bit} {
-    expr {-$min}
+test expr-36.16 {expr edge cases} wideIs64bit {
+    expr {wide(-$min)}
 } $min
-
 test expr-36.17 {expr edge cases} {wideIs64bit} {
     expr {$min / 1}
 } $min
-
 test expr-36.18 {expr edge cases} {wideIs64bit} {
     expr {$min % 1}
 } {0}
-
 test expr-36.19 {expr edge cases} {wideIs64bit} {
     expr {$min / 2}
 } {-4611686018427387904}
-
 test expr-36.20 {expr edge cases} {wideIs64bit} {
     expr {$min % 2}
 } {0}
-
 test expr-36.21 {expr edge cases} {wideIs64bit} {
     expr {$min / 3}
 } {-3074457345618258603}
-
 test expr-36.22 {expr edge cases} {wideIs64bit} {
     expr {$min % 3}
 } {1}
-
 test expr-36.23 {expr edge cases} {wideIs64bit} {
     expr {$min / ($max - 3)}
 } {-2}
-
 test expr-36.24 {expr edge cases} {wideIs64bit} {
     expr {$min % ($max - 3)}
 } {9223372036854775800}
-
 test expr-36.25 {expr edge cases} {wideIs64bit} {
     expr {$min / ($max - 2)}
 } {-2}
-
 test expr-36.26 {expr edge cases} {wideIs64bit} {
     expr {$min % ($max - 2)}
 } {9223372036854775802}
-
 test expr-36.27 {expr edge cases} {wideIs64bit} {
     expr {$min / ($max - 1)}
 } {-2}
-
 test expr-36.28 {expr edge cases} {wideIs64bit} {
     expr {$min % ($max - 1)}
 } {9223372036854775804}
-
 test expr-36.29 {expr edge cases} {wideIs64bit} {
     expr {$min / $max}
 } {-2}
-
 test expr-36.30 {expr edge cases} {wideIs64bit} {
     expr {$min % $max}
 } {9223372036854775806}
-
 test expr-36.31 {expr edge cases} {wideIs64bit} {
     expr {$max / $max}
 } {1}
-
 test expr-36.32 {expr edge cases} {wideIs64bit} {
     expr {$max % $max}
 } {0}
-
 test expr-36.33 {expr edge cases} {wideIs64bit} {
     expr {$max / ($max - 1)}
 } {1}
-
 test expr-36.34 {expr edge cases} {wideIs64bit} {
     expr {$max % ($max - 1)}
 } {1}
-
 test expr-36.35 {expr edge cases} {wideIs64bit} {
     expr {$max / ($max - 2)}
 } {1}
-
 test expr-36.36 {expr edge cases} {wideIs64bit} {
     expr {$max % ($max - 2)}
 } {2}
-
 test expr-36.37 {expr edge cases} {wideIs64bit} {
     expr {$max / ($max - 3)}
 } {1}
-
 test expr-36.38 {expr edge cases} {wideIs64bit} {
     expr {$max % ($max - 3)}
 } {3}
-
 test expr-36.39 {expr edge cases} {wideIs64bit} {
     expr {$max / 3}
 } {3074457345618258602}
-
 test expr-36.40 {expr edge cases} {wideIs64bit} {
     expr {$max % 3}
 } {1}
-
 test expr-36.41 {expr edge cases} {wideIs64bit} {
     expr {$max / 2}
 } {4611686018427387903}
-
 test expr-36.42 {expr edge cases} {wideIs64bit} {
     expr {$max % 2}
 } {1}
-
 test expr-36.43 {expr edge cases} {wideIs64bit} {
     expr {$max / 1}
 } $max
-
 test expr-36.44 {expr edge cases} {wideIs64bit} {
     expr {$max % 1}
 } {0}
-
 test expr-36.45 {expr edge cases} {wideIs64bit} {
     expr {$max / -1}
 } "-$max"
-
 test expr-36.46 {expr edge cases} {wideIs64bit} {
     expr {$max % -1}
 } {0}
-
 test expr-36.47 {expr edge cases} {wideIs64bit} {
     expr {$max / -2}
 } {-4611686018427387904}
-
 test expr-36.48 {expr edge cases} {wideIs64bit} {
     expr {$max % -2}
 } {-1}
-
 test expr-36.49 {expr edge cases} {wideIs64bit} {
     expr {$max / -3}
 } {-3074457345618258603}
-
 test expr-36.50 {expr edge cases} {wideIs64bit} {
     expr {$max % -3}
 } {-2}
-
 test expr-36.51 {expr edge cases} {wideIs64bit} {
     expr {$max / ($min + 3)}
 } {-2}
-
 test expr-36.52 {expr edge cases} {wideIs64bit} {
     expr {$max % ($min + 3)}
 } {-9223372036854775803}
-
 test expr-36.53 {expr edge cases} {wideIs64bit} {
     expr {$max / ($min + 2)}
 } {-2}
-
 test expr-36.54 {expr edge cases} {wideIs64bit} {
     expr {$max % ($min + 2)}
 } {-9223372036854775805}
-
 test expr-36.55 {expr edge cases} {wideIs64bit} {
     expr {$max / ($min + 1)}
 } {-1}
-
 test expr-36.56 {expr edge cases} {wideIs64bit} {
     expr {$max % ($min + 1)}
 } {0}
-
 test expr-36.57 {expr edge cases} {wideIs64bit} {
     expr {$max / $min}
 } {-1}
-
 test expr-36.58 {expr edge cases} {wideIs64bit} {
     expr {$max % $min}
 } {-1}
-
 test expr-36.59 {expr edge cases} {wideIs64bit} {
     expr {($min + 1) / ($max - 1)}
 } {-2}
-
 test expr-36.60 {expr edge cases} {wideIs64bit} {
     expr {($min + 1) % ($max - 1)}
 } {9223372036854775805}
-
 test expr-36.61 {expr edge cases} {wideIs64bit} {
     expr {($max - 1) / ($min + 1)}
 } {-1}
-
 test expr-36.62 {expr edge cases} {wideIs64bit} {
     expr {($max - 1) % ($min + 1)}
 } {-1}
-
 test expr-36.63 {expr edge cases} {wideIs64bit} {
     expr {($max - 1) / $min}
 } {-1}
-
 test expr-36.64 {expr edge cases} {wideIs64bit} {
     expr {($max - 1) % $min}
 } {-2}
-
 test expr-36.65 {expr edge cases} {wideIs64bit} {
     expr {($max - 2) / $min}
 } {-1}
-
 test expr-36.66 {expr edge cases} {wideIs64bit} {
     expr {($max - 2) % $min}
 } {-3}
-
 test expr-36.67 {expr edge cases} {wideIs64bit} {
     expr {($max - 3) / $min}
 } {-1}
-
 test expr-36.68 {expr edge cases} {wideIs64bit} {
     expr {($max - 3) % $min}
 } {-4}
-
 test expr-36.69 {expr edge cases} {wideIs64bit} {
     expr {-3 / $min}
 } {0}
-
 test expr-36.70 {expr edge cases} {wideIs64bit} {
     expr {-3 % $min}
 } {-3}
-
 test expr-36.71 {expr edge cases} {wideIs64bit} {
     expr {-2 / $min}
 } {0}
-
 test expr-36.72 {expr edge cases} {wideIs64bit} {
     expr {-2 % $min}
 } {-2}
-
 test expr-36.73 {expr edge cases} {wideIs64bit} {
     expr {-1 / $min}
 } {0}
-
 test expr-36.74 {expr edge cases} {wideIs64bit} {
     expr {-1 % $min}
 } {-1}
-
 test expr-36.75 {expr edge cases} {wideIs64bit} {
     expr {0 / $min}
 } {0}
-
 test expr-36.76 {expr edge cases} {wideIs64bit} {
     expr {0 % $min}
 } {0}
-
 test expr-36.77 {expr edge cases} {wideIs64bit} {
     expr {0 / ($min + 1)}
 } {0}
-
 test expr-36.78 {expr edge cases} {wideIs64bit} {
     expr {0 % ($min + 1)}
 } {0}
-
 test expr-36.79 {expr edge cases} {wideIs64bit} {
     expr {1 / $min}
 } {-1}
-
 test expr-36.80 {expr edge cases} {wideIs64bit} {
     expr {1 % $min}
 } {-9223372036854775807}
-
 test expr-36.81 {expr edge cases} {wideIs64bit} {
     expr {1 / ($min + 1)}
 } {-1}
-
 test expr-36.82 {expr edge cases} {wideIs64bit} {
     expr {1 % ($min + 1)}
 } {-9223372036854775806}
-
 test expr-36.83 {expr edge cases} {wideIs64bit} {
     expr {2 / $min}
 } {-1}
-
 test expr-36.84 {expr edge cases} {wideIs64bit} {
     expr {2 % $min}
 } {-9223372036854775806}
-
 test expr-36.85 {expr edge cases} {wideIs64bit} {
     expr {2 / ($min + 1)}
 } {-1}
-
 test expr-36.86 {expr edge cases} {wideIs64bit} {
     expr {2 % ($min + 1)}
 } {-9223372036854775805}
-
 test expr-36.87 {expr edge cases} {wideIs64bit} {
     expr {3 / $min}
 } {-1}
-
 test expr-36.88 {expr edge cases} {wideIs64bit} {
     expr {3 % $min}
 } {-9223372036854775805}
-
 test expr-36.89 {expr edge cases} {wideIs64bit} {
     expr {3 / ($min + 1)}
 } {-1}
-
 test expr-36.90 {expr edge cases} {wideIs64bit} {
     expr {3 % ($min + 1)}
 } {-9223372036854775804}
 
-
 test expr-37.1 {expr edge cases} {wideIs64bit} {
     set dividend $max
     set divisor 2
@@ -6344,7 +6570,6 @@ test expr-37.1 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($divisor * $q) + $r}]
 } {4611686018427387903 * 2 + 1 = 9223372036854775807}
-
 test expr-37.2 {expr edge cases} {wideIs64bit} {
     set dividend [expr {$max - 1}]
     set divisor 2
@@ -6352,7 +6577,6 @@ test expr-37.2 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {4611686018427387903 * 2 + 0 = 9223372036854775806}
-
 test expr-37.3 {expr edge cases} {wideIs64bit} {
     set dividend [expr {$max - 2}]
     set divisor 2
@@ -6360,7 +6584,6 @@ test expr-37.3 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {4611686018427387902 * 2 + 1 = 9223372036854775805}
-
 test expr-37.4 {expr edge cases} {wideIs64bit} {
     set dividend $max
     set divisor 3
@@ -6368,7 +6591,6 @@ test expr-37.4 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {3074457345618258602 * 3 + 1 = 9223372036854775807}
-
 test expr-37.5 {expr edge cases} {wideIs64bit} {
     set dividend [expr {$max - 1}]
     set divisor 3
@@ -6376,7 +6598,6 @@ test expr-37.5 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {3074457345618258602 * 3 + 0 = 9223372036854775806}
-
 test expr-37.6 {expr edge cases} {wideIs64bit} {
     set dividend [expr {$max - 2}]
     set divisor 3
@@ -6384,7 +6605,6 @@ test expr-37.6 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {3074457345618258601 * 3 + 2 = 9223372036854775805}
-
 test expr-37.7 {expr edge cases} {wideIs64bit} {
     set dividend $min
     set divisor 2
@@ -6392,7 +6612,6 @@ test expr-37.7 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {-4611686018427387904 * 2 + 0 = -9223372036854775808}
-
 test expr-37.8 {expr edge cases} {wideIs64bit} {
     set dividend [expr {$min + 1}]
     set divisor 2
@@ -6400,7 +6619,6 @@ test expr-37.8 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {-4611686018427387904 * 2 + 1 = -9223372036854775807}
-
 test expr-37.9 {expr edge cases} {wideIs64bit} {
     set dividend [expr {$min + 2}]
     set divisor 2
@@ -6408,7 +6626,6 @@ test expr-37.9 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {-4611686018427387903 * 2 + 0 = -9223372036854775806}
-
 test expr-37.10 {expr edge cases} {wideIs64bit} {
     # Multiplication overflows 64 bit type here,
     # so when the 1 is added it overflows
@@ -6419,7 +6636,6 @@ test expr-37.10 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {-3074457345618258603 * 3 + 1 = -9223372036854775808}
-
 test expr-37.11 {expr edge cases} {wideIs64bit} {
     set dividend $min
     set divisor -3
@@ -6427,7 +6643,6 @@ test expr-37.11 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {3074457345618258602 * -3 + -2 = -9223372036854775808}
-
 test expr-37.12 {expr edge cases} {wideIs64bit} {
     set dividend $min
     set divisor $min
@@ -6435,7 +6650,6 @@ test expr-37.12 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {1 * -9223372036854775808 + 0 = -9223372036854775808}
-
 test expr-37.13 {expr edge cases} {wideIs64bit} {
     set dividend $min
     set divisor [expr {$min + 1}]
@@ -6443,7 +6657,6 @@ test expr-37.13 {expr edge cases} {wideIs64bit} {
     set r [expr {$dividend % $divisor}]
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {1 * -9223372036854775807 + -1 = -9223372036854775808}
-
 test expr-37.14 {expr edge cases} {wideIs64bit} {
     set dividend $min
     set divisor [expr {$min + 2}]
@@ -6452,6 +6665,516 @@ test expr-37.14 {expr edge cases} {wideIs64bit} {
     list $q * $divisor + $r = [expr {($q * $divisor) + $r}]
 } {1 * -9223372036854775806 + -2 = -9223372036854775808}
 
+test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} {
+    expr {abs(-2147483648)}
+} 2147483648
+test expr-38.2 {abs and -0 [Bug 1893815]} {
+    expr {abs(-0)}
+} 0
+test expr-38.3 {abs and -0 [Bug 1893815]} {
+    expr {abs(-0.0)}
+} 0.0
+test expr-38.4 {abs and -0 [Bug 1893815]} {
+    expr {abs(-1e-324)}
+} 0.0
+test expr-38.5 {abs and -0 [Bug 1893815]} {
+    ::tcl::mathfunc::abs -0
+} 0
+test expr-38.6 {abs and -0 [Bug 1893815]} {
+    ::tcl::mathfunc::abs -0.0
+} 0.0
+test expr-38.7 {abs and -0 [Bug 1893815]} {
+    ::tcl::mathfunc::abs -1e-324
+} 0.0
+test expr-38.8 {abs and 0.0 [Bug 2954959]} {
+    ::tcl::mathfunc::abs 0.0
+} 0.0
+test expr-38.9 {abs and 0.0 [Bug 2954959]} {
+    expr {abs(0.0)}
+} 0.0
+test expr-38.10 {abs and -0x0 [Bug 2954959]} {
+    expr {abs(-0x0)}
+} 0
+test expr-38.11 {abs and 0x0 [Bug 2954959]} {
+    ::tcl::mathfunc::abs { 	0x0}
+} { 	0x0}
+test expr-38.12 {abs and -0x0 [Bug 2954959]} {
+    ::tcl::mathfunc::abs { 	-0x0}
+} 0
+test expr-38.13 {abs and 0.0 [Bug 2954959]} {
+    ::tcl::mathfunc::abs 1e-324
+} 1e-324
+
+testConstraint testexprlongobj   [llength [info commands testexprlongobj]]
+testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]]
+
+test expr-39.1 {Check that Tcl_ExprLongObj doesn't modify interpreter result if no error} testexprlongobj {
+    testexprlongobj 4+1
+} {This is a result: 5}
+#Check for [Bug 1109484]
+test expr-39.2 {Tcl_ExprLongObj handles wide ints gracefully} testexprlongobj {
+    testexprlongobj wide(1)+2
+} {This is a result: 3}
+
+test expr-39.3 {Tcl_ExprLongObj on the empty string} \
+    -constraints {testexprlongobj}\
+    -body {testexprlongobj ""} \
+    -match glob \
+    -returnCodes error -result *
+test expr-39.4 {Tcl_ExprLongObj coerces doubles} testexprlongobj {
+    testexprlongobj 3+.14159
+} {This is a result: 3}
+test expr-39.5 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+    testexprlongobj 0x80000000
+} {This is a result: -2147483648}
+test expr-39.6 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+    testexprlongobj 0xffffffff
+} {This is a result: -1}
+test expr-39.7 {Tcl_ExprLongObj handles overflows} \
+    -constraints {testexprlongobj longIs32bit} \
+    -match glob \
+    -body {
+	list [catch {testexprlongobj 0x100000000} result] $result
+    } \
+    -result {1 {integer value too large to represent*}}
+test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
+    testexprlongobj -0x80000000
+} {This is a result: -2147483648}
+test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+    testexprlongobj -0xffffffff
+} {This is a result: 1}
+test expr-39.10 {Tcl_ExprLongObj handles overflows} \
+    -constraints {testexprlongobj longIs32bit} \
+    -match glob \
+    -body {
+	list [catch {testexprlongobj -0x100000000} result] $result
+    } \
+    -result {1 {integer value too large to represent*}}
+test expr-39.11 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+    testexprlongobj 2147483648.
+} {This is a result: -2147483648}
+test expr-39.12 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+    testexprlongobj 4294967295.
+} {This is a result: -1}
+test expr-39.13 {Tcl_ExprLongObj handles overflows} \
+    -constraints {testexprlongobj longIs32bit} \
+    -match glob \
+    -body {
+	list [catch {testexprlongobj 4294967296.} result] $result
+    } \
+    -result {1 {integer value too large to represent*}}
+test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
+    testexprlongobj -2147483648.
+} {This is a result: -2147483648}
+test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
+    testexprlongobj -4294967295.
+} {This is a result: 1}
+test expr-39.16 {Tcl_ExprLongObj handles overflows} \
+    -constraints {testexprlongobj longIs32bit} \
+    -match glob \
+    -body {
+	list [catch {testexprlongobj 4294967296.} result] $result
+    } \
+    -result {1 {integer value too large to represent*}}
+    
+test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj {
+    testexprdoubleobj 4.+1.
+} {This is a result: 5.0}
+#Check for [Bug 1109484]
+test expr-39.18 {Tcl_ExprDoubleObj on the empty string} \
+    -constraints {testexprdoubleobj} \
+    -match glob \
+    -body {testexprdoubleobj ""} \
+    -returnCodes error -result *
+test expr-39.19 {Tcl_ExprDoubleObj coerces wides} testexprdoubleobj {
+    testexprdoubleobj 1[string repeat 0 17]
+} {This is a result: 1e+17}
+test expr-39.20 {Tcl_ExprDoubleObj coerces bignums} testexprdoubleobj {
+    testexprdoubleobj 1[string repeat 0 38]
+} {This is a result: 1e+38}
+test expr-39.21 {Tcl_ExprDoubleObj handles overflows} \
+    testexprdoubleobj&&ieeeFloatingPoint {
+	testexprdoubleobj 17976931348623157[string repeat 0 292].
+    } {This is a result: 1.7976931348623157e+308}
+test expr-39.22 {Tcl_ExprDoubleObj handles overflows that look like int} \
+    testexprdoubleobj&&ieeeFloatingPoint {
+	testexprdoubleobj 17976931348623157[string repeat 0 292]
+    } {This is a result: 1.7976931348623157e+308}
+test expr-39.23 {Tcl_ExprDoubleObj handles overflows} \
+    testexprdoubleobj&&ieeeFloatingPoint {
+	testexprdoubleobj 17976931348623165[string repeat 0 292].
+    } {This is a result: Inf}
+test expr-39.24 {Tcl_ExprDoubleObj handles overflows that look like int} \
+    testexprdoubleobj&&ieeeFloatingPoint {
+	testexprdoubleobj 17976931348623165[string repeat 0 292]
+    } {This is a result: Inf}
+test expr-39.25 {Tcl_ExprDoubleObj and NaN} \
+    {testexprdoubleobj ieeeFloatingPoint} {
+	list [catch {testexprdoubleobj 0.0/0.0} result] $result
+    } {1 {domain error: argument not in valid range}}
+
+test expr-40.1 {large octal shift} {
+    expr 0o100000000000000000000000000000000
+} [expr 0x1000000000000000000000000]
+test expr-40.2 {large octal shift} {
+    expr 0o100000000000000000000000000000001
+} [expr 0x1000000000000000000000001]
+
+test expr-41.1 {exponent overflow} {
+    expr 1.0e2147483630
+} Inf
+test expr-41.2 {exponent underflow} {
+    expr 1.0e-2147483630
+} 0.0
+
+test expr-42.1 {denormals} ieeeFloatingPoint {
+    expr 7e-324
+} 5e-324
+
+# TIP 114
+
+test expr-43.1 {0b notation} {
+    expr 0b0
+} 0
+test expr-43.2 {0b notation} {
+    expr 0b1
+} 1
+test expr-43.3 {0b notation} {
+    expr 0b10
+} 2
+test expr-43.4 {0b notation} {
+    expr 0b11
+} 3
+test expr-43.5 {0b notation} {
+    expr 0b100
+} 4
+test expr-43.6 {0b notation} {
+    expr 0b101
+} 5
+test expr-43.7 {0b notation} {
+    expr 0b1000
+} 8
+test expr-43.8 {0b notation} {
+    expr 0b1001
+} 9
+test expr-43.9 {0b notation} {
+    expr 0b1[string repeat 0 31]
+} 2147483648
+test expr-43.10 {0b notation} {
+    expr 0b1[string repeat 0 30]1
+} 2147483649
+test expr-43.11 {0b notation} {
+    expr 0b[string repeat 1 64]
+} 18446744073709551615
+test expr-43.12 {0b notation} {
+    expr 0b1[string repeat 0 64]
+} 18446744073709551616
+test expr-43.13 {0b notation} {
+    expr 0b1[string repeat 0 63]1
+} 18446744073709551617
+
+test expr-44.1 {0o notation} {
+    expr 0o0
+} 0
+test expr-44.2 {0o notation} {
+    expr 0o1
+} 1
+test expr-44.3 {0o notation} {
+    expr 0o7
+} 7
+test expr-44.4 {0o notation} {
+    expr 0o10
+} 8
+test expr-44.5 {0o notation} {
+    expr 0o11
+} 9
+test expr-44.6 {0o notation} {
+    expr 0o100
+} 64
+test expr-44.7 {0o notation} {
+    expr 0o101
+} 65
+test expr-44.8 {0o notation} {
+    expr 0o1000
+} 512
+test expr-44.9 {0o notation} {
+    expr 0o1001
+} 513
+test expr-44.10 {0o notation} {
+    expr 0o1[string repeat 7 21]
+} 18446744073709551615
+test expr-44.11 {0o notation} {
+    expr 0o2[string repeat 0 21]
+} 18446744073709551616
+test expr-44.12 {0o notation} {
+    expr 0o2[string repeat 0 20]1
+} 18446744073709551617
+
+# TIP 237 again
+
+test expr-45.1 {entier} {
+    expr entier(0)
+} 0
+test expr-45.2 {entier} {
+    expr entier(0.5)
+} 0
+test expr-45.3 {entier} {
+    expr entier(1.0)
+} 1
+test expr-45.4 {entier} {
+    expr entier(1.5)
+} 1
+test expr-45.5 {entier} {
+    expr entier(2.0)
+} 2
+test expr-45.6 {entier} {
+    expr entier(1e+22)
+} 10000000000000000000000
+test expr-45.7 {entier} {
+    list [catch {expr entier(Inf)} result] $result
+} {1 {integer value too large to represent}}
+test expr-45.8 {entier} ieeeFloatingPoint {
+    list [catch {expr {entier($ieeeValues(NaN))}} result] $result
+} {1 {floating point value is Not a Number}}
+test expr-45.9 {entier} ieeeFloatingPoint {
+    list [catch {expr {entier($ieeeValues(-NaN))}} result] $result
+} {1 {floating point value is Not a Number}}
+
+test expr-46.1 {round() rounds to +-infinity} {
+    expr round(0.5)
+} 1
+test expr-46.2 {round() rounds to +-infinity} {
+    expr round(1.5)
+} 2
+test expr-46.3 {round() rounds to +-infinity} {
+    expr round(-0.5)
+} -1
+test expr-46.4 {round() rounds to +-infinity} {
+    expr round(-1.5)
+} -2
+test expr-46.5 {round() overflow} {
+    expr round(9.2233720368547758e+018)
+} 9223372036854775808
+test expr-46.6 {round() overflow} {
+    expr round(-9.2233720368547758e+018)
+} -9223372036854775808
+test expr-46.7 {round() bad value} -body {
+    set x trash
+    expr {round($x)}
+} -returnCodes error -match glob -result *
+test expr-46.8 {round() already an integer} {
+    set x 123456789012
+    incr x
+    expr round($x)
+} 123456789013
+test expr-46.9 {round() boundary case - 1/2 - 1 ulp} {
+    set x 0.25
+    set bit 0.125
+    while 1 {
+	set newx [expr {$x + $bit}]
+	if { $newx == $x || $newx == 0.5 } break
+	set x $newx
+	set bit [expr { $bit / 2.0 }]
+    }
+    expr {round($x)}
+} 0
+test expr-46.10 {round() boundary case - 1/2 + 1 ulp} {
+    set x 0.75
+    set bit 0.125
+    while 1 {
+	set newx [expr {$x - $bit}]
+	if { $newx == $x || $newx == 0.5 } break
+	set x $newx
+	set bit [expr { $bit / 2.0 }]
+    }
+    expr {round($x)}
+} 1
+test expr-46.11 {round() boundary case - -1/2 - 1 ulp} {
+    set x -0.75
+    set bit 0.125
+    while 1 {
+	set newx [expr {$x + $bit}]
+	if { $newx == $x || $newx == -0.5 } break
+	set x $newx
+	set bit [expr { $bit / 2.0 }]
+    }
+    expr {round($x)}
+} -1
+test expr-46.12 {round() boundary case - -1/2 + 1 ulp} {
+    set x -0.25
+    set bit 0.125
+    while 1 {
+	set newx [expr {$x - $bit}]
+	if { $newx == $x || $newx == -0.5 } break
+	set x $newx
+	set bit [expr { $bit / 2.0 }]
+    }
+    expr {round($x)}
+} 0
+test expr-46.13 {round() boundary case - round down} {
+    expr {round(2147483647 - 0.51)}
+} 2147483646
+
+test expr-46.14 {round() boundary case - round up} {
+    expr {round(2147483647 - 0.50)}
+} 2147483647
+
+test expr-46.15 {round() boundary case - round up to wide} {
+    expr {round(2147483647 + 0.50)}
+} [expr {wide(2147483647) + 1}]
+
+test expr-46.16 {round() boundary case - round up} {
+    expr {round(-2147483648 + 0.51)}
+} -2147483647
+
+test expr-46.17 {round() boundary case - round down} {
+    expr {round(-2147483648 + 0.50)}
+} -2147483648
+test expr-46.18 {round() boundary case - round down to wide} {
+    expr {round(-2147483648 - 0.50)}
+} [expr {wide(-2147483648) - 1}]
+
+test expr-46.19 {round() handling of long/bignum boundary} {
+    expr {round(double(0x7fffffffffffffff))}
+} 9223372036854775808
+
+test expr-47.1 {isqrt() - arg count} {
+    list [catch {expr {isqrt(1,2)}} result] $result
+} {1 {too many arguments for math function "isqrt"}}
+
+test expr-47.2 {isqrt() - non-number} {
+    list [catch {expr {isqrt({rubbish})}} result] $result
+} {1 {expected number but got "rubbish"}}
+
+test expr-47.3 {isqrt() - NaN} ieeeFloatingPoint {
+    list [catch {expr {isqrt(NaN)}} result] $result
+} {1 {floating point value is Not a Number}}
+
+test expr-47.4 {isqrt() of negative floating point number} {
+    list [catch {expr {isqrt(-1.0)}} result] $result
+} {1 {square root of negative argument}}
+
+test expr-47.5 {isqrt() of floating point zero} {
+    expr isqrt(0.0)
+} 0
+
+test expr-47.6 {isqrt() of exact floating point numbers} {
+    set trouble {}
+    for {set i 0} {$i < 16} {incr i} {
+	set root [expr {1 << $i}]
+	set rm1 [expr {$root - 1}]
+	set arg [expr {pow(2., (2 * $i))}]
+	if {isqrt($arg-1) != $rm1} {
+	    append trouble "i = " $i ": isqrt( " $arg "-1) != " $rm1 "\n"
+	}
+	if {isqrt($arg) != $root} {
+	    append trouble "i = " $i ": isqrt( " $arg ") != " $root "\n"
+	}
+	if {isqrt($arg+1) != $root} {
+	    append trouble "i = " $i ": isqrt( " $arg "+1) != " $root "\n"
+	}
+    }
+    set trouble
+} {}
+
+test expr-47.7 {isqrt() of exact floating point numbers} ieeeFloatingPoint {
+    set trouble {}
+    for {set i 17} {$i < 27} {incr i} {
+	set root [expr {1 << $i}]
+	set rm1 [expr {$root - 1}]
+	set arg [expr {pow(2., (2 * $i))}]
+	if {isqrt($arg-1.0) != $rm1} {
+	    append trouble "i = " $i ": isqrt( " $arg "-1) != " $rm1 "\n"
+	}
+	if {isqrt($arg) != $root} {
+	    append trouble "i = " $i ": isqrt( " $arg ") != " $root "\n"
+	}
+	if {isqrt($arg+1.0) != $root} {
+	    append trouble "i = " $i ": isqrt( " $arg "+1) != " $root "\n"
+	}
+    }
+    set trouble
+} {}
+
+test expr-47.8 {isqrt of inexact floating point number} ieeeFloatingPoint {
+    expr isqrt(2[string repeat 0 34])
+} 141421356237309504
+
+test expr-47.9 {isqrt of negative int} {
+    list [catch {expr isqrt(-1)} result] $result
+} {1 {square root of negative argument}}
+
+test expr-47.10 {isqrt of negative bignum} {
+    list [catch {expr isqrt(-1[string repeat 0 1000])} result] $result
+} {1 {square root of negative argument}}
+
+test expr-47.11 {isqrt of zero} {
+    expr {isqrt(0)}
+} 0
+
+test expr-47.12 {isqrt of various sizes of integer} {
+    set faults 0
+    set trouble {}
+    for {set i 0} {$faults < 10 && $i <= 1024} {incr i} {
+	set root [expr {1 << $i}]
+	set rm1 [expr {$root - 1}]
+	set arg [expr {1 << (2 * $i)}]
+	set tval [expr {isqrt($arg-1)}]
+	if {$tval != $rm1} {
+	    append trouble "i = " $i ": isqrt(" $arg "-1) == " $tval \
+		" != " $rm1 "\n"
+	    incr faults
+	}
+	set tval [expr {isqrt($arg)}]
+	if {$tval != $root} {
+	    append trouble "i = " $i ": isqrt(" $arg ") == " $tval \
+		" != " $root "\n"
+	    incr faults
+	}
+	set tval [expr {isqrt($arg+1)}]
+	if {$tval != $root} {
+	    append trouble "i = " $i ": isqrt(" $arg "+1) == " $tval \
+		" != " $root "\n"
+	    incr faults
+	}
+    }
+    set trouble
+} {}
+
+test expr-47.13 {isqrt and floating point rounding (Bug 2143288)} {
+    set trouble {}
+    set faults 0
+    for {set i 0} {$i < 29 && $faults < 10} {incr i} {
+	for {set j 0} {$j <= $i} {incr j} {
+	    set k [expr {isqrt((1<<56)+(1<<$i)+(1<<$j))}]
+	    if {$k != (1<<28)} {
+		append trouble "i = $i, j = $j, k = $k\n"
+		incr faults
+	    }
+	}
+	set k [expr {isqrt((1<<56)+(1<<29)+(1<<$i))}]
+	if {$k != (1<<28)+1} {
+	    append trouble "i = $i, k = $k\n"
+	    incr faults
+	}
+    }
+    set trouble
+} {}
+
+test expr-48.1 {Bug 1770224} {
+    expr {-0x8000000000000001 >> 0x8000000000000000}
+} -1
+
+test expr-49.1 {Bug 2823282} {
+    coroutine foo apply {{} {set expr expr; $expr {[yield]}}}
+    foo 1
+} 1
+
+test expr-50.1 {test sqrt() of bignums with non-Inf answer} {
+    expr {sqrt("1[string repeat 0 616]") == 1e308}
+} 1
+
+
 
 # cleanup
 if {[info exists a]} {
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 4ba7034..3d22b09 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -1,36 +1,104 @@
 # This file tests the tclFCmd.c file.
 #
-# 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) 1996-1997 Sun Microsystems, Inc.
 # Copyright (c) 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.
-#
-# RCS: @(#) $Id: fCmd.test,v 1.46 2005/05/10 18:35:19 kennykb Exp $
-#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+cd [temporaryDirectory]
+
 testConstraint testsetplatform [llength [info commands testsetplatform]]
 testConstraint testchmod [llength [info commands testchmod]]
+testConstraint winVista 0
+testConstraint win2000orXP 0
 # Don't know how to determine this constraint correctly
 testConstraint notNetworkFilesystem 0
+testConstraint reg 0
+if {[testConstraint win]} {
+    catch {
+	# Is the registry extension already static to this shell?
+	try {
+	    load {} Registry
+	    set ::reglib {}
+	} on error {} {
+	    # try the location given to use on the commandline to tcltest
+	    ::tcltest::loadTestedCommands
+	    load $::reglib Registry
+	}
+	testConstraint reg 1
+    }
+}
+
+set tmpspace /tmp;# default value
+# Find a group that exists on this Unix system, or else skip tests that
+# require Unix groups.
+testConstraint foundGroup [expr {![testConstraint unix]}]
+if {[testConstraint unix]} {
+    catch {
+	set groupList [exec groups]
+	set group [lindex $groupList 0]
+	testConstraint foundGroup 1
+    }
+
+    proc dev dir {
+	file stat $dir stat
+	return $stat(dev)
+    }
+
+    if {[catch {makeDirectory tcl[pid] /tmp} tmpspace] == 0} {
+	testConstraint xdev [expr {([dev .] != [dev $tmpspace])}]
+    }
+}
+
+# Also used in winFCmd...
+if {[testConstraint win]} {
+    set major [string index $tcl_platform(osVersion) 0]
+    if {[testConstraint nt] && $major > 4} {
+        if {$major > 5} {
+            testConstraint winVista 1
+        } elseif {$major == 5} {
+            testConstraint win2000orXP 1
+        }
+    }
+}
+
+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
+testConstraint notFileSharing 1
+testConstraint linkFile 1
+testConstraint linkDirectory 1
 
 # Several tests require need to match results against the unix username
 set user {}
-if {$tcl_platform(platform) == "unix"} {
-    catch {set user [exec whoami]}
-    if {$user == ""} {
-	catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+if {[testConstraint unix]} {
+    catch {
+	set user [exec whoami]
+    }
+    if {$user eq ""} {
+	catch {
+	    regexp {^[^(]*\(([^)]*)\)} [exec id] -> user
+	}
     }
-    if {$user == ""} {
+    if {$user eq ""} {
 	set user "root"
     }
 }
@@ -42,18 +110,18 @@ proc createfile {file {string a}} {
     return $string
 }
 
-# 
+#
 # checkcontent --
 #
-#  Ensures that file "file" contains only the string "matchString"
-#  returns 0 if the file does not exist, or has a different content
+#  Ensures that file "file" contains only the string "matchString" returns 0
+#  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 
-    }]} {
+	close $f
+    } on error {} {
 	return 0
     }
     return [string match $matchString $fileString]
@@ -78,7 +146,10 @@ proc cleanup {args} {
 	    set x [glob -directory $p tf* td*]
 	}
 	foreach file $x {
-	    if {[catch {file delete -force -- $file}]} {
+	    if {
+		[catch {file delete -force -- $file}]
+		&& [testConstraint testchmod]
+	    } then {
 		catch {openup $file}
 		catch {file delete -force -- $file}
 	    }
@@ -87,33 +158,18 @@ proc cleanup {args} {
 }
 
 proc contents {file} {
-    set f [open $file r]
+    set f [open $file]
     set r [read $f]
     close $f
-    set r
+    return $r
 }
 
-cd [temporaryDirectory]
-testConstraint fileSharing 0
-testConstraint notFileSharing 1
-
-testConstraint xdev 0
-
-if {$tcl_platform(platform) == "unix"} {
-    if {[catch {set m1 [exec df .]; set m2 [exec df /tmp]}] == 0} {
-	set m1 [string range $m1 0 [expr [string first " " $m1]-1]]
-	set m2 [string range $m2 0 [expr [string first " " $m2]-1]]
-	if {$m1 != "" && $m2 != "" && $m1 != $m2 && [file exists $m1] && [file exists $m2]} {
-	    testConstraint xdev 1
-	}
-    }
-}
 
 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 or allowable filename.
+# 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"
 append long $long
@@ -121,80 +177,91 @@ append long $long
 append long $long
 append long $long
 append long $long
-
-test fCmd-1.1 {TclFileRenameCmd} {notRoot} {
+
+test fCmd-1.1 {TclFileRenameCmd} -constraints {notRoot} -setup {
     cleanup
+} -body {
     createfile tf1
     file rename tf1 tf2
     glob tf*
-} {tf2}
+} -result {tf2}
 
-test fCmd-2.1 {TclFileCopyCmd} {notRoot} {
+test fCmd-2.1 {TclFileCopyCmd} -constraints {notRoot} -setup {
     cleanup
+} -body {
     createfile tf1
     file copy tf1 tf2
     lsort [glob tf*]
-} {tf1 tf2}
-
-test fCmd-3.1 {FileCopyRename: FileForceOption fails} {notRoot} {
-    list [catch {file rename -xyz} msg] $msg
-} {1 {bad option "-xyz": should be -force or --}}
-test fCmd-3.2 {FileCopyRename: not enough args} {notRoot} {
-    list [catch {file rename xyz} msg] $msg
-} {1 {wrong # args: should be "file rename ?options? source ?source ...? target"}}
-test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} {notRoot} {
-    list [catch {file rename xyz ~_totally_bogus_user} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} {notRoot} {
-    cleanup
-    list [catch {file copy tf1 ~} msg] $msg
-} {1 {error copying "tf1": no such file or directory}}
-test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} {notRoot} {
-    cleanup
-    list [catch {file rename tf1 tf2 tf3} msg] $msg
-} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} \
-	{notRoot} {
-    cleanup
+} -result {tf1 tf2}
+
+test fCmd-3.1 {FileCopyRename: FileForceOption fails} -constraints {notRoot} -body {
+    file rename -xyz
+} -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"}
+test fCmd-3.3 {FileCopyRename: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
+    file rename xyz ~_totally_bogus_user
+} -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-3.4 {FileCopyRename: Tcl_TranslateFileName passes} -setup {
+    cleanup
+} -constraints {notRoot} -returnCodes error -body {
+    file copy tf1 ~
+} -result {error copying "tf1": no such file or directory}
+test fCmd-3.5 {FileCopyRename: target doesn't exist: stat(target) != 0} -setup {
+    cleanup
+} -constraints {notRoot} -returnCodes error -body {
+    file rename tf1 tf2 tf3
+} -result {error renaming: target "tf3" is not a directory}
+test fCmd-3.6 {FileCopyRename: target tf3 is not a dir: !S_ISDIR(target)} -setup {
+    cleanup
+} -constraints {notRoot} -returnCodes error -body {
     createfile tf3
-    list [catch {file rename tf1 tf2 tf3} msg] $msg
-} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.7 {FileCopyRename: target exists & is directory} {notRoot} {
+    file rename tf1 tf2 tf3
+} -result {error renaming: target "tf3" is not a directory}
+test fCmd-3.7 {FileCopyRename: target exists & is directory} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir td1
     createfile tf1 tf1
     file rename tf1 td1
     contents [file join td1 tf1]
-} {tf1}
-test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
+} -result {tf1}
+test fCmd-3.8 {FileCopyRename: too many arguments: argc - i > 2} -setup {
     cleanup
-    list [catch {file rename tf1 tf2 tf3} msg] $msg
-} {1 {error renaming: target "tf3" is not a directory}}
-test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} {notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+    file rename tf1 tf2 tf3
+} -result {error renaming: target "tf3" is not a directory}
+test fCmd-3.9 {FileCopyRename: too many arguments: argc - i > 2} -setup {
     cleanup
-    list [catch {file copy -force -- tf1 tf2 tf3} msg] $msg
-} {1 {error copying: target "tf3" is not a directory}}
-test fCmd-3.10 {FileCopyRename: just 2 arguments} {notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+    file copy -force -- tf1 tf2 tf3
+} -result {error copying: target "tf3" is not a directory}
+test fCmd-3.10 {FileCopyRename: just 2 arguments} -constraints notRoot -setup {
     cleanup
+} -body {
     createfile tf1 tf1
     file rename tf1 tf2
     contents tf2
-} {tf1}
-test fCmd-3.11 {FileCopyRename: just 2 arguments} {notRoot} {
+} -result {tf1}
+test fCmd-3.11 {FileCopyRename: just 2 arguments} -constraints notRoot -setup {
     cleanup
+} -body {
     createfile tf1 tf1
     file rename -force -force -- tf1 tf2
     contents tf2
-} {tf1}
-test fCmd-3.12 {FileCopyRename: move each source: 1 source} {notRoot} {
+} -result {tf1}
+test fCmd-3.12 {FileCopyRename: move each source: 1 source} -setup {
     cleanup
+} -constraints {notRoot} -body {
     createfile tf1 tf1
     file mkdir td1
     file rename tf1 td1
     contents [file join td1 tf1]
-} {tf1}
-test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
+} -result {tf1}
+test fCmd-3.13 {FileCopyRename: move each source: multiple sources} -setup {
     cleanup
+} -constraints {notRoot} -body {
     createfile tf1 tf1
     createfile tf2 tf2
     createfile tf3 tf3
@@ -203,261 +270,291 @@ test fCmd-3.13 {FileCopyRename: move each source: multiple sources} {notRoot} {
     file rename tf1 tf2 tf3 tf4 td1
     list [contents [file join td1 tf1]] [contents [file join td1 tf2]] \
 	[contents [file join td1 tf3]] [contents [file join td1 tf4]]
-} {tf1 tf2 tf3 tf4}
-test fCmd-3.14 {FileCopyRename: FileBasename fails} {notRoot} {
+} -result {tf1 tf2 tf3 tf4}
+test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     file mkdir td1
-    list [catch {file rename ~_totally_bogus_user td1} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-3.15 {FileCopyRename: source[0] == '\0'} {notRoot unixOrPc} {
+    file rename ~_totally_bogus_user td1
+} -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup {
     cleanup
+} -constraints {notRoot unixOrPc} -returnCodes error -body {
     file mkdir td1
-    list [catch {file rename / td1} msg] $msg
-} {1 {error renaming "/" to "td1": file already exists}}
-test fCmd-3.16 {FileCopyRename: break on first error} {notRoot} {
-    cleanup
-    createfile tf1 
-    createfile tf2 
-    createfile tf3 
-    createfile tf4 
+    file rename / td1
+} -result {error renaming "/" to "td1": file already exists}
+test fCmd-3.16 {FileCopyRename: break on first error} -setup {
+    cleanup
+} -constraints {notRoot} -returnCodes error -body {
+    createfile tf1
+    createfile tf2
+    createfile tf3
+    createfile tf4
     file mkdir td1
     createfile [file join td1 tf3]
-    list [catch {file rename tf1 tf2 tf3 tf4 td1} msg] $msg
-} [subst {1 {error renaming "tf3" to "[file join td1 tf3]": file already exists}}]
+    file rename tf1 tf2 tf3 tf4 td1
+} -result [subst {error renaming "tf3" to "[file join td1 tf3]": file already exists}]
 
-test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} {notRoot} {
+test fCmd-4.1 {TclFileMakeDirsCmd: make each dir: 1 dir} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir td1
     glob td*
-} {td1}
-test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} {notRoot} {
+} -result {td1}
+test fCmd-4.2 {TclFileMakeDirsCmd: make each dir: multiple dirs} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir td1 td2 td3
     lsort [glob td*]
-} {td1 td2 td3}
-test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} {notRoot} {
+} -result {td1 td2 td3}
+test fCmd-4.3 {TclFileMakeDirsCmd: stops on first error} -setup {
     cleanup
+} -constraints {notRoot} -body {
     createfile tf1
     catch {file mkdir td1 td2 tf1 td3 td4}
     glob td1 td2 tf1 td3 td4
-} {td1 td2 tf1}
-test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} {notRoot} {
+} -result {td1 td2 tf1}
+test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup {
     cleanup
-    list [catch {file mkdir ~_totally_bogus_user} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} \
-	{notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+    file mkdir ~_totally_bogus_user
+} -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setup {
     cleanup
-    list [catch {file mkdir ""} msg] $msg
-} {1 {can't create directory "": no such file or directory}}
-test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} {notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+    file mkdir ""
+} -result {can't create directory "": no such file or directory}
+test fCmd-4.6 {TclFileMakeDirsCmd: one level deep} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir td1
     glob td1
-} {td1}
-test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} {notRoot} {
+} -result {td1}
+test fCmd-4.7 {TclFileMakeDirsCmd: multi levels deep} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir [file join td1 td2 td3 td4]
     glob td1 [file join td1 td2]
-} "td1 [file join td1 td2]"
-test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} {notRoot} {
+} -result "td1 [file join td1 td2]"
+test fCmd-4.8 {TclFileMakeDirsCmd: already exist: lstat(target) == 0} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir td1
     set x [file exists td1]
     file mkdir td1
     list $x [file exists td1]
-} {1 1}
-test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} {notRoot} {
+} -result {1 1}
+test fCmd-4.9 {TclFileMakeDirsCmd: exists, not dir} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     createfile tf1
-    list [catch {file mkdir tf1} msg] $msg
-} [subst {1 {can't create directory "[file join tf1]": file already exists}}]
-test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} {notRoot} {
+    file mkdir tf1
+} -result [subst {can't create directory "[file join tf1]": file already exists}]
+test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir td1
     set x [file exists td1]
     file mkdir td1
     list $x [file exists td1]
-} {1 1}
-test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} \
-	{unix notRoot testchmod} {
+} -result {1 1}
+test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
     cleanup
+} -constraints {unix notRoot testchmod} -returnCodes error -body {
     file mkdir td1/td2/td3
     testchmod 000 td1/td2
-    set msg [list [catch {file mkdir td1/td2/td3/td4} msg] $msg]
+    file mkdir td1/td2/td3/td4
+} -cleanup {
     testchmod 755 td1/td2
-    set msg
-} {1 {can't create directory "td1/td2/td3": permission denied}}
-test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} {notRoot} {
     cleanup
+} -result {can't create directory "td1/td2/td3": permission denied}
+test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup {
+    cleanup
+} -constraints {notRoot} -body {
     set x [file exists td1]
     file mkdir td1
     list $x [file exists td1]
-} {0 1}
-test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} \
-	{unix notRoot} {
+} -result {0 1}
+test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
     cleanup
     file delete -force foo
+} -constraints {unix notRoot} -body {
     file mkdir foo
     file attr foo -perm 040000
-    set result [list [catch {file mkdir foo/tf1} msg] $msg]
+    file mkdir foo/tf1
+} -returnCodes error -cleanup {
     file delete -force foo
-    set result
-} {1 {can't create directory "foo/tf1": permission denied}}
-test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} {notRoot} {
+} -result {can't create directory "foo/tf1": permission denied}
+test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir tf1
     file exists tf1
-} {1}
+} -result {1}
 
-test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} {notRoot} {
-    list [catch {file delete -xyz} msg] $msg
-} {1 {bad option "-xyz": should be -force or --}}
-test fCmd-5.2 {TclFileDeleteCmd: not enough args} {notRoot} {
-    list [catch {file delete -force -force} msg] $msg
-} {1 {wrong # args: should be "file delete ?options? file ?file ...?"}}
-test fCmd-5.3 {TclFileDeleteCmd: 1 file} {notRoot} {
+test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
+    file delete -xyz
+} -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 {}
+test fCmd-5.3 {TclFileDeleteCmd: 1 file} -constraints {notRoot} -setup {
     cleanup
+} -body {
     createfile tf1
     createfile tf2
     file mkdir td1
     file delete tf2
     glob tf* td*
-} {tf1 td1}
-test fCmd-5.4 {TclFileDeleteCmd: multiple files} {notRoot} {
+} -result {tf1 td1}
+test fCmd-5.4 {TclFileDeleteCmd: multiple files} -constraints notRoot -setup {
     cleanup
+} -body {
     createfile tf1
     createfile tf2
     file mkdir td1
     set x [list [file exists tf1] [file exists tf2] [file exists td1]]
     file delete tf1 td1 tf2
     lappend x [file exists tf1] [file exists tf2] [file exists tf3]
-} {1 1 1 0 0 0}
-test fCmd-5.5 {TclFileDeleteCmd: stop at first error} {notRoot unixOrPc} {
+} -cleanup {cleanup} -result {1 1 1 0 0 0}
+test fCmd-5.5 {TclFileDeleteCmd: stop at first error} -setup {
     cleanup
+} -constraints {notRoot unixOrPc} -body {
     createfile tf1
     createfile tf2
     file mkdir td1
     catch {file delete tf1 td1 $root tf2}
     list [file exists tf1] [file exists tf2] [file exists td1]
-} {0 1 0}
-test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} {notRoot} {
-    list [catch {file delete ~_totally_bogus_user} msg] $msg
-} {1 {user "_totally_bogus_user" doesn't exist}}
-test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} {notRoot} {
+} -cleanup {cleanup} -result {0 1 0}
+test fCmd-5.6 {TclFileDeleteCmd: Tcl_TranslateFileName fails} -constraints {notRoot} -body {
+    file delete ~_totally_bogus_user
+} -returnCodes error -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-5.7 {TclFileDeleteCmd: Tcl_TranslateFileName succeeds} -setup {
     catch {file delete ~/tf1}
+} -constraints {notRoot} -body {
     createfile ~/tf1
     file delete ~/tf1
-} {}
-test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} {notRoot} {
+} -result {}
+test fCmd-5.8 {TclFileDeleteCmd: file doesn't exist: lstat(name) != 0} -setup {
     cleanup
+} -constraints {notRoot} -body {
     set x [file exists tf1]
     file delete tf1
     list $x [file exists tf1]
-} {0 0}    
-test fCmd-5.9 {TclFileDeleteCmd: is directory} {notRoot} {
+} -result {0 0}
+test fCmd-5.9 {TclFileDeleteCmd: is directory} -constraints {notRoot} -setup {
     cleanup
+} -body {
     file mkdir td1
     file delete td1
     file exists td1
-} {0}
-test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} {notRoot} {
+} -result {0}
+test fCmd-5.10 {TclFileDeleteCmd: TclpRemoveDirectory fails} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     file mkdir [file join td1 td2]
-    list [catch {file delete td1} msg] $msg
-} {1 {error deleting "td1": directory not empty}}
-test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} {notRoot} {
+    file delete td1
+} -result {error deleting "td1": directory not empty}
+test fCmd-5.11 {TclFileDeleteCmd: TclpRemoveDirectory with cwd inside} -setup {
     cleanup
     set dir [pwd]
+} -constraints {notRoot} -body {
     file mkdir [file join td1 td2]
     cd [file join td1 td2]
     set res [list [catch {file delete -force [file dirname [pwd]]} msg]]
     cd $dir
     lappend res [file exists td1] $msg
-} {0 0 {}}
-test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} {unix} {
+} -cleanup {
+    cd $dir
+} -result {0 0 {}}
+test fCmd-5.12 {TclFileDeleteCmd: TclpRemoveDirectory with bad perms} -setup {
     cleanup
+} -constraints {unix} -body {
     file mkdir [file join td1 td2]
-    #exec chmod u-rwx [file join td1 td2]
     file attributes [file join td1 td2] -permissions u+rwx
     set res [list [catch {file delete -force td1} msg]]
     lappend res [file exists td1] $msg
-} {0 0 {}}
+} -result {0 0 {}}
 
-test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot} {
+test fCmd-6.1 {CopyRenameOneFile: bad source} {notRoot emptyTest} {
     # can't test this, because it's caught by FileCopyRename
 } {}
-test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot} {
+test fCmd-6.2 {CopyRenameOneFile: bad target} {notRoot emptyTest} {
     # can't test this, because it's caught by FileCopyRename
 } {}
-test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} {notRoot} {
+test fCmd-6.3 {CopyRenameOneFile: lstat(source) != 0} -setup {
     cleanup
-    list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1": no such file or directory}}
-test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} {notRoot} {
+} -constraints {notRoot} -returnCodes error -body {
+    file rename tf1 tf2
+} -result {error renaming "tf1": no such file or directory}
+test fCmd-6.4 {CopyRenameOneFile: lstat(source) == 0} -setup {
     cleanup
+} -constraints {notRoot} -body {
     createfile tf1
     file rename tf1 tf2
     glob tf*
-} {tf2}
-test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} {notRoot} {
+} -result {tf2}
+test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} -setup {
     cleanup
+} -constraints {notRoot} -body {
     createfile tf1
     file rename tf1 tf2
     glob tf*
-} {tf2}
-test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} {unix notRoot testchmod} {
+} -result {tf2}
+test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
     cleanup
+} -constraints {unix notRoot testchmod} -body {
     file mkdir td1
     testchmod 000 td1
     createfile tf1
-    set msg [list [catch {file rename tf1 td1} msg] $msg]
+    file rename tf1 td1
+} -returnCodes error -cleanup {
     testchmod 755 td1
-    set msg
-} {1 {error renaming "tf1" to "td1/tf1": permission denied}}
-test fCmd-6.7 {CopyRenameOneFile: errno != ENOENT} {win 95} {
-    cleanup
-    createfile tf1
-    list [catch {file rename tf1 $long} msg] $msg
-} [subst {1 {error renaming "tf1" to "$long": file name too long}}]
-test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} {unix notRoot} {
+} -result {error renaming "tf1" to "td1/tf1": permission denied}
+test fCmd-6.9 {CopyRenameOneFile: errno == ENOENT} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
     createfile tf1
     file rename tf1 tf2
     glob tf*
-} {tf2}
-test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} {notRoot} {
+} -result {tf2}
+test fCmd-6.10 {CopyRenameOneFile: lstat(target) == 0} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     createfile tf1
     createfile tf2
-    list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1" to "tf2": file already exists}}
-test fCmd-6.11 {CopyRenameOneFile: force == 0} {notRoot} {
+    file rename tf1 tf2
+} -result {error renaming "tf1" to "tf2": file already exists}
+test fCmd-6.11 {CopyRenameOneFile: force == 0} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     createfile tf1
     createfile tf2
-    list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1" to "tf2": file already exists}}
-test fCmd-6.12 {CopyRenameOneFile: force != 0} {notRoot} {
+    file rename tf1 tf2
+} -result {error renaming "tf1" to "tf2": file already exists}
+test fCmd-6.12 {CopyRenameOneFile: force != 0} -setup {
     cleanup
+} -constraints {notRoot} -body {
     createfile tf1
     createfile tf2
     file rename -force tf1 tf2
     glob tf*
-} {tf2}
-test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} {notRoot} {
+} -result {tf2}
+test fCmd-6.13 {CopyRenameOneFile: source is dir, target is file} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     file mkdir td1
     file mkdir td2
     createfile [file join td2 td1]
-    list [catch {file rename -force td1 td2} msg] $msg
-} [subst {1 {can't overwrite file "[file join td2 td1]" with directory "td1"}}]
-test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} {notRoot} {
+    file rename -force td1 td2
+} -result [subst {can't overwrite file "[file join td2 td1]" with directory "td1"}]
+test fCmd-6.14 {CopyRenameOneFile: source is file, target is dir} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     createfile tf1
     file mkdir [file join td1 tf1]
-    list [catch {file rename -force tf1 td1} msg] $msg
-} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
+    file rename -force tf1 td1
+} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
 test fCmd-6.15 {CopyRenameOneFile: TclpRenameFile succeeds} -setup {
     cleanup
 } -constraints {notRoot notNetworkFilesystem} -body {
@@ -476,10 +573,11 @@ test fCmd-6.16 {CopyRenameOneFile: TclpCopyRenameOneFile fails} -setup {
     file rename -force td2 td1
 } -returnCodes error -match glob -result \
     [subst {error renaming "td2" to "[file join td1 td2]": file *}]
-test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} {notRoot} {
+test fCmd-6.17 {CopyRenameOneFile: errno == EINVAL} -setup {
     cleanup
-    list [catch {file rename -force $root tf1} msg] $msg
-} [subst {1 {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}}]
+} -constraints {notRoot} -returnCodes error -body {
+    file rename -force $root tf1
+} -result [subst {error renaming "$root" to "tf1": trying to rename a volume or move a directory into itself}]
 test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
     cleanup
 } -constraints {notRoot} -body {
@@ -489,228 +587,264 @@ test fCmd-6.18 {CopyRenameOneFile: errno != EXDEV} -setup {
     file rename -force td2 td1
 } -returnCodes error -match glob -result \
     [subst {error renaming "td2" to "[file join td1 td2]": file *}]
-test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} {unix notRoot} {
-    cleanup /tmp
+test fCmd-6.19 {CopyRenameOneFile: errno == EXDEV} -setup {
+    cleanup $tmpspace
+} -constraints {unix notRoot} -body {
     createfile tf1
-    file rename tf1 /tmp
-    glob -nocomplain tf* /tmp/tf1
-} {/tmp/tf1}
-test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} {win} {
+    file rename tf1 $tmpspace
+    glob -nocomplain tf* [file join $tmpspace tf1]
+} -result [file join $tmpspace tf1]
+test fCmd-6.20 {CopyRenameOneFile: errno == EXDEV} -constraints {win} -setup {
     catch {file delete -force c:/tcl8975@ d:/tcl8975@}
+} -body {
     file mkdir c:/tcl8975@
-    if [catch {file rename c:/tcl8975@ d:/}] {
-	set msg d:/tcl8975@
-    } else {
-	set msg [glob c:/tcl8975@ d:/tcl8975@]
-	file delete -force d:/tcl8975@
+    if {[catch {file rename c:/tcl8975@ d:/}]} {
+	return d:/tcl8975@
     }
+    glob c:/tcl8975@ d:/tcl8975@
+} -cleanup {
     file delete -force c:/tcl8975@
-    set msg
-} {d:/tcl8975@}
-test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} \
-	{unix notRoot} {
-    cleanup /tmp
+    catch {file delete -force d:/tcl8975@}
+} -result {d:/tcl8975@}
+test fCmd-6.21 {CopyRenameOneFile: copy/rename: S_ISDIR(source)} -setup {
+    cleanup $tmpspace
+} -constraints {unix notRoot} -body {
     file mkdir td1
-    file rename td1 /tmp
-    glob -nocomplain td* /tmp/td*
-} {/tmp/td1}
-test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} \
-	{unix notRoot} {
-    cleanup /tmp
+    file rename td1 $tmpspace
+    glob -nocomplain td* [file join $tmpspace td*]
+} -result [file join $tmpspace td1]
+test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
+    cleanup $tmpspace
+} -constraints {unix notRoot} -body {
     createfile tf1
-    file rename tf1 /tmp
-    glob -nocomplain tf* /tmp/tf*
-} {/tmp/tf1}
-test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} \
-	{unix notRoot xdev} {
-    cleanup /tmp
+    file rename tf1 $tmpspace
+    glob -nocomplain tf* [file join $tmpspace tf*]
+} -result [file join $tmpspace tf1]
+test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
+    cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
     file mkdir td1/td2/td3
     file attributes td1 -permissions 0000
-    set msg [list [catch {file rename td1 /tmp} msg] $msg]
+    file rename td1 $tmpspace
+} -returnCodes error -cleanup {
     file attributes td1 -permissions 0755
-    set msg 
-} {1 {error renaming "td1": permission denied}}
-test fCmd-6.24 {CopyRenameOneFile: error uses original name} \
-	{unix notRoot} {
     cleanup
+} -match regexp -result {^error renaming "td1"( to "/tmp/tcl\d+/td1")?: permission denied$}
+test fCmd-6.24 {CopyRenameOneFile: error uses original name} -setup {
+    cleanup
+} -constraints {unix notRoot} -body {
     file mkdir ~/td1/td2
     set td1name [file join [file dirname ~] [file tail ~] td1]
     file attributes $td1name -permissions 0000
-    set msg [list [catch {file copy ~/td1 td1} msg] $msg]
+    file copy ~/td1 td1
+} -returnCodes error -cleanup {
     file attributes $td1name -permissions 0755
     file delete -force ~/td1
-    set msg
-} {1 {error copying "~/td1": permission denied}}
-test fCmd-6.25 {CopyRenameOneFile: error uses original name} \
-	{unix notRoot} {
+} -result {error copying "~/td1": permission denied}
+test fCmd-6.25 {CopyRenameOneFile: error uses original name} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
     file mkdir td2
     file mkdir ~/td1
     set td1name [file join [file dirname ~] [file tail ~] td1]
     file attributes $td1name -permissions 0000
-    set msg [list [catch {file copy td2 ~/td1} msg] $msg]
+    file copy td2 ~/td1
+} -returnCodes error -cleanup {
     file attributes $td1name -permissions 0755
     file delete -force ~/td1
-    set msg
-} {1 {error copying "td2" to "~/td1/td2": permission denied}}
-test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} \
-	{unix notRoot} {
+} -result {error copying "td2" to "~/td1/td2": permission denied}
+test fCmd-6.26 {CopyRenameOneFile: doesn't use original name} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
     file mkdir ~/td1/td2
     set td2name [file join [file dirname ~] [file tail ~] td1 td2]
     file attributes $td2name -permissions 0000
-    set msg [list [catch {file copy ~/td1 td1} msg] $msg]
+    file copy ~/td1 td1
+} -returnCodes error -cleanup {
     file attributes $td2name -permissions 0755
     file delete -force ~/td1
-    set msg
-} "1 {error copying \"~/td1\" to \"td1\": \"[file join [file dirname ~] [file tail ~] td1 td2]\": permission denied}"
-test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} \
-	{unix notRoot xdev} {
-    cleanup /tmp
+} -result "error copying \"~/td1\" to \"td1\": \"[file join $::env(HOME) td1 td2]\": permission denied"
+test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
+    cleanup $tmpspace
+} -constraints {notRoot xdev} -returnCodes error -body {
     file mkdir td1/td2/td3
-    file mkdir /tmp/td1
-    createfile /tmp/td1/tf1
-    list [catch {file rename -force td1 /tmp} msg] $msg
-} {1 {error renaming "td1" to "/tmp/td1": file already exists}}
-test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} \
-	{unix notRoot xdev} {
-    cleanup /tmp
+    file mkdir [file join $tmpspace td1]
+    createfile [file join $tmpspace td1 tf1]
+    file rename -force td1 $tmpspace
+} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists}
+test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
+    cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
     file mkdir td1/td2/td3
     file attributes td1/td2/td3 -permissions 0000
-    set msg [list [catch {file rename td1 /tmp} msg] $msg]
+    file rename td1 $tmpspace
+} -returnCodes error -cleanup {
     file attributes td1/td2/td3 -permissions 0755
-    set msg
-} {1 {error renaming "td1" to "/tmp/td1": "td1/td2/td3": permission denied}}
-test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} \
-	{unix notRoot xdev} {
-    cleanup /tmp
+    cleanup $tmpspace
+} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": "td1/td2/td3": permission denied}
+test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
+    cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
     file mkdir td1/td2/td3
-    file rename td1 /tmp
-    glob td* /tmp/td1/t*
-} {/tmp/td1/td2}
-test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} \
-	{unix notRoot} {
-    cleanup
+    file rename td1 $tmpspace
+    glob td* [file join $tmpspace td1 t*]
+} -result [file join $tmpspace td1 td2]
+test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
+    cleanup $tmpspace
+} -constraints {unix notRoot} -body {
     file mkdir foo/bar
     file attr foo -perm 040555
-    set catchResult [catch {file rename foo/bar /tmp} msg]
-    set msg [lindex [split $msg :] end]
-    catch {file delete /tmp/bar}
+    file rename foo/bar $tmpspace
+} -returnCodes error -cleanup {
+    catch {file delete [file join $tmpspace bar]}
     catch {file attr foo -perm 040777}
     catch {file delete -force foo}
-    list $catchResult $msg
-} {1 { permission denied}}
-test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} \
-	{unix notRoot xdev} {
-    catch {cleanup /tmp}
-    file mkdir /tmp/td1
-    createfile /tmp/td1/tf1
-    file rename /tmp/td1/tf1 tf1
-    list [file exists /tmp/td1/tf1] [file exists tf1]
-} {0 1}
-test fCmd-6.32 {CopyRenameOneFile: copy} {notRoot} {
-    cleanup
-    list [catch {file copy tf1 tf2} msg] $msg
-} {1 {error copying "tf1": no such file or directory}}
-catch {cleanup /tmp}
+} -match glob -result {*: permission denied}
+test fCmd-6.31 {CopyRenameOneFile: TclpDeleteFile passed} -setup {
+    cleanup $tmpspace
+} -constraints {notRoot xdev} -body {
+    file mkdir [file join $tmpspace td1]
+    createfile [file join $tmpspace td1 tf1]
+    file rename [file join $tmpspace td1 tf1] tf1
+    list [file exists [file join $tmpspace td1 tf1]] [file exists tf1]
+} -result {0 1}
+test fCmd-6.32 {CopyRenameOneFile: copy} -constraints {notRoot} -setup {
+    cleanup
+} -returnCodes error -body {
+    file copy tf1 tf2
+} -result {error copying "tf1": no such file or directory}
 
-test fCmd-7.1 {FileForceOption: none} {notRoot} {
+test fCmd-7.1 {FileForceOption: none} -constraints {notRoot} -setup {
     cleanup
+} -returnCodes error -body {
     file mkdir [file join tf1 tf2]
-    list [catch {file delete tf1} msg] $msg
-} {1 {error deleting "tf1": directory not empty}}
-test fCmd-7.2 {FileForceOption: -force} {notRoot} {
+    file delete tf1
+} -result {error deleting "tf1": directory not empty}
+test fCmd-7.2 {FileForceOption: -force} -constraints {notRoot} -setup {
     cleanup
+} -body {
     file mkdir [file join tf1 tf2]
     file delete -force tf1
-} {}
-test fCmd-7.3 {FileForceOption: --} {notRoot} {
+} -result {}
+test fCmd-7.3 {FileForceOption: --} -constraints {notRoot} -body {
     createfile -tf1
     file delete -- -tf1
-} {}
-test fCmd-7.4 {FileForceOption: bad option} {notRoot} {
+} -result {}
+test fCmd-7.4 {FileForceOption: bad option} -constraints {notRoot} -setup {
     createfile -tf1
-    set msg [list [catch {file delete -tf1} msg] $msg]
+} -body {
+    file delete -tf1
+} -returnCodes error -cleanup {
     file delete -- -tf1
-    set msg
-} {1 {bad option "-tf1": should be -force or --}}
-test fCmd-7.5 {FileForceOption: multiple times through loop} {notRoot} {
+} -result {bad option "-tf1": must be -force or --}
+test fCmd-7.5 {FileForceOption: multiple times through loop} -setup {
+    cleanup
+} -constraints {notRoot} -returnCodes error -body {
     createfile --
     createfile -force
     file delete -force -force -- -- -force
-    list [catch {glob -- -- -force} msg] $msg
-} {1 {no files matched glob patterns "-- -force"}}
+    glob -- -- -force
+} -result {no files matched glob patterns "-- -force"}
 
 test fCmd-8.1 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
-	{unix notRoot knownBug} {
+    -constraints {unix notRoot knownBug} -body {
     # Labelled knownBug because it is dangerous [Bug: 3881]
     file mkdir td1
     file attr td1 -perm 040000
-    set result [list [catch {file rename ~$user td1} msg] $msg]
+    file rename ~$user td1
+} -returnCodes error -cleanup {
     file delete -force td1
-    set result
-} "1 {error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied}"
+} -result "error renaming \"~$user\" to \"td1/[file tail ~$user]\": permission denied"
 test fCmd-8.2 {FileBasename: basename of ~user: argc == 1 && *path == ~} \
-	{unix notRoot} {
+	-constraints {unix notRoot} -body {
     string equal [file tail ~$user] ~$user
-} 0
-test fCmd-8.3 {file copy and path translation: ensure correct error} {
-    list [catch {file copy ~ [file join this file doesnt exist]} res] $res
-} [list 1 \
-  "error copying \"~\" to \"[file join this file doesnt exist]\":\
-  no such file or directory"]
+} -result 0
+test fCmd-8.3 {file copy and path translation: ensure correct error} -body {
+    file copy ~ [file join this file doesnt exist]
+} -returnCodes error -result [subst \
+	{error copying "~" to "[file join this file doesnt exist]": no such file or directory}]
 
-test fCmd-9.1 {file rename: comprehensive: EACCES} {unix notRoot} {
+test fCmd-9.1 {file rename: comprehensive: EACCES} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
     file mkdir td1
     file mkdir td2
     file attr td2 -perm 040000
-    set result [list [catch {file rename td1 td2/} msg] $msg]
+    file rename td1 td2/
+} -returnCodes error -cleanup {
     file delete -force td2
     file delete -force td1
-    set result
-} {1 {error renaming "td1" to "td2/td1": permission denied}}
-test fCmd-9.2 {file rename: comprehensive: source doesn't exist} {notRoot} {
+} -result {error renaming "td1" to "td2/td1": permission denied}
+test fCmd-9.2 {file rename: comprehensive: source doesn't exist} -setup {
     cleanup
-    list [catch {file rename tf1 tf2} msg] $msg
-} {1 {error renaming "tf1": no such file or directory}}
-test fCmd-9.3 {file rename: comprehensive: file to new name} {notRoot testchmod} {
+} -constraints {notRoot} -returnCodes error -body {
+    file rename tf1 tf2
+} -result {error renaming "tf1": no such file or directory}
+test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
     cleanup
+} -constraints {notRoot testchmod} -body {
     createfile tf1
     createfile tf2
     testchmod 444 tf2
     file rename tf1 tf3
     file rename tf2 tf4
     list [lsort [glob tf*]] [file writable tf3] [file writable tf4]
-} {{tf3 tf4} 1 0}    
-test fCmd-9.4 {file rename: comprehensive: dir to new name} {unixOrPc notRoot testchmod} {
+} -result {{tf3 tf4} 1 0}
+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]
-} {{td3 td4} 1 0}    
-test fCmd-9.5 {file rename: comprehensive: file to self} {notRoot testchmod} {
+} -cleanup {
+    cleanup
+} -result {{td3 td4} 1 0}
+test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup {
     cleanup
+} -constraints {unix notRoot testchmod notDarwin9} -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.5 {file rename: comprehensive: file to self} -setup {
+    cleanup
+} -constraints {notRoot testchmod} -body {
     createfile tf1 tf1
     createfile tf2 tf2
     testchmod 444 tf2
     file rename -force tf1 tf1
     file rename -force tf2 tf2
     list [contents tf1] [contents tf2] [file writable tf1] [file writable tf2]
-} {tf1 tf2 1 0}    
-test fCmd-9.6 {file rename: comprehensive: dir to self} {notRoot unixOrPc testchmod} {
+} -result {tf1 tf2 1 0}
+test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
     cleanup
+} -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]
-} {{td1 td2} 1 0}    
-test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testchmod} {
+} -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
+    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.7 {file rename: comprehensive: file to existing file} -setup {
+    cleanup
+} -constraints {notRoot testchmod} -body {
     createfile tf1
     createfile tf2
     createfile tfs1
@@ -730,14 +864,13 @@ test fCmd-9.7 {file rename: comprehensive: file to existing file} {notRoot testc
     file rename -force tfs2 tfd2
     file rename -force tfs3 tfd3
     file rename -force tfs4 tfd4
-    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
-} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
+    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
+} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4} {1 {error renaming "tf1" to "tf2": file already exists}} 1 1 0 0}
 test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
     cleanup
 } -constraints {notRoot testchmod notNetworkFilesystem} -body {
-    # Under unix, you can rename a read-only directory, but you can't
-    # move it into another directory.
-
+    # Under unix, you can rename a read-only directory, but you can't move it
+    # into another directory.
     file mkdir td1
     file mkdir [file join td2 td1]
     file mkdir tds1
@@ -748,7 +881,7 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
     file mkdir [file join tdd2 tds2]
     file mkdir [file join tdd3 tds3]
     file mkdir [file join tdd4 tds4]
-    if {$tcl_platform(platform) != "unix"} {
+    if {![testConstraint unix]} {
 	testchmod 555 tds3
 	testchmod 555 tds4
     }
@@ -759,12 +892,12 @@ test fCmd-9.8 {file rename: comprehensive: dir to empty dir} -setup {
     file rename -force tds2 tdd2
     file rename -force tds3 tdd3
     file rename -force tds4 tdd4
-    if {$tcl_platform(platform) != "unix"} {
-	set w3 [file writable [file join tdd3 tds3]]
-	set w4 [file writable [file join tdd4 tds4]]
-    } else {
+    if {[testConstraint unix]} {
 	set w3 0
 	set w4 0
+    } else {
+	set w3 [file writable [file join tdd3 tds3]]
+	set w4 [file writable [file join tdd4 tds4]]
     }
     list [lsort [glob td*]] $msg [file writable [file join tdd1 tds1]] \
     [file writable [file join tdd2 tds2]] $w3 $w4
@@ -777,21 +910,22 @@ test fCmd-9.9 {file rename: comprehensive: dir to non-empty dir} -setup {
     file mkdir tds2
     file mkdir [file join tdd1 tds1 xxx]
     file mkdir [file join tdd2 tds2 xxx]
-    if {$tcl_platform(platform) != "unix"} {
+    if {!([testConstraint unix] || [testConstraint winVista])} {
 	testchmod 555 tds2
     }
     set a1 [list [catch {file rename -force tds1 tdd1} msg] $msg]
     set a2 [list [catch {file rename -force tds2 tdd2} msg] $msg]
-    if {$tcl_platform(platform) != "unix"} {
-	set w2 [file writable tds2]
-    } else {
+    if {[testConstraint unix] || [testConstraint winVista]} {
 	set w2 0
+    } else {
+	set w2 [file writable tds2]
     }
     list [lsort [glob td*]] $a1 $a2 [file writable tds1] $w2
 } -match glob -result \
     [subst {{tdd1 tdd2 tds1 tds2} {1 {error renaming "tds1" to "[file join tdd1 tds1]": file *}} {1 {error renaming "tds2" to "[file join tdd2 tds2]": file *}} 1 0}]
-test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
+test fCmd-9.10 {file rename: comprehensive: file to new name and dir} -setup {
     cleanup
+} -constraints {notRoot testchmod} -body {
     createfile tf1
     createfile tf2
     file mkdir td1
@@ -800,25 +934,26 @@ test fCmd-9.10 {file rename: comprehensive: file to new name and dir} {notRoot t
     file rename tf2 [file join td1 tf4]
     list [catch {glob tf*}] [lsort [glob -directory td1 t*]] \
     [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
-} [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
-test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} {notRoot testchmod} {
+} -result [subst {1 {[file join td1 tf3] [file join td1 tf4]} 1 0}]
+test fCmd-9.11 {file rename: comprehensive: dir to new name and dir} -setup {
     cleanup
+} -constraints {notRoot testchmod} -body {
     file mkdir td1
     file mkdir td2
     file mkdir td3
-    if {$tcl_platform(platform) != "unix"} {
+    if {!([testConstraint unix] || [testConstraint winVista])} {
 	testchmod 555 td2
     }
     file rename td1 [file join td3 td3]
     file rename td2 [file join td3 td4]
-    if {$tcl_platform(platform) != "unix"} {
-	set w4 [file writable [file join td3 td4]]
-    } else {
+    if {[testConstraint unix] || [testConstraint winVista]} {
         set w4 0
+    } else {
+	set w4 [file writable [file join td3 td4]]
     }
     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
     [file writable [file join td3 td3]] $w4
-} [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
+} -result [subst {td3 {[file join td3 td3] [file join td3 td4]} 1 0}]
 test fCmd-9.12 {file rename: comprehensive: target exists} -setup {
     cleanup
 } -constraints {notRoot testchmod notNetworkFilesystem} -body {
@@ -839,79 +974,104 @@ test fCmd-9.13 {file rename: comprehensive: can't overwrite target} -setup {
     file rename -force td1 td2
 } -returnCodes error -match glob -result \
     [subst {error renaming "td1" to "[file join td2 td1]": file *}]
-test fCmd-9.14 {file rename: comprehensive: dir into self} {notRoot} {
+test fCmd-9.14 {file rename: comprehensive: dir into self} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir td1
     list [glob td*] [list [catch {file rename td1 td1} msg] $msg]
-} [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
-test fCmd-9.14.1 {file rename: comprehensive: dir into self} {notRoot} {
+} -result [subst {td1 {1 {error renaming "td1" to "[file join td1 td1]": trying to rename a volume or move a directory into itself}}}]
+test fCmd-9.14.1 {file rename: comprehensive: dir into self} -setup {
     cleanup
+} -constraints {notRoot} -body {
     file mkdir td1
     file rename td1 td1x
     file rename td1x td1
     set msg "ok"
-} {ok}
-test fCmd-9.14.2 {file rename: comprehensive: dir into self} {nonPortable notRoot} {
+} -result {ok}
+test fCmd-9.14.2 {file rename: comprehensive: dir into self} -setup {
     cleanup
-    file mkdir td1
     set dir [pwd]
+} -constraints {nonPortable notRoot} -body {
+    file mkdir td1
     cd td1
-    set res [list [catch {file rename [file join .. td1] [file join .. td1x]} msg] $msg]
+    file rename [file join .. td1] [file join .. td1x]
+} -returnCodes error -cleanup {
     cd $dir
-    set res
-} [subst {1 {error renaming "[file join .. td1]" to "[file join .. td1x]": permission denied}}]
-test fCmd-9.14.3 {file rename: comprehensive: dir into self} {notRoot} {
+} -result [subst {error renaming "[file join .. td1]" to "[file join .. td1x]": permission denied}]
+test fCmd-9.14.3 {file rename: comprehensive: dir into self} -setup {
     cleanup
-    file mkdir td1
     set dir [pwd]
+} -constraints {notRoot} -body {
+    file mkdir td1
     cd td1
-    set res [list [catch {file rename [file join .. td1] [file join .. td1 foo]} msg] $msg]
+    file rename [file join .. td1] [file join .. td1 foo]
+} -returnCodes error -cleanup {
     cd $dir
-    set res
-} [subst {1 {error renaming "[file join .. td1]" to "[file join .. td1 foo]": trying to rename a volume or move a directory into itself}}]
-test fCmd-9.15 {file rename: comprehensive: source and target incompatible} \
-	{notRoot} {
+} -result [subst {error renaming "[file join .. td1]" to "[file join .. td1 foo]": trying to rename a volume or move a directory into itself}]
+test fCmd-9.15 {file rename: comprehensive: source and target incompatible} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     file mkdir td1
     createfile tf1
-    list [catch {file rename -force td1 tf1} msg] $msg
-} {1 {can't overwrite file "tf1" with directory "td1"}}
-test fCmd-9.16 {file rename: comprehensive: source and target incompatible} \
-	{notRoot} {
+    file rename -force td1 tf1
+} -cleanup {
+    cleanup
+} -result {can't overwrite file "tf1" with directory "td1"}
+test fCmd-9.16 {file rename: comprehensive: source and target incompatible} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     file mkdir td1/tf1
     createfile tf1
-    list [catch {file rename -force tf1 td1} msg] $msg
-} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
+    file rename -force tf1 td1
+} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
 
-test fCmd-10.1 {file copy: comprehensive: source doesn't exist} {notRoot} {
+test fCmd-10.1 {file copy: comprehensive: source doesn't exist} -setup {
     cleanup
-    list [catch {file copy tf1 tf2} msg] $msg
-} {1 {error copying "tf1": no such file or directory}}
-test fCmd-10.2 {file copy: comprehensive: file to new name} {notRoot testchmod} {
+} -constraints {notRoot} -returnCodes error -body {
+    file copy tf1 tf2
+} -result {error copying "tf1": no such file or directory}
+test fCmd-10.2 {file copy: comprehensive: file to new name} -setup {
     cleanup
+} -constraints {notRoot testchmod} -body {
     createfile tf1 tf1
     createfile tf2 tf2
     testchmod 444 tf2
     file copy tf1 tf3
     file copy tf2 tf4
     list [lsort [glob tf*]] [contents tf3] [contents tf4] [file writable tf3] [file writable tf4]
-} {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
-test fCmd-10.3 {file copy: comprehensive: dir to new name} {notRoot unixOrPc testchmod} {
+} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
+test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
+    cleanup
+} -constraints {unix notRoot testchmod} -body {
+    file mkdir [file join td1 tdx]
+    file mkdir [file join td2 tdy]
+    testchmod 555 td2
+    file copy td1 td3
+    file copy td2 td4
+    list [lsort [glob td*]] [glob -directory td3 t*] \
+	    [glob -directory td4 t*] [file writable td3] [file writable td4]
+} -cleanup {
+    testchmod 755 td2
+    testchmod 755 td4
+} -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 {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]
     testchmod 555 td2
     file copy td1 td3
     file copy td2 td4
-    set msg [list [lsort [glob td*]] [glob -directory td3 t*] \
-	    [glob -directory td4 t*] [file writable td3] [file writable td4]]
+    list [lsort [glob td*]] [glob -directory td3 t*] \
+	    [glob -directory td4 t*] [file writable td3] [file writable td4]
+} -cleanup {
     testchmod 755 td2
     testchmod 755 td4
-    set msg
-} [subst {{td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 0}]
-test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testchmod} {
+} -result [list {td1 td2 td3 td4} [file join td3 tdx] [file join td4 tdy] 1 1]
+test fCmd-10.4 {file copy: comprehensive: file to existing file} -setup {
     cleanup
+} -constraints {notRoot testchmod} -body {
     createfile tf1
     createfile tf2
     createfile tfs1
@@ -931,10 +1091,11 @@ test fCmd-10.4 {file copy: comprehensive: file to existing file} {notRoot testch
     file copy -force tfs2 tfd2
     file copy -force tfs3 tfd3
     file copy -force tfs4 tfd4
-    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4] 
-} {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
-test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod} {
+    list [lsort [glob tf*]] $msg [file writable tfd1] [file writable tfd2] [file writable tfd3] [file writable tfd4]
+} -result {{tf1 tf2 tfd1 tfd2 tfd3 tfd4 tfs1 tfs2 tfs3 tfs4} {1 {error copying "tf1" to "tf2": file already exists}} 1 1 0 0}
+test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup {
     cleanup
+} -constraints {notRoot testchmod} -body {
     file mkdir td1
     file mkdir [file join td2 td1]
     file mkdir tds1
@@ -954,11 +1115,11 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} {notRoot testchmod}
     set a3 [catch {file copy -force tds2 tdd2}]
     set a4 [catch {file copy -force tds3 tdd3}]
     set a5 [catch {file copy -force tds4 tdd4}]
-    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5 
-} [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
-test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
-	{notRoot unixOrPc testchmod} {
+    list [lsort [glob td*]] $a1 $a2 $a3 $a4 $a5
+} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
+test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup {
     cleanup
+} -constraints {notRoot unixOrPc testchmod} -body {
     file mkdir tds1
     file mkdir tds2
     file mkdir [file join tdd1 tds1 xxx]
@@ -967,9 +1128,10 @@ test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} \
     set a1 [list [catch {file copy -force tds1 tdd1} msg] $msg]
     set a2 [list [catch {file copy -force tds2 tdd2} msg] $msg]
     list [lsort [glob td*]] $a1 $a2 [file writable tds1] [file writable tds2]
-} [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
-test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot testchmod} {
+} -result [subst {{tdd1 tdd2 tds1 tds2} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} {1 {error copying "tds2" to "[file join tdd2 tds2]": file already exists}} 1 0}]
+test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
     cleanup
+} -constraints {notRoot testchmod} -body {
     createfile tf1
     createfile tf2
     file mkdir td1
@@ -978,10 +1140,10 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} {notRoot t
     file copy tf2 [file join td1 tf4]
     list [lsort [glob tf*]] [lsort [glob -directory td1 t*]] \
     [file writable [file join td1 tf3]] [file writable [file join td1 tf4]]
-} [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} \
-	{notRoot unixOrPc testchmod} {
+} -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 {unix notRoot testchmod} -body {
     file mkdir td1
     file mkdir td2
     file mkdir td3
@@ -990,556 +1152,591 @@ test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} \
     file copy td2 [file join td3 td4]
     list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
     [file writable [file join td3 td3]] [file writable [file join td3 td4]]
-} [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 0}]
-test fCmd-10.9 {file copy: comprehensive: source and target incompatible} \
-	{notRoot} {
+} -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 {win notRoot testchmod} -body {
+    # On Windows with ACLs, copying a directory is defined like this
+    file mkdir td1
+    file mkdir td2
+    file mkdir td3
+    testchmod 555 td2
+    file copy td1 [file join td3 td3]
+    file copy td2 [file join td3 td4]
+    list [lsort [glob td*]] [lsort [glob -directory td3 t*]] \
+    [file writable [file join td3 td3]] [file writable [file join td3 td4]]
+} -result [subst {{td1 td2 td3} {[file join td3 td3] [file join td3 td4]} 1 1}]
+test fCmd-10.9 {file copy: comprehensive: source and target incompatible} -setup {
+    cleanup
+} -constraints {notRoot} -returnCodes error -body {
     file mkdir td1
     createfile tf1
-    list [catch {file copy -force td1 tf1} msg] $msg
-} {1 {can't overwrite file "tf1" with directory "td1"}}
-test fCmd-10.10 {file copy: comprehensive: source and target incompatible} \
-	{notRoot} {
+    file copy -force td1 tf1
+} -result {can't overwrite file "tf1" with directory "td1"}
+test fCmd-10.10 {file copy: comprehensive: source and target incompatible} -setup {
     cleanup
+} -constraints {notRoot} -returnCodes error -body {
     file mkdir [file join td1 tf1]
     createfile tf1
-    list [catch {file copy -force tf1 td1} msg] $msg
-} [subst {1 {can't overwrite directory "[file join td1 tf1]" with file "tf1"}}]
-test fCmd-10.11 {file copy: copy to empty file name} {
+    file copy -force tf1 td1
+} -result [subst {can't overwrite directory "[file join td1 tf1]" with file "tf1"}]
+test fCmd-10.11 {file copy: copy to empty file name} -setup {
     cleanup
+} -returnCodes error -body {
     createfile tf1
-    list [catch {file copy tf1 ""} msg] $msg
-} {1 {error copying "tf1" to "": no such file or directory}}
-test fCmd-10.12 {file rename: rename to empty file name} {
+    file copy tf1 ""
+} -result {error copying "tf1" to "": no such file or directory}
+test fCmd-10.12 {file rename: rename to empty file name} -setup {
     cleanup
+} -returnCodes error -body {
     createfile tf1
-    list [catch {file rename tf1 ""} msg] $msg
-} {1 {error renaming "tf1" to "": no such file or directory}}
-cleanup    
+    file rename tf1 ""
+} -result {error renaming "tf1" to "": no such file or directory}
+cleanup
 
-# old tests    
+# old tests
 
-test fCmd-11.1 {TclFileRenameCmd: -- option } {notRoot} {
+test fCmd-11.1 {TclFileRenameCmd: -- option} -constraints notRoot -setup {
     catch {file delete -force -- -tfa1}
+} -body {
     set s [createfile -tfa1]
     file rename -- -tfa1 tfa2
-    set result [expr [checkcontent tfa2 $s] && ![file exists -tfa1]]
+    list [checkcontent tfa2 $s] [file exists -tfa1]
+} -cleanup {
     file delete tfa2
-    set result
-} {1}
-test fCmd-11.2 {TclFileRenameCmd: bad option } {notRoot} {
+} -result {1 0}
+test fCmd-11.2 {TclFileRenameCmd: bad option} -constraints notRoot -setup {
     catch {file delete -force -- tfa1}
+} -body {
     set s [createfile tfa1]
-    set r1 [catch {file rename -x tfa1 tfa2}]
-    set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
+    list [catch {file rename -x tfa1 tfa2}] \
+	[checkcontent tfa1 $s] [file exists tfa2]
+} -cleanup {
     file delete tfa1
-    set result
-} {1}
-test fCmd-11.3 {TclFileRenameCmd: bad \# args} {
-    catch {file rename -- }
-} {1}
-test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} {notRoot} {
-     global env
-     set temp $env(HOME)
-     unset env(HOME)
-     set result [catch {file rename tfa ~/foobar }]
-     set env(HOME) $temp
-     set result
- } {1}
-test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} {notRoot} {
+} -result {1 1 0}
+test fCmd-11.3 {TclFileRenameCmd: bad \# args} -returnCodes error -body {
+    file rename --
+} -match glob -result *
+test fCmd-11.4 {TclFileRenameCmd: target filename translation failing} -setup {
+    set temp $::env(HOME)
+} -constraints notRoot -body {
+    global env
+    unset env(HOME)
+    catch { file rename tfa ~/foobar }
+} -cleanup {
+    set ::env(HOME) $temp
+} -result 1
+test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup {
     catch {file delete -force -- tfa1 tfa2 tfa3}
-    createfile tfa1 
-    createfile tfa2 
-    createfile tfa3 
-    set result [catch {file rename tfa1 tfa2 tfa3}]
+} -constraints {notRoot} -body {
+    createfile tfa1
+    createfile tfa2
+    createfile tfa3
+    catch {file rename tfa1 tfa2 tfa3}
+} -cleanup {
     file delete tfa1 tfa2 tfa3
-    set result
-} {1}
-test fCmd-11.6 {TclFileRenameCmd: : single file into directory} {notRoot} {
+} -result {1}
+test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup {
     catch {file delete -force -- tfa1 tfad}
+} -constraints {notRoot} -body {
     set s [createfile tfa1]
     file mkdir tfad
     file rename tfa1 tfad
-    set result [expr [checkcontent tfad/tfa1 $s] && ![file exists tfa1]]
+    list [checkcontent tfad/tfa1 $s] [file exists tfa1]
+} -cleanup {
     file delete -force tfad
-    set result
-} {1}
-test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} {notRoot} {
+} -result {1 0}
+test fCmd-11.7 {TclFileRenameCmd: : multiple files into directory} -setup {
     catch {file delete -force -- tfa1 tfa2 tfad}
-    set s1 [createfile tfa1 ]
-    set s2 [createfile tfa2 ]
+} -constraints {notRoot} -body {
+    set s1 [createfile tfa1]
+    set s2 [createfile tfa2]
     file mkdir tfad
     file rename tfa1 tfa2 tfad
-    set r1 [checkcontent tfad/tfa1 $s1]
-    set r2 [checkcontent tfad/tfa2 $s2]
-    
-    set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfa2]]
-
+    list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
+	[file exists tfa1] [file exists tfa2]
+} -cleanup {
     file delete -force tfad
-    set result
-} {1}
-test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} {notRoot} {
+} -result {1 1 0 0}
+test fCmd-11.8 {TclFileRenameCmd: error renaming file to directory} -setup {
     catch {file delete -force -- tfa tfad}
-    set s [createfile tfa ]
+} -constraints {notRoot} -body {
+    set s [createfile tfa]
     file mkdir tfad
     file mkdir tfad/tfa
-    set r1 [catch {file rename tfa tfad}]
-    set r2 [checkcontent tfa $s]
-    set r3 [file isdir tfad]
-    set result [expr $r1 && $r2 && $r3 ]
+    list [catch {file rename tfa tfad}] [checkcontent tfa $s] [file isdir tfad]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
+} -result {1 1 1}
 
 #
 # Coverage tests for renamefile() ;
 #
-test fCmd-12.1 {renamefile: source filename translation failing} {notRoot} {
+test fCmd-12.1 {renamefile: source filename translation failing} -setup {
+    set temp $::env(HOME)
+} -constraints {notRoot} -body {
     global env
-    set temp $env(HOME)
     unset env(HOME)
-    set result [catch {file rename ~/tfa1 tfa2}]
-    set env(HOME) $temp
-    set result
-} {1}
-test fCmd-12.2 {renamefile: src filename translation failing} {notRoot} {
+    catch {file rename ~/tfa1 tfa2}
+} -cleanup {
+    set ::env(HOME) $temp
+} -result {1}
+test fCmd-12.2 {renamefile: src filename translation failing} -setup {
+    set temp $::env(HOME)
+} -constraints {notRoot} -body {
     global env
-    set temp $env(HOME)
     unset env(HOME)
     set s [createfile tfa1]
     file mkdir tfad
-    set result [catch {file rename tfa1 ~/tfa2 tfad}]
-    set env(HOME) $temp
+    catch {file rename tfa1 ~/tfa2 tfad}
+} -cleanup {
+    set ::env(HOME) $temp
     file delete -force tfad
-    set result
-} {1}
-test fCmd-12.3 {renamefile: stat failing on source} {notRoot} {
+} -result {1}
+test fCmd-12.3 {renamefile: stat failing on source} -setup {
     catch {file delete -force -- tfa1 tfa2}
-    set r1 [catch {file rename tfa1 tfa2}]
-    expr {$r1 && ![file exists tfa1] && ![file exists tfa2]}
-} {1}
-test fCmd-12.4 {renamefile: error renaming file to directory} {notRoot} {
+} -constraints {notRoot} -body {
+    list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
+} -result {1 0 0}
+test fCmd-12.4 {renamefile: error renaming file to directory} -setup {
     catch {file delete -force -- tfa tfad}
-    set s1 [createfile tfa ]
+} -constraints {notRoot} -body {
+    set s1 [createfile tfa]
     file mkdir tfad
     file mkdir tfad/tfa
-    set r1 [catch {file rename tfa tfad}]
-    set r2 [checkcontent tfa $s1]
-    set r3 [file isdir tfad/tfa]
-    set result [expr $r1 && $r2 && $r3]
+    list [catch {file rename tfa tfad}] [checkcontent tfa $s1] \
+	[file isdir tfad/tfa]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
-test fCmd-12.5 {renamefile: error renaming directory to file} {notRoot} {
+} -result {1 1 1}
+test fCmd-12.5 {renamefile: error renaming directory to file} -setup {
     catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
     file mkdir tfa
     file mkdir tfad
     set s [createfile tfad/tfa]
-    set r1 [catch {file rename tfa tfad}]
-    set r2 [checkcontent tfad/tfa $s]
-    set r3 [file isdir tfad]
-    set r4 [file isdir tfa]
-    set result [expr $r1 && $r2 && $r3 && $r4 ]
+    list [catch {file rename tfa tfad}] [checkcontent tfad/tfa $s] \
+	[file isdir tfad] [file isdir tfa]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
-test fCmd-12.6 {renamefile: TclRenameFile succeeding} {notRoot} {
+} -result {1 1 1 1}
+test fCmd-12.6 {renamefile: TclRenameFile succeeding} -setup {
     catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
     set s [createfile tfa1]
     file rename tfa1 tfa2
-    set result [expr [checkcontent tfa2 $s] && ![file exists tfa1]]
+    list [checkcontent tfa2 $s] [file exists tfa1]
+} -cleanup {
     file delete tfa2
-    set result
-} {1}
-test fCmd-12.7 {renamefile: renaming directory into offspring} {notRoot} {
+} -result {1 0}
+test fCmd-12.7 {renamefile: renaming directory into offspring} -setup {
     catch {file delete -force -- tfad}
+} -constraints {notRoot} -body {
     file mkdir tfad
     file mkdir tfad/dir
-    set result [catch {file rename tfad tfad/dir}]
-    file delete -force tfad 
-    set result
-} {1}
-test fCmd-12.8 {renamefile: generic error} {unix notRoot} {
+    catch {file rename tfad tfad/dir}
+} -cleanup {
+    file delete -force tfad
+} -result {1}
+test fCmd-12.8 {renamefile: generic error} -setup {
     catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
     file mkdir tfa
     file mkdir tfa/dir
     file attributes tfa -permissions 0555
-    set result [catch {file rename tfa/dir tfa2}]
-    file attributes tfa -permissions 0777
+    catch {file rename tfa/dir tfa2}
+} -cleanup {
+    catch {file attributes tfa -permissions 0777}
     file delete -force tfa
-    set result
-} {1}
-test fCmd-12.9 {renamefile: moving a file across volumes} {unix notRoot} {
-    catch {file delete -force -- tfa /tmp/tfa}
-    set s [createfile tfa ]
-    file rename tfa /tmp
-    set result [expr [checkcontent /tmp/tfa $s] && ![file exists tfa]]
-    file delete /tmp/tfa
-    set result
-} {1}
-test fCmd-12.10 {renamefile: moving a directory across volumes } \
-	{unix notRoot} {
-    catch {file delete -force -- tfad /tmp/tfad}
+} -result {1}
+test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
+    cleanup $tmpspace
+} -constraints {unix notRoot} -body {
+    set s [createfile tfa]
+    file rename tfa $tmpspace
+    list [checkcontent [file join $tmpspace tfa] $s] [file exists tfa]
+} -cleanup {
+    cleanup $tmpspace
+} -result {1 0}
+test fCmd-12.10 {renamefile: moving a directory across volumes} -setup {
+    cleanup $tmpspace
+} -constraints {xdev notRoot} -body {
     file mkdir tfad
-    set s [createfile tfad/a ]
-    file rename tfad /tmp
-    set restul [expr [checkcontent /tmp/tfad/a $s] && ![file exists tfad]]
-    file delete -force /tmp/tfad
-    set result
-} {1}
+    set s [createfile tfad/a]
+    file rename tfad $tmpspace
+    list [checkcontent [file join $tmpspace tfad a] $s] [file exists tfad]
+} -cleanup {
+    cleanup $tmpspace
+} -result {1 0}
 
 #
 # Coverage tests for TclCopyFilesCmd()
 #
-test fCmd-13.1 {TclCopyFilesCmd: -force option} {notRoot} {
+test fCmd-13.1 {TclCopyFilesCmd: -force option} -constraints notRoot -setup {
     catch {file delete -force -- tfa1}
+} -body {
     set s [createfile tfa1]
     file copy -force  tfa1 tfa2
-    set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
+    list [checkcontent tfa2 $s] [checkcontent tfa1 $s]
+} -cleanup {
     file delete tfa1 tfa2
-    set result
-} {1}
-test fCmd-13.2 {TclCopyFilesCmd: -- option} {notRoot} {
+} -result {1 1}
+test fCmd-13.2 {TclCopyFilesCmd: -- option} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa1}
+} -body {
     set s [createfile -tfa1]
     file copy --  -tfa1 tfa2
-    set result [expr [checkcontent tfa2 $s] &&  [checkcontent -tfa1 $s]]
+    list [checkcontent tfa2 $s] [checkcontent -tfa1 $s]
+} -cleanup {
     file delete -- -tfa1 tfa2
-    set result
-} {1}
-test fCmd-13.3 {TclCopyFilesCmd: bad option} {notRoot} {
+} -result {1 1}
+test fCmd-13.3 {TclCopyFilesCmd: bad option} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa1}
+} -body {
     set s [createfile tfa1]
-    set r1 [catch {file copy -x tfa1 tfa2}]
-    set result [expr $r1 && [checkcontent tfa1 $s] && ![file exists tfa2]]
+    list [catch {file copy -x tfa1 tfa2}] \
+	[checkcontent tfa1 $s] [file exists tfa2]
+} -cleanup {
     file delete tfa1
-    set result
-} {1}
-test fCmd-13.4 {TclCopyFilesCmd: bad \# args} {notRoot} {
-    catch {file copy -- }
-} {1}
-test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} {
-     global env
-     set temp $env(HOME)
+} -result {1 1 0}
+test fCmd-13.4 {TclCopyFilesCmd: bad \# args} -constraints {notRoot} -body {
+    file copy --
+} -returnCodes error -match glob -result *
+test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup {
+    set temp $::env(HOME)
+} -body {
+    global env
     unset env(HOME)
-     set result [catch {file copy tfa ~/foobar }]
-     set env(HOME) $temp
-     set result
- } {1}
-test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} {notRoot} {
+    catch { file copy tfa ~/foobar }
+} -cleanup {
+    set ::env(HOME) $temp
+} -result {1}
+test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
     catch {file delete -force -- tfa1 tfa2 tfa3}
-    createfile tfa1 
-    createfile tfa2 
-    createfile tfa3 
-    set result [catch {file copy tfa1 tfa2 tfa3}]
+} -constraints {notRoot} -body {
+    createfile tfa1
+    createfile tfa2
+    createfile tfa3
+    catch {file copy tfa1 tfa2 tfa3}
+} -cleanup {
     file delete tfa1 tfa2 tfa3
-    set result
-} {1}
-test fCmd-13.7 {TclCopyFilesCmd: single file into directory} {notRoot} {
+} -result {1}
+test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup {
     catch {file delete -force -- tfa1 tfad}
+} -constraints {notRoot} -body {
     set s [createfile tfa1]
     file mkdir tfad
     file copy tfa1 tfad
-    set result [expr [checkcontent tfad/tfa1 $s] &&  [checkcontent tfa1 $s]]
+    list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s]
+} -cleanup {
     file delete -force tfad tfa1
-    set result
-} {1}
-test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} {notRoot} {
+} -result {1 1}
+test fCmd-13.8 {TclCopyFilesCmd: multiple files into directory} -setup {
     catch {file delete -force -- tfa1 tfa2 tfad}
-    set s1 [createfile tfa1 ]
-    set s2 [createfile tfa2 ]
+} -constraints {notRoot} -body {
+    set s1 [createfile tfa1]
+    set s2 [createfile tfa2]
     file mkdir tfad
     file copy tfa1 tfa2 tfad
-    set r1 [checkcontent tfad/tfa1 $s1]
-    set r2 [checkcontent tfad/tfa2 $s2]
-    set r3 [checkcontent tfa1 $s1]
-    set r4 [checkcontent tfa2 $s2]
-    set result [expr $r1 && $r2 && $r3 && $r4 ]
-
+    list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
+	[checkcontent tfa1 $s1] [checkcontent tfa2 $s2]
+} -cleanup {
     file delete -force tfad tfa1 tfa2
-    set result
-} {1}
-test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} {notRoot} {
+} -result {1 1 1 1}
+test fCmd-13.9 {TclCopyFilesCmd: error copying file to directory} -setup {
     catch {file delete -force -- tfa tfad}
-    set s [createfile tfa ]
+} -constraints {notRoot} -body {
+    set s [createfile tfa]
     file mkdir tfad
     file mkdir tfad/tfa
-    set r1 [catch {file copy tfa tfad}]
-    set r2 [expr [checkcontent tfa $s] && [file isdir tfad/tfa]]
-    set r3 [file isdir tfad]
-    set result [expr $r1 && $r2 && $r3 ]
+    list [catch {file copy tfa tfad}] [checkcontent tfa $s] \
+	[file isdir tfad/tfa] [file isdir tfad]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
+} -result {1 1 1 1}
 
 #
 # Coverage tests for copyfile()
-# 
-test fCmd-14.1 {copyfile: source filename translation failing} {notRoot} {
+#
+test fCmd-14.1 {copyfile: source filename translation failing} -setup {
+    set temp $::env(HOME)
+} -constraints {notRoot} -body {
     global env
-    set temp $env(HOME)
     unset env(HOME)
-    set result [catch {file copy ~/tfa1 tfa2}]
-    set env(HOME) $temp
-    set result
-} {1}
-test fCmd-14.2 {copyfile: dst filename translation failing} {notRoot} {
+    catch {file copy ~/tfa1 tfa2}
+} -cleanup {
+    set ::env(HOME) $temp
+} -result {1}
+test fCmd-14.2 {copyfile: dst filename translation failing} -setup {
+    set temp $::env(HOME)
+} -constraints {notRoot} -body {
     global env
-    set temp $env(HOME)
     unset env(HOME)
     set s [createfile tfa1]
     file mkdir tfad
-    set r1 [catch {file copy tfa1 ~/tfa2 tfad}]
-    set result [expr $r1 && [checkcontent tfad/tfa1 $s]]
-    set env(HOME) $temp
+    list [catch {file copy tfa1 ~/tfa2 tfad}] [checkcontent tfad/tfa1 $s]
+} -cleanup {
+    set ::env(HOME) $temp
     file delete -force tfa1 tfad
-    set result
-} {1}
-test fCmd-14.3 {copyfile: stat failing on source} {notRoot} {
+} -result {1 1}
+test fCmd-14.3 {copyfile: stat failing on source} -setup {
     catch {file delete -force -- tfa1 tfa2}
-    set r1 [catch {file copy tfa1 tfa2}]
-    expr $r1 && ![file exists tfa1] && ![file exists tfa2]
-} {1}
-test fCmd-14.4 {copyfile: error copying file to directory} {notRoot} {
+} -constraints notRoot -body {
+    list [catch {file copy tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
+} -result {1 0 0}
+test fCmd-14.4 {copyfile: error copying file to directory} -setup {
     catch {file delete -force -- tfa tfad}
-    set s1 [createfile tfa ]
+} -constraints {notRoot} -body {
+    set s1 [createfile tfa]
     file mkdir tfad
     file mkdir tfad/tfa
-    set r1 [catch {file copy tfa tfad}]
-    set r2 [checkcontent tfa $s1]
-    set r3 [file isdir tfad]
-    set r4 [file isdir tfad/tfa]
-    set result [expr $r1 && $r2 && $r3 && $r4 ]
+    list [catch {file copy tfa tfad}] [checkcontent tfa $s1] \
+	[file isdir tfad] [file isdir tfad/tfa]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
-test fCmd-14.5 {copyfile: error copying directory to file} {notRoot} {
-     catch {file delete -force -- tfa tfad}
-     file mkdir tfa
-     file mkdir tfad
-     set s [createfile tfad/tfa]
-     set r1 [catch {file copy tfa tfad}]
-     set r2 [checkcontent tfad/tfa $s]
-     set r3 [file isdir tfad]
-     set r4 [file isdir tfa]
-     set result [expr $r1 && $r2 && $r3 && $r4 ]
+} -result {1 1 1 1}
+test fCmd-14.5 {copyfile: error copying directory to file} -setup {
+    catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
+    file mkdir tfa
+    file mkdir tfad
+    set s [createfile tfad/tfa]
+    list [catch {file copy tfa tfad}] [checkcontent tfad/tfa $s] \
+	[file isdir tfad] [file isdir tfa]
+} -cleanup {
      file delete -force tfa tfad
-     set result
-} {1}
-test fCmd-14.6 {copyfile: copy file succeeding} {notRoot} {
+} -result {1 1 1 1}
+test fCmd-14.6 {copyfile: copy file succeeding} -constraints notRoot -setup {
     catch {file delete -force -- tfa tfa2}
+} -body {
     set s [createfile tfa]
     file copy tfa tfa2
-    set result [expr  [checkcontent tfa $s] && [checkcontent tfa2 $s]]
+    list [checkcontent tfa $s] [checkcontent tfa2 $s]
+} -cleanup {
     file delete tfa tfa2
-    set result
-} {1}
-test fCmd-14.7 {copyfile: copy directory succeeding} {notRoot} {
+} -result {1 1}
+test fCmd-14.7 {copyfile: copy directory succeeding} -setup {
     catch {file delete -force -- tfa tfa2}
+} -constraints {notRoot} -body {
     file mkdir tfa
     set s [createfile tfa/file]
     file copy tfa tfa2
-    set result [expr [checkcontent tfa/file $s] && [checkcontent tfa2/file $s]]
+    list [checkcontent tfa/file $s] [checkcontent tfa2/file $s]
+} -cleanup {
     file delete -force tfa tfa2
-    set result
-} {1}
-test fCmd-14.8 {copyfile: copy directory failing} {unix notRoot} {
+} -result {1 1}
+test fCmd-14.8 {copyfile: copy directory failing} -setup {
     catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
     file mkdir tfa/dir/a/b/c
     file attributes tfa/dir -permissions 0000
-    set r1 [catch {file copy tfa tfa2}]
+    catch {file copy tfa tfa2}
+} -cleanup {
     file attributes tfa/dir -permissions 0777
-    set result $r1
     file delete -force tfa tfa2
-    set result
-} {1}
+} -result {1}
 
 #
 # Coverage tests for TclMkdirCmd()
 #
-test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} {notRoot} {
+test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {
+    set temp $::env(HOME)
+} -constraints {notRoot} -body {
     global env
-    set temp $env(HOME)
-    unset env(HOME) 
-    set result [catch {file mkdir ~/tfa}]
-    set env(HOME) $temp
-    set result
-} {1}
+    unset env(HOME)
+    catch {file mkdir ~/tfa}
+} -cleanup {
+    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 } {notRoot} {
+test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup {
     catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
     file mkdir tfa
-    set result [file isdirectory tfa]
+    file isdirectory tfa
+} -cleanup {
     file delete tfa
-    set result
-} {1}
-test fCmd-15.3 {TclMakeDirsCmd: - two directories} {notRoot} {
+} -result {1}
+test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup {
     catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
     file mkdir tfa1 tfa2
-    set result [expr [file isdirectory tfa1] && [file isdirectory tfa2]]
+    list [file isdirectory tfa1] [file isdirectory tfa2]
+} -cleanup {
     file delete tfa1 tfa2
-    set result
-} {1}
-test fCmd-15.4 {TclMakeDirsCmd - stat failing} {unix notRoot} {
+} -result {1 1}
+test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup {
     catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
     file mkdir tfa
     createfile tfa/file
     file attributes tfa -permissions 0000
-    set result [catch {file mkdir tfa/file}]
+    catch {file mkdir tfa/file}
+} -cleanup {
     file attributes tfa -permissions 0777
     file delete -force tfa
-    set result
-} {1}
-test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} \
-	{notRoot} {
+} -result {1}
+test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup {
     catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
     file mkdir tfa/a/b/c
-    set result [file isdir tfa/a/b/c]
+    file isdir tfa/a/b/c
+} -cleanup {
     file delete -force tfa
-    set result
-} {1}
-test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} {notRoot} {
+} -result {1}
+test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup {
     catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
     set s [createfile tfa]
-    set r1 [catch {file mkdir tfa}]
-    set r2 [file isdir tfa]
-    set r3 [file exists tfa]
-    set result [expr $r1 && !$r2 && $r3 && [checkcontent tfa $s]]
+    list [catch {file mkdir tfa}] [file isdir tfa] [file exists tfa] \
+	[checkcontent tfa $s]
+} -cleanup {
     file delete tfa
-    set result
-} {1}
-test fCmd-15.7 {TclMakeDirsCmd - making several directories} {notRoot} {
+} -result {1 0 1 1}
+test fCmd-15.7 {TclMakeDirsCmd - making several directories} -setup {
     catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
     file mkdir tfa1 tfa2/a/b/c
-    set result [expr [file isdir tfa1] && [file isdir tfa2/a/b/c]]
+    list [file isdir tfa1] [file isdir tfa2/a/b/c]
+} -cleanup {
     file delete -force tfa1 tfa2
-    set result
-} {1}
-test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} {notRoot} {
+} -result {1 1}
+test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body {
     file mkdir tfa
     file mkdir tfa
-    set result [file isdir tfa]
+    file isdir tfa
+} -constraints {notRoot} -cleanup {
     file delete tfa
-    set result
-} {1}
+} -result {1}
 
 # Coverage tests for TclDeleteFilesCommand()
-test fCmd-16.1 {test the -- argument} {notRoot} {
+test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa}
+} -body {
     createfile tfa
     file delete -- tfa
     file exists tfa
-} {0}
-test fCmd-16.2 {test the -force and -- arguments} {notRoot} {
+} -result 0
+test fCmd-16.2 {test the -force and -- arguments} -constraints notRoot -setup {
     catch {file delete -force -- tfa}
+} -body {
     createfile tfa
     file delete -force -- tfa
     file exists tfa
-} {0}
-test fCmd-16.3 {test bad option} {notRoot} {
+} -result 0
+test fCmd-16.3 {test bad option} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa}
+} -body {
     createfile tfa
-    set result [catch {file delete -dog tfa}]
+    catch {file delete -dog tfa}
+} -cleanup {
     file delete tfa
-    set result
-} {1}
-test fCmd-16.4 {test not enough args} {notRoot} {
-    catch {file delete}
-} {1}
-test fCmd-16.5 {test not enough args with options} {notRoot} {
-    catch {file delete --}
-} {1}
-test fCmd-16.6 {delete: source filename translation failing} {notRoot} {
+} -result {1}
+test fCmd-16.4 {accept zero files (TIP 323)} -body {
+    file delete
+} -result {}
+test fCmd-16.5 {accept zero files (TIP 323)} -body {
+    file delete --
+} -result {}
+test fCmd-16.6 {delete: source filename translation failing} -setup {
+    set temp $::env(HOME)
+} -constraints {notRoot} -body {
     global env
-    set temp $env(HOME)
     unset env(HOME)
-    set result [catch {file delete ~/tfa}]
-    set env(HOME) $temp
-    set result
-} {1}
-test fCmd-16.7 {remove a non-empty directory without -force } {notRoot} {
+    catch {file delete ~/tfa}
+} -cleanup {
+    set ::env(HOME) $temp
+} -result {1}
+test fCmd-16.7 {remove a non-empty directory without -force} -setup {
     catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
     file mkdir tfa
     createfile tfa/a
-    set result [catch  {file delete tfa }]
+    catch {file delete tfa}
+} -cleanup {
     file delete -force tfa
-    set result
-} {1}
-test fCmd-16.8 {remove a normal file } {notRoot} {
+} -result {1}
+test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa}
+} -body {
     file mkdir tfa
     createfile tfa/a
-    set result [catch  {file delete tfa }]
+    catch {file delete tfa}
+} -cleanup {
     file delete -force tfa
-    set result
-} {1}
-test fCmd-16.9 {error while deleting file } {unix notRoot} {
+} -result {1}
+test fCmd-16.9 {error while deleting file} -setup {
     catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
     file mkdir tfa
     createfile tfa/a
     file attributes tfa -permissions 0555
-    set result [catch  {file delete tfa/a }]
+    catch {file delete tfa/a}
     #######
-    #######  If any directory in a tree that is being removed does not 
-    #######  have write permission, the process will fail!
-    #######  This is also the case with "rm -rf"
+    #######  If any directory in a tree that is being removed does not have
+    #######  write permission, the process will fail! This is also the case
+    #######  with "rm -rf"
     #######
+} -cleanup {
     file attributes tfa -permissions 0777
     file delete -force tfa
-    set result
-} {1}
-test fCmd-16.10 {deleting multiple files} {notRoot} {
+} -result {1}
+test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa1 tfa2}
+} -body {
     createfile tfa1
     createfile tfa2
     file delete tfa1 tfa2
-    expr ![file exists tfa1] && ![file exists tfa2]
-} {1}
-test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} {notRoot} {
+    list [file exists tfa1] [file exists tfa2]
+} -result {0 0}
+test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup {
     catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
     file delete tfa
-    set result 1
-} {1}
+} -result {}
 
 # More coverage tests for mkpath()
-test fCmd-17.1 {mkdir stat failing on target but not ENOENT} {unix notRoot} {
+test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup {
      catch {file delete -force -- tfa1}
+} -constraints {unix notRoot} -body {
      file mkdir tfa1
      file attributes tfa1 -permissions 0555
-     set result [catch {file mkdir tfa1/tfa2}]
+     catch {file mkdir tfa1/tfa2}
+} -cleanup {
      file attributes tfa1 -permissions 0777
      file delete -force tfa1
-     set result
-} {1}
-test fCmd-17.2 {mkdir several levels deep - relative } {notRoot} {
+} -result {1}
+test fCmd-17.2 {mkdir several levels deep - relative} -setup {
     catch {file delete -force -- tfa}
+} -constraints {notRoot} -body {
     file mkdir tfa/a/b
-    set result [file isdir tfa/a/b ]
+    file isdir tfa/a/b
+} -cleanup {
     file delete tfa/a/b tfa/a tfa
-    set result
-} {1}
-test fCmd-17.3 {mkdir several levels deep - absolute } {notRoot} {
+} -result 1
+test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
     catch {file delete -force -- tfa}
-    set f [file join [pwd] tfa a ]
+} -constraints {notRoot} -body {
+    set f [file join [pwd] tfa a]
     file mkdir $f
-    set result [file isdir $f ]
+    file isdir $f
+} -cleanup {
     file delete $f [file join [pwd] tfa]
-    set result
-} {1}
+} -result {1}
 
 #
 # Functionality tests for TclFileRenameCmd()
 #
-
 test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
-	{notRoot} {
+	-setup {
     catch {file delete -force -- tfad}
+    set savedDir [pwd]
+} -constraints {notRoot} -body {
     file mkdir tfad/dir
     cd tfad/dir
-    set s [createfile foo ]
+    set s [createfile foo]
     file rename  foo bar
     file rename bar ./foo
     file rename ./foo bar
@@ -1549,73 +1746,70 @@ test fCmd-18.1 {TclFileRenameCmd: rename (first form) in the same directory} \
     file rename ../../tfad/dir/foo ../../tfad/dir/bar
     file rename [file join [pwd] bar] foo
     file rename foo [file join [pwd] bar]
-    set result [expr [checkcontent bar $s] && ![file exists foo]]
-    cd ../..
+    list [checkcontent bar $s] [file exists foo]
+} -cleanup {
+    cd $savedDir
     file delete -force tfad
-    set result
-} {1}
-test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} {notRoot} {
+} -result {1 0}
+test fCmd-18.2 {TclFileRenameCmd: single dir to nonexistant} -setup {
     catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
     file mkdir tfa1
     file rename tfa1 tfa2
-    set result [expr [file exists tfa2] && ![file exists tfa1]]
+    list [file exists tfa2] [file exists tfa1]
+} -cleanup {
     file delete tfa2
-    set result
-} {1}
-test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} {notRoot} {
+} -result {1 0}
+test fCmd-18.3 {TclFileRenameCmd: mixed dirs and files into directory} -setup {
     catch {file delete -force -- tfa1 tfad1 tfad2}
-    set s [createfile tfa1 ]
+} -constraints {notRoot} -body {
+    set s [createfile tfa1]
     file mkdir tfad1 tfad2
     file rename tfa1 tfad1 tfad2
-    set r1 [checkcontent  tfad2/tfa1 $s]
-    set r2 [file isdir tfad2/tfad1]
-    set result [expr $r1 && $r2 && ![file exists tfa1] && ![file exists tfad1]]
+    list [checkcontent tfad2/tfa1 $s] [file isdir tfad2/tfad1] \
+	[file exists tfa1] [file exists tfad1]
+} -cleanup {
     file delete tfad2/tfa1
     file delete -force tfad2
-    set result
-} {1}
-test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} {notRoot} {
+} -result {1 1 0 0}
+test fCmd-18.4 {TclFileRenameCmd: attempt to replace non-dir with dir} -setup {
     catch {file delete -force -- tfa tfad}
-    set s [createfile tfa ]
+} -constraints {notRoot} -body {
+    set s [createfile tfa]
     file mkdir tfad
-    set r1 [catch {file rename tfad tfa}]
-    set r2 [checkcontent tfa $s]
-    set r3 [file isdir tfad]
-    set result [expr $r1 && $r2 && $r3 ]
+    list [catch {file rename tfad tfa}] [checkcontent tfa $s] [file isdir tfad]
+} -cleanup {
     file delete tfa tfad
-    set result
-} {1}
-test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} {notRoot} {
+} -result {1 1 1}
+test fCmd-18.5 {TclFileRenameCmd: attempt to replace dir with non-dir} -setup {
     catch {file delete -force -- tfa tfad}
-    set s [createfile tfa ]
+} -constraints {notRoot} -body {
+    set s [createfile tfa]
     file mkdir tfad/tfa
-    set r1 [catch {file rename tfa tfad}]
-    set r2 [checkcontent tfa $s]
-    set r3 [file isdir tfad/tfa]
-    set result [expr $r1 && $r2 && $r3 ]
-    file delete -force  tfa tfad
-    set result
-} {1}
+    list [catch {file rename tfa tfad}] [checkcontent tfa $s] \
+	[file isdir tfad/tfa]
+} -cleanup {
+    file delete -force tfa tfad
+} -result {1 1 1}
 #
 # On Windows there is no easy way to determine if two files are the same
 #
-test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} {unix notRoot} {
+test fCmd-18.6 {TclFileRenameCmd: rename a file to itself} -setup {
     catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
     set s [createfile tfa]
-    set r1 [catch {file rename tfa tfa}]
-    set result [expr $r1 && [checkcontent tfa $s]]
+    list [catch {file rename tfa tfa}] [checkcontent tfa $s]
+} -cleanup {
     file delete tfa
-    set result
-} {1}
-test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} \
-	{notRoot} {
+} -result {1 1}
+test fCmd-18.7 {TclFileRenameCmd: rename dir on top of another empty dir w/o -force} -setup {
     catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
     file mkdir tfa tfad/tfa
-    set r1 [catch {file rename tfa tfad}]
-    set result [expr $r1 && [file isdir tfa]]
+    list [catch {file rename tfa tfad}] [file isdir tfa]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
+} -result {1 1}
 test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -force} -setup {
     catch {file delete -force -- tfa tfad}
 } -constraints {notRoot notNetworkFilesystem} -body {
@@ -1625,344 +1819,344 @@ test fCmd-18.8 {TclFileRenameCmd: rename dir on top of another empty dir w/ -for
 } -cleanup {
     file delete -force tfad
 } -result 0
-test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} \
-	{notRoot} {
+test fCmd-18.9 {TclFileRenameCmd: rename dir on top of a non-empty dir w/o -force} -setup {
     catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
     file mkdir tfa tfad/tfa/file
-    set r1 [catch {file rename tfa tfad}]
-    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
+    list [catch {file rename tfa tfad}] [file isdir tfa] \
+	[file isdir tfad/tfa/file]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
-test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} \
-	{notRoot notNetworkFilesystem} {
+} -result {1 1 1}
+test fCmd-18.10 {TclFileRenameCmd: rename dir on top of a non-empty dir w/ -force} -setup {
     catch {file delete -force -- tfa tfad}
+} -constraints {notRoot notNetworkFilesystem} -body {
     file mkdir tfa tfad/tfa/file
-    set r1 [catch {file rename -force tfa tfad}]
-    set result [expr $r1 && [file isdir tfa] && [file isdir tfad/tfa/file]]
+    list [catch {file rename -force tfa tfad}] [file isdir tfa] \
+	[file isdir tfad/tfa/file]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
-test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} {notRoot} {
+} -result {1 1 1}
+test fCmd-18.11 {TclFileRenameCmd: rename a non-existant file} -setup {
     catch {file delete -force -- tfa1}
-    set r1 [catch {file rename tfa1 tfa2}]
-    set result [expr $r1 && ![file exists tfa1] && ![file exists tfa2]]
-} {1}
-test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} \
-	{unix notRoot} {
+} -constraints {notRoot} -body {
+    list [catch {file rename tfa1 tfa2}] [file exists tfa1] [file exists tfa2]
+} -result {1 0 0}
+test fCmd-18.12 {TclFileRenameCmd : rename a symbolic link to file} -setup {
     catch {file delete -force -- tfa1 tfa2 tfa3}
-
+} -constraints {unix notRoot} -body {
     set s [createfile tfa1]
     file link -symbolic tfa2 tfa1
     file rename tfa2 tfa3
-    set t [file type tfa3]
-    set result [expr {$t eq "link"}]
+    file type tfa3
+} -cleanup {
     file delete tfa1 tfa3
-    set result
-} {1}
-test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} \
-	{unix notRoot} {
+} -result link
+test fCmd-18.13 {TclFileRenameCmd : rename a symbolic link to dir} -setup {
     catch {file delete -force -- tfa1 tfa2 tfa3}
-
+} -constraints {unix notRoot} -body {
     file mkdir tfa1
     file link -symbolic tfa2 tfa1
     file rename tfa2 tfa3
-    set t [file type tfa3]
-    set result [expr {$t eq "link"}]
+    file type tfa3
+} -cleanup {
     file delete tfa1 tfa3
-    set result
-} {1}
-test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} \
-	{unix notRoot} {
+} -result link
+test fCmd-18.14 {TclFileRenameCmd : rename a path with sym link} -setup {
     catch {file delete -force -- tfa1 tfa2 tfa3}
-
+} -constraints {unix notRoot} -body {
     file mkdir tfa1/a/b/c/d
     file mkdir tfa2
-    set f [file join [pwd] tfa1/a/b] 
+    set f [file join [pwd] tfa1/a/b]
     set f2 [file join [pwd] {tfa2/b alias}]
     file link -symbolic $f2 $f
     file rename {tfa2/b alias/c} tfa3
-    set r1 [file isdir tfa3]
-    set r2 [file exists tfa1/a/b/c]
-    set result [expr $r1 && !$r2]
+    list [file isdir tfa3] [file exists tfa1/a/b/c]
+} -cleanup {
     file delete -force tfa1 tfa2 tfa3
-    set result
-} {1}
-test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} \
-	{unix notRoot} {
+} -result {1 0}
+test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup {
     catch {file delete -force -- tfa1 tfa2 tfalink}
-
+} -constraints {unix notRoot} -body {
     file mkdir tfa1
     set s [createfile tfa2]
     file link -symbolic tfalink tfa1
-
     file rename tfa2 tfalink
-    set result [checkcontent tfa1/tfa2 $s ]
+    checkcontent tfa1/tfa2 $s
+} -cleanup {
     file delete -force tfa1 tfalink
-    set result
-} {1}
-test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} {unix notRoot} {
+} -result {1}
+test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup {
     catch {file delete -force -- tfa1 tfalink}
-
+} -constraints {unix notRoot} -body {
     file mkdir tfa1
     file link -symbolic tfalink tfa1
-    file delete tfa1 
+    file delete tfa1
     file rename tfalink tfa2
-    set result [expr [string compare [file type tfa2] "link"] == 0]
+    file type tfa2
+} -cleanup {
     file delete tfa2
-    set result
-} {1}
+} -result link
 
 #
 # Coverage tests for TclUnixRmdir
 #
-test fCmd-19.1 {remove empty directory} {notRoot} {
+test fCmd-19.1 {remove empty directory} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa}
+} -body {
     file mkdir tfa
     file delete tfa
     file exists tfa
-} {0}
-test fCmd-19.2 {rmdir error besides EEXIST} {unix notRoot} {
+} -result {0}
+test fCmd-19.2 {rmdir error besides EEXIST} -setup {
     catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
     file mkdir tfa
     file mkdir tfa/a
     file attributes tfa -permissions 0555
-    set result [catch {file delete tfa/a}]
+    catch {file delete tfa/a}
+} -cleanup {
     file attributes tfa -permissions 0777
     file delete -force tfa
-    set result
-} {1}
-test fCmd-19.3 {recursive remove} {notRoot} {
+} -result {1}
+test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa}
+} -body {
     file mkdir tfa
     file mkdir tfa/a
     file delete -force tfa
     file exists tfa
-} {0}
+} -result {0}
 
 #
-# TclUnixDeleteFile and TraversalDelete are covered by tests from the 
+# TclUnixDeleteFile and TraversalDelete are covered by tests from the
 # TclDeleteFilesCmd suite
 #
-#
 
 #
 # Coverage tests for TraverseUnixTree(), called from TclDeleteFilesCmd
 #
-
-test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory } \
-	{unix notRoot} {
+test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup {
     catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
     file mkdir tfa
     file mkdir tfa/a
     file attributes tfa/a -permissions 0000
-    set result [catch {file delete -force tfa}]
+    catch {file delete -force tfa}
+} -cleanup {
     file attributes tfa/a -permissions 0777
     file delete -force tfa
-    set result
-} {1}
-
-test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} \
-	{unix notRoot} {
+} -result {1}
+test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup {
     catch {file delete -force -- tfa}
+} -constraints {unix notRoot} -body {
     file mkdir tfa
-    for {set i 1} {$i <= 200} {incr i} {createfile tfa/testfile_$i}
-    set result [catch {file delete -force tfa} msg]
+    for {set i 1} {$i <= 300} {incr i} {
+	createfile tfa/testfile_$i
+    }
+    file delete -force tfa
+} -cleanup {
     while {[catch {file delete -force tfa}]} {}
-    list $result $msg
-} {0 {}}
+} -result {}
 
 #
 # Feature testing for TclCopyFilesCmd
-# 
-test fCmd-21.1 {copy : single file to nonexistant } {notRoot} {
+#
+test fCmd-21.1 {copy : single file to nonexistant} -setup {
     catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
     set s [createfile tfa1]
     file copy tfa1 tfa2
-    set result [expr [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
+    list [checkcontent tfa2 $s] [checkcontent tfa1 $s]
+} -cleanup {
     file delete tfa1 tfa2
-    set result
-} {1}
-test fCmd-21.2 {copy : single dir to nonexistant } {notRoot} {
+} -result {1 1}
+test fCmd-21.2 {copy : single dir to nonexistant} -setup {
     catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
     file mkdir tfa1
     file copy tfa1 tfa2
-    set result [expr [file isdir tfa2] && [file isdir tfa1]]
+    list [file isdir tfa2] [file isdir tfa1]
+} -cleanup {
     file delete tfa1 tfa2
-    set result
-} {1}
-test fCmd-21.3 {copy : single file into directory  } {notRoot} {
+} -result {1 1}
+test fCmd-21.3 {copy : single file into directory} -setup {
     catch {file delete -force -- tfa1 tfad}
+} -constraints {notRoot} -body {
     set s [createfile tfa1]
     file mkdir tfad
     file copy tfa1 tfad
-    set result [expr [checkcontent tfad/tfa1 $s] && [checkcontent tfa1 $s]]
+    list [checkcontent tfad/tfa1 $s] [checkcontent tfa1 $s]
+} -cleanup {
     file delete -force tfa1 tfad
-    set result
-} {1}
-test fCmd-21.4 {copy : more than one source and target is not a directory} \
-	{notRoot} {
+} -result {1 1}
+test fCmd-21.4 {copy : more than one source and target is not a directory} -setup {
     catch {file delete -force -- tfa1 tfa2 tfa3}
-    createfile tfa1 
-    createfile tfa2 
-    createfile tfa3 
-    set result [catch {file copy tfa1 tfa2 tfa3}]
+} -constraints {notRoot} -body {
+    createfile tfa1
+    createfile tfa2
+    createfile tfa3
+    catch {file copy tfa1 tfa2 tfa3}
+} -cleanup {
     file delete tfa1 tfa2 tfa3
-    set result
-} {1}
-test fCmd-21.5 {copy : multiple files into directory  } {notRoot} {
+} -result {1}
+test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup {
     catch {file delete -force -- tfa1 tfa2 tfad}
-    set s1 [createfile tfa1 ]
-    set s2 [createfile tfa2 ]
+} -body {
+    set s1 [createfile tfa1]
+    set s2 [createfile tfa2]
     file mkdir tfad
     file copy tfa1 tfa2 tfad
-    set r1 [checkcontent tfad/tfa1 $s1]
-    set r2 [checkcontent tfad/tfa2 $s2]
-    set r3 [checkcontent tfa1 $s1]
-    set r4 [checkcontent tfa2 $s2]
-    set result [expr $r1 && $r2 && $r3 && $r4]
+    list [checkcontent tfad/tfa1 $s1] [checkcontent tfad/tfa2 $s2] \
+	[checkcontent tfa1 $s1] [checkcontent tfa2 $s2]
+} -cleanup {
     file delete -force tfa1 tfa2 tfad
-    set result
-} {1}
-test fCmd-21.6 {copy: mixed dirs and files into directory} \
-	{notRoot notFileSharing} {
+} -result {1 1 1 1}
+test fCmd-21.6 {copy: mixed dirs and files into directory} -setup {
     catch {file delete -force -- tfa1 tfad1 tfad2}
-    set s [createfile tfa1 ]
+} -constraints {notRoot notFileSharing} -body {
+    set s [createfile tfa1]
     file mkdir tfad1 tfad2
     file copy tfa1 tfad1 tfad2
-    set r1 [checkcontent [file join tfad2 tfa1] $s]
-    set r2 [file isdir [file join tfad2 tfad1]]
-    set r3 [checkcontent tfa1 $s]
-    set result [expr $r1 && $r2 && $r3 && [file isdir tfad1]]
+    list [checkcontent [file join tfad2 tfa1] $s] \
+	[file isdir [file join tfad2 tfad1]] \
+	[checkcontent tfa1 $s] [file isdir tfad1]
+} -cleanup {
     file delete -force tfa1 tfad1 tfad2
-    set result
-} {1}
-test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} {unix notRoot dontCopyLinks} {
+} -result {1 1 1 1}
+test fCmd-21.7.1 {TclCopyFilesCmd: copy a dangling link} -setup {
+    catch {file delete -force tfad1 tfalink tfalink2}
+} -constraints {unix notRoot dontCopyLinks} -body {
     file mkdir tfad1
     file link -symbolic tfalink tfad1
     file delete tfad1
-    set result [list [catch {file copy tfalink tfalink2} msg] $msg]
-    file delete -force tfalink tfalink2 
-    set result
-} {1 {error copying "tfalink": the target of this link doesn't exist}}
-test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} {unix notRoot} {
+    file copy tfalink tfalink2
+} -returnCodes error -cleanup {
+    file delete -force tfalink tfalink2
+} -result {error copying "tfalink": the target of this link doesn't exist}
+test fCmd-21.7.2 {TclCopyFilesCmd: copy a dangling link} -setup {
+    catch {file delete -force tfad1 tfalink tfalink2}
+} -constraints {unix notRoot} -body {
     file mkdir tfad1
     file link -symbolic tfalink tfad1
     file delete tfad1
     file copy tfalink tfalink2
-    set result [string match [file type tfalink2] link]
-    file delete tfalink tfalink2 
-    set result
-} {1}
-test fCmd-21.8.1 {TclCopyFilesCmd: copy a link } {unix notRoot dontCopyLinks} {
+    file type tfalink2
+} -cleanup {
+    file delete tfalink tfalink2
+} -result link
+test fCmd-21.8.1 {TclCopyFilesCmd: copy a link} -setup {
+    catch {file delete -force tfad1 tfalink tfalink2}
+} -constraints {unix notRoot dontCopyLinks} -body {
     file mkdir tfad1
     file link -symbolic tfalink tfad1
     file copy tfalink tfalink2
-    set r1 [file type tfalink]; # link
-    set r2 [file type tfalink2]; # directory
-    set r3 [file isdir tfad1]; # 1
-    set result [expr {("$r1" == "link") && ("$r2" == "directory") && $r3}]
+    list [file type tfalink] [file type tfalink2] [file isdir tfad1]
+} -cleanup {
     file delete -force tfad1 tfalink tfalink2
-    set result
-} {1}
-test fCmd-21.8.2 {TclCopyFilesCmd: copy a link } {unix notRoot} {
+} -result {link directory 1}
+test fCmd-21.8.2 {TclCopyFilesCmd: copy a link} -setup {
+    catch {file delete -force tfad1 tfalink tfalink2}
+} -constraints {unix notRoot} -body {
     file mkdir tfad1
     file link -symbolic tfalink tfad1
     file copy tfalink tfalink2
-    set r1 [file type tfalink]; # link
-    set r2 [file type tfalink2]; # link
-    set r3 [file isdir tfad1]; # 1
-    set result [expr {("$r1" == "link") && ("$r2" == "link") && $r3}]
+    list [file type tfalink] [file type tfalink2] [file isdir tfad1]
+} -cleanup {
     file delete -force tfad1 tfalink tfalink2
-    set result
-} {1}
-test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} {unix notRoot} {
+} -result {link link 1}
+test fCmd-21.9 {TclCopyFilesCmd: copy dir with a link in it} -setup {
+    catch {file delete -force tfad1 tfad2}
+} -constraints {unix notRoot} -body {
     file mkdir tfad1
     file link -symbolic tfad1/tfalink "[pwd]/tfad1"
     file copy tfad1 tfad2
-    set result [string match [file type tfad2/tfalink] link]
+    file type tfad2/tfalink
+} -cleanup {
     file delete -force tfad1 tfad2
-    set result
-} {1}
-test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} \
-	{notRoot} {
+} -result link
+test fCmd-21.10 {TclFileCopyCmd: copy dir on top of another empty dir w/o -force} -setup {
     catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
     file mkdir tfa [file join tfad tfa]
-    set r1 [catch {file copy tfa tfad}]
-    set result [expr $r1 && [file isdir tfa]]
+    list [catch {file copy tfa tfad}] [file isdir tfa]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
-test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} {notRoot} {
+} -result {1 1}
+test fCmd-21.11 {TclFileCopyCmd: copy dir on top of a dir w/o -force} -setup {
     catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
     file mkdir tfa [file join tfad tfa file]
-    set r1 [catch {file copy tfa tfad}]
-    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
+    list [catch {file copy tfa tfad}] [file isdir tfa] \
+	[file isdir [file join tfad tfa file]]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
-test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} \
-	{notRoot} {
+} -result {1 1 1}
+test fCmd-21.12 {TclFileCopyCmd: copy dir on top of a non-empty dir w/ -force} -setup {
     catch {file delete -force -- tfa tfad}
+} -constraints {notRoot} -body {
     file mkdir tfa [file join tfad tfa file]
-    set r1 [catch {file copy -force tfa tfad}]
-    set result [expr $r1 && [file isdir tfa] && [file isdir [file join tfad tfa file]]]
+    list [catch {file copy -force tfa tfad}] [file isdir tfa] \
+	[file isdir [file join tfad tfa file]]
+} -cleanup {
     file delete -force tfa tfad
-    set result
-} {1}
+} -result {1 1 1}
 
 #
 # Coverage testing for TclpRenameFile
 #
-test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} {notRoot} {
+test fCmd-22.1 {TclpRenameFile: rename and overwrite in a single dir} -setup {
     catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
     set s [createfile tfa1]
     set s2 [createfile tfa2 q]
-
-    set r1 [catch {rename tfa1 tfa2}]
+    set result [catch {file rename tfa1 tfa2}]
     file rename -force tfa1 tfa2
-    set result [expr $r1 && [checkcontent tfa2 $s]]
+    lappend result [checkcontent tfa2 $s]
+} -cleanup {
     file delete [glob tfa1 tfa2]
-    set result
-} {1}
-test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} {unix notRoot} {
+} -result {1 1}
+test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} -setup {
     catch {file delete -force -- tfa1}
-    set s [createfile tfa1]	
+} -constraints {unix notRoot} -body {
+    set s [createfile tfa1]
     file rename -force tfa1 tfa1
-    set result [checkcontent tfa1 $s]
-    file delete tfa1 
-    set result
-} {1}
-test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} {notRoot} {
+    checkcontent tfa1 $s
+} -cleanup {
+    file delete tfa1
+} -result {1}
+test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup {
     catch {file delete -force -- d1 tfad}
+} -constraints {notRoot} -body {
     file mkdir d1 [file join tfad d1]
-    set r1 [catch {file rename d1 tfad}]
-    set result [expr $r1 && [file isdir d1] && [file isdir [file join tfad d1]]]
+    list [catch {file rename d1 tfad}] [file isdir d1] \
+	[file isdir [file join tfad d1]]
+} -cleanup {
     file delete -force d1 tfad
-    set result
-} {1}
-test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} {notRoot} {
+} -result {1 1 1}
+test fCmd-22.4 {TclpRenameFile: rename dir to dir several levels deep} -setup {
     catch {file delete -force -- d1 tfad}
+} -constraints {notRoot} -body {
     file mkdir d1 [file join tfad a b c]
     file rename d1 [file join tfad a b c d1]
-    set result [expr ![file isdir d1] && [file isdir [file join tfad a b c d1]]]
+    list [file isdir d1] [file isdir [file join tfad a b c d1]]
+} -cleanup {
     file delete -force [glob d1 tfad]
-    set result
-} {1}
+} -result {0 1}
 #
 # TclMacCopyFile needs to be redone.
 #
-test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
+test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} -setup {
     catch {file delete -force -- tfa1 tfa2}
+} -constraints {notRoot} -body {
     set s [createfile tfa1]
     set s2 [createfile tfa2 q]
-
-    set r1 [catch {file copy tfa1 tfa2}]
+    set result [catch {file copy tfa1 tfa2}]
     file copy -force tfa1 tfa2
-    set result [expr $r1 && [checkcontent tfa2 $s] && [checkcontent tfa1 $s]]
+    lappend result [checkcontent tfa2 $s] [checkcontent tfa1 $s]
+} -cleanup {
     file delete tfa1 tfa2
-    set result
-} {1}
+} -result {1 1 1}
 
 #
 # TclMacMkdir - basic cases are covered elsewhere.
@@ -1973,241 +2167,252 @@ test fCmd-22.5 {TclMacCopyFile: copy and overwrite in a single dir} {notRoot} {
 # TclMacRmdir
 # Error cases are not covered.
 #
-
-test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} {notRoot} {
+test fCmd-23.1 {TclMacRmdir: trying to remove a nonempty directory} -setup {
     catch {file delete -force -- tfad}
-
+} -constraints {notRoot} -body {
     file mkdir [file join tfad dir]
-
-    set result [catch {file delete tfad}]
-    file delete -force tfad 
-    set result
-} {1}
+    list [catch {file delete tfad}] [file delete -force tfad]
+} -cleanup {
+    catch {file delete -force tfad}
+} -result {1 {}}
 
 #
-# TclMacDeleteFile	
+# TclMacDeleteFile
 # Error cases are not covered.
 #
-test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} {notRoot} {
+test fCmd-24.1 {TclMacDeleteFile: deleting a normal file} -setup {
     catch {file delete -force -- tfa1}
-
+} -constraints {notRoot} -body {
     createfile tfa1
     file delete tfa1
     file exists tfa1
-} {0}
+} -cleanup {
+    catch {file delete -force tfa1}
+} -result {0}
 
 #
 # TclMacCopyDirectory
 # Error cases are not covered.
 #
-test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} {notRoot notFileSharing} {
+test fCmd-25.1 {TclMacCopyDirectory: copying a normal directory} -setup {
     catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {notRoot notFileSharing} -body {
     file mkdir [file join tfad1 a b c]
     file copy tfad1 tfad2
-    set result [expr [file isdir [file join tfad1 a b c]] && [file isdir [file join tfad2 a b c]]]
+    list [file isdir [file join tfad1 a b c]] \
+	[file isdir [file join tfad2 a b c]]
+} -cleanup {
     file delete -force tfad1 tfad2
-    set result
-} {1}
-test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} {notRoot notFileSharing} {
+} -result {1 1}
+test fCmd-25.2 {TclMacCopyDirectory: copying a short path normal directory} -setup {
     catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {notRoot notFileSharing} -body {
     file mkdir tfad1
     file copy tfad1 tfad2
-    set result [expr [file isdir tfad1] && [file isdir tfad2]]
+    list [file isdir tfad1] [file isdir tfad2]
+} -cleanup {
     file delete tfad1 tfad2
-    set result
-} {1}
-test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} {notRoot notFileSharing} {
+} -result {1 1}
+test fCmd-25.3 {TclMacCopyDirectory: copying dirs between different dirs} -setup {
     catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {notRoot notFileSharing} -body {
     file mkdir [file join tfad1 x y z]
     file mkdir [file join tfad2 dir]
     file copy tfad1 [file join tfad2 dir]
-    set result [expr [file isdir [file join tfad1 x y z]] && [file isdir [file join tfad2 dir tfad1 x y z]]]
+    list [file isdir [file join tfad1 x y z]] \
+	[file isdir [file join tfad2 dir tfad1 x y z]]
+} -cleanup {
     file delete -force tfad1 tfad2
-    set result
-} {1}
+} -result {1 1}
 
 #
 # Functionality tests for TclDeleteFilesCmd
 #
-
-test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} {unix notRoot} {
+test fCmd-26.1 {TclDeleteFilesCmd: delete symlink} -setup {
     catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {unix notRoot} -body {
     file mkdir tfad1
     file link -symbolic tfalink tfad1
     file delete tfalink
-
-    set r1 [file isdir tfad1]
-    set r2 [file exists tfalink]
-
-    set result [expr $r1 && !$r2]
+    list [file isdir tfad1] [file exists tfalink]
+} -cleanup {
     file delete tfad1
-    set result
-} {1}
-test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} {unix notRoot} {
+    catch {file delete tfalink}
+} -result {1 0}
+test fCmd-26.2 {TclDeleteFilesCmd: delete dir with symlink} -setup {
     catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {unix notRoot} -body {
     file mkdir tfad1
     file mkdir tfad2
     file link -symbolic [file join tfad2 link] [file join .. tfad1]
     file delete -force tfad2
-
-    set r1 [file isdir tfad1]
-    set r2 [file exists tfad2]
-    
-    set result [expr $r1 && !$r2]
+    list [file isdir tfad1] [file exists tfad2]
+} -cleanup {
     file delete tfad1
-    set result
-} {1}
-test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} {unix notRoot} {
+} -result {1 0}
+test fCmd-26.3 {TclDeleteFilesCmd: delete dangling symlink} -setup {
     catch {file delete -force -- tfad1 tfad2}
-
+} -constraints {unix notRoot} -body {
     file mkdir tfad1
     file link -symbolic tfad2 tfad1
     file delete tfad1
     file delete tfad2
+    list [file exists tfad1] [file exists tfad2]
+} -result {0 0}
 
-    set r1 [file exists tfad1]
-    set r2 [file exists tfad2]
-    
-    set result [expr !$r1 && !$r2]
-    set result
-} {1}
-
-test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} {testsetplatform} {
+# There is no fCmd-27.1
+test fCmd-27.2 {TclFileAttrsCmd - Tcl_TranslateFileName fails} -setup {
     set platform [testgetplatform]
+} -constraints {testsetplatform} -body {
     testsetplatform unix
-    list [catch {file attributes ~_totally_bogus_user} msg] $msg [testsetplatform $platform]
-} {1 {user "_totally_bogus_user" doesn't exist} {}}
-test fCmd-27.3 {TclFileAttrsCmd - all attributes} {
+    file attributes ~_totally_bogus_user
+} -returnCodes error -cleanup {
+    testsetplatform $platform
+} -result {user "_totally_bogus_user" doesn't exist}
+test fCmd-27.3 {TclFileAttrsCmd - all attributes} -setup {
     catch {file delete -force -- foo.tmp}
+} -body {
     createfile foo.tmp
-    list [catch {file attributes foo.tmp} msg] [expr {[llength $msg] > 0}] [file delete -force -- foo.tmp]
-} {0 1 {}}
-test fCmd-27.4 {TclFileAttrsCmd - getting one option} {
+    file attributes foo.tmp
+    # Must be non-empty result
+} -cleanup {
+    file delete -force -- foo.tmp
+} -match glob -result {?*}
+test fCmd-27.4 {TclFileAttrsCmd - getting one option} -setup {
     catch {file delete -force -- foo.tmp}
+} -body {
     createfile foo.tmp
     set attrs [file attributes foo.tmp]
-    list [catch {file attributes foo.tmp {expand}[lindex $attrs 0]}] [file delete -force -- foo.tmp]
-} {0 {}}
-# Find a group that exists on this Unix system, or else skip tests that
-# require Unix groups.
-if {$tcl_platform(platform) == "unix"} {
-    ::tcltest::testConstraint foundGroup 0
-    catch {
-	set groupList [exec groups]
-	set group [lindex $groupList 0]
-	::tcltest::testConstraint foundGroup 1
-    }
-} else {
-    ::tcltest::testConstraint foundGroup 1
-}
-test fCmd-27.5 {TclFileAttrsCmd - setting one option} {foundGroup} {
+    file attributes foo.tmp {*}[lindex $attrs 0]
+    # Any successful result will do
+} -cleanup {
+    file delete -force -- foo.tmp
+} -match glob -result *
+test fCmd-27.5 {TclFileAttrsCmd - setting one option} -setup {
     catch {file delete -force -- foo.tmp}
+} -constraints {foundGroup} -body {
     createfile foo.tmp
     set attrs [file attributes foo.tmp]
-    list [catch {file attributes foo.tmp {expand}[lrange $attrs 0 1]} msg] $msg [file delete -force -- foo.tmp]
-} {0 {} {}}
-test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} {foundGroup} {
+    file attributes foo.tmp {*}[lrange $attrs 0 1]
+} -cleanup {
+    file delete -force -- foo.tmp
+} -result {}
+test fCmd-27.6 {TclFileAttrsCmd - setting more than one option} -setup {
     catch {file delete -force -- foo.tmp}
+} -constraints {foundGroup} -body {
     createfile foo.tmp
     set attrs [file attributes foo.tmp]
-    list [catch {file attributes foo.tmp {expand}[lrange $attrs 0 3]} msg] $msg [file delete -force -- foo.tmp]
-} {0 {} {}}
-
-if {[string equal $tcl_platform(platform) "windows"]} {
-    if {[string index $tcl_platform(osVersion) 0] >= 5 \
-      && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
-	tcltest::testConstraint linkDirectory 1
-	tcltest::testConstraint linkFile 1
-    } else {
-	tcltest::testConstraint linkDirectory 0
-	tcltest::testConstraint linkFile 0
-    }
-} else {
-    tcltest::testConstraint linkFile 1
-    tcltest::testConstraint linkDirectory 1
+    file attributes foo.tmp {*}[lrange $attrs 0 3]
+} -cleanup {
+    file delete -force -- foo.tmp
+} -result {}
+
+if {
+    [testConstraint win] &&
+    ([string index $tcl_platform(osVersion) 0] < 5
+     || [lindex [file system [temporaryDirectory]] 1] ne "NTFS")
+} then {
+    testConstraint linkDirectory 0
+    testConstraint linkFile 0
 }
 
-test fCmd-28.1 {file link} {
-    list [catch {file link} msg] $msg
-} {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
-test fCmd-28.2 {file link} {
-    list [catch {file link a b c d} msg] $msg
-} {1 {wrong # args: should be "file link ?-linktype? linkname ?target?"}}
-test fCmd-28.3 {file link} {
-    list [catch {file link abc b c} msg] $msg
-} {1 {bad switch "abc": must be -symbolic or -hard}}
-test fCmd-28.4 {file link} {
-    list [catch {file link -abc b c} msg] $msg
-} {1 {bad switch "-abc": must be -symbolic or -hard}}
+test fCmd-28.1 {file link} -returnCodes error -body {
+    file link
+} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
+test fCmd-28.2 {file link} -returnCodes error -body {
+    file link a b c d
+} -result {wrong # args: should be "file link ?-linktype? linkname ?target?"}
+test fCmd-28.3 {file link} -returnCodes error -body {
+    file link abc b c
+} -result {bad switch "abc": must be -symbolic or -hard}
+test fCmd-28.4 {file link} -returnCodes error -body {
+    file link -abc b c
+} -result {bad switch "-abc": must be -symbolic or -hard}
 cd [workingDirectory]
 makeDirectory abc.dir
 makeDirectory abc2.dir
 makeFile contents abc.file
 makeFile contents abc2.file
 cd [temporaryDirectory]
-test fCmd-28.5 {file link: source already exists} {linkDirectory} {
+test fCmd-28.5 {file link: source already exists} -setup {
+    cd [temporaryDirectory]
+} -constraints {linkDirectory} -body {
+    file link abc.dir abc2.dir
+} -returnCodes error -cleanup {
+    cd [workingDirectory]
+} -result {could not create new link "abc.dir": that path already exists}
+test fCmd-28.6 {file link: unsupported operation} -setup {
     cd [temporaryDirectory]
-    set res [list [catch {file link abc.dir abc2.dir} msg] $msg]
+} -constraints {linkDirectory win} -body {
+    file link -hard abc.link abc.dir
+} -returnCodes error -cleanup {
     cd [workingDirectory]
-    set res
-} {1 {could not create new link "abc.dir": that path already exists}}
-test fCmd-28.6 {file link: unsupported operation} {linkDirectory win} {
+} -result {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}
+test fCmd-28.7 {file link: source already exists} -setup {
     cd [temporaryDirectory]
-    set res [list [catch {file link -hard abc.link abc.dir} msg] $msg]
+} -constraints {linkFile} -body {
+    file link abc.file abc2.file
+} -returnCodes error -cleanup {
     cd [workingDirectory]
-    set res
-} {1 {could not create new link "abc.link" pointing to "abc.dir": illegal operation on a directory}}
-test fCmd-28.7 {file link: source already exists} {linkFile} {
+} -result {could not create new link "abc.file": that path already exists}
+test fCmd-28.8 {file link} -constraints {linkFile win} -setup {
     cd [temporaryDirectory]
-    set res [list [catch {file link abc.file abc2.file} msg] $msg]
+} -body {
+    file link -symbolic abc.link abc.file
+} -returnCodes error -cleanup {
     cd [workingDirectory]
-    set res
-} {1 {could not create new link "abc.file": that path already exists}}
-test fCmd-28.8 {file link} {linkFile win} {
+} -result {could not create new link "abc.link" pointing to "abc.file": not a directory}
+test fCmd-28.9 {file link: success with file} -constraints {linkFile} -setup {
     cd [temporaryDirectory]
-    set res [list [catch {file link -symbolic abc.link abc.file} msg] $msg]
+    file delete -force abc.link
+} -body {
+    file link abc.link abc.file
+} -cleanup {
     cd [workingDirectory]
-    set res
-} {1 {could not create new link "abc.link" pointing to "abc.file": not a directory}}
-test fCmd-28.9 {file link: success with file} {linkFile} {
+} -result abc.file
+test fCmd-28.9.1 {file link: success with file} -setup {
     cd [temporaryDirectory]
     file delete -force abc.link
-    set res [list [catch {file link abc.link abc.file} msg] $msg]
+} -constraints {linkFile win} -body {
+    file stat abc.file arr
+    set res $arr(nlink)
+    lappend res [catch {file link abc.link abc.file} msg] $msg
+    file stat abc.file arr
+    lappend res $arr(nlink)
+} -cleanup {
     cd [workingDirectory]
-    set res
-} {0 abc.file}
+} -result {1 0 abc.file 2}
 cd [temporaryDirectory]
 catch {file delete -force abc.link}
 cd [workingDirectory]
-test fCmd-28.10 {file link: linking to nonexistent path} {linkDirectory} {
+test fCmd-28.10 {file link: linking to nonexistent path} -setup {
     cd [temporaryDirectory]
     file delete -force abc.link
-    set res [list [catch {file link abc.link abc2.doesnt} msg] $msg]
+} -constraints {linkDirectory} -body {
+    file link abc.link abc2.doesnt
+} -returnCodes error -cleanup {
     cd [workingDirectory]
-    set res
-} {1 {could not create new link "abc.link": target "abc2.doesnt" doesn't exist}}
-test fCmd-28.10.1 {file link: linking to nonexistent path} {linkDirectory} {
+} -result {could not create new link "abc.link": target "abc2.doesnt" doesn't exist}
+test fCmd-28.10.1 {file link: linking to nonexistent path} -setup {
     cd [temporaryDirectory]
     file delete -force abc.link
-    set res [list [catch {file link doesnt/abc.link abc.dir} msg] $msg]
+} -constraints {linkDirectory} -body {
+    file link doesnt/abc.link abc.dir
+} -returnCodes error -cleanup {
     cd [workingDirectory]
-    set res
-} {1 {could not create new link "doesnt/abc.link": no such file or directory}}
-test fCmd-28.11 {file link: success with directory} {linkDirectory} {
+} -result {could not create new link "doesnt/abc.link": no such file or directory}
+test fCmd-28.11 {file link: success with directory} -setup {
     cd [temporaryDirectory]
     file delete -force abc.link
-    set res [list [catch {file link abc.link abc.dir} msg] $msg]
+} -constraints {linkDirectory} -body {
+    file link abc.link abc.dir
+} -cleanup {
     cd [workingDirectory]
-    set res
-} {0 abc.dir}
-test fCmd-28.12 {file link: cd into a link} {linkDirectory} {
+} -result abc.dir
+test fCmd-28.12 {file link: cd into a link} -setup {
     cd [temporaryDirectory]
     file delete -force abc.link
+} -constraints {linkDirectory} -body {
     file link abc.link abc.dir
     set orig [pwd]
     cd abc.link
@@ -2215,55 +2420,66 @@ test fCmd-28.12 {file link: cd into a link} {linkDirectory} {
     cd ..
     set up [pwd]
     cd $orig
-    # 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)
-    if {([file normalize $up] != [file normalize $orig]) \
-      && ([file normalize $up] != [file normalize [file dirname abc.dir]])} {
-	set res "wrong directory with 'cd abc.link ; cd ..': \
-	  \"[file normalize $up]\" should be \"[file normalize $orig]\" or\
-	  \"[file normalize [file dirname abc.dir]]\""
+    # 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)
+    if {
+	([file normalize $up] ne [file normalize $orig]) &&
+	([file normalize $up] ne [file normalize [file dirname abc.dir]])
+    } then {
+	return "wrong directory with 'cd abc.link ; cd ..': \
+		\"[file normalize $up]\" should be \"[file normalize $orig]\"\
+		or \"[file normalize [file dirname abc.dir]]\""
     } else {
-	set res "ok"
+	return "ok"
     }
+} -cleanup {
+    file delete -force abc.link
     cd [workingDirectory]
-    set res
-} {ok}
-test fCmd-28.13 {file link} {linkDirectory} {
-    # duplicate link throws error
+} -result ok
+test fCmd-28.13 {file link} -constraints {linkDirectory} -setup {
     cd [temporaryDirectory]
-    set res [list [catch {file link abc.link abc.dir} msg] $msg]
+    file link abc.link abc.dir
+} -body {
+    # duplicate link throws error
+    file link abc.link abc.dir
+} -returnCodes error -cleanup {
+    file delete -force abc.link
     cd [workingDirectory]
-    set res
-} {1 {could not create new link "abc.link": that path already exists}}
-test fCmd-28.14 {file link: deletes link not dir} {linkDirectory} {
+} -result {could not create new link "abc.link": that path already exists}
+test fCmd-28.14 {file link: deletes link not dir} -setup {
     cd [temporaryDirectory]
+} -constraints {linkDirectory} -body {
     file delete -force abc.link
-    set res [list [file exists abc.link] [file exists abc.dir]]
+    list [file exists abc.link] [file exists abc.dir]
+} -cleanup {
     cd [workingDirectory]
-    set res
-} {0 1}
-test fCmd-28.15.1 {file link: copies link not dir} {linkDirectory dontCopyLinks} {
+} -result {0 1}
+test fCmd-28.15.1 {file link: copies link not dir} -setup {
     cd [temporaryDirectory]
     file delete -force abc.link
+} -constraints {linkDirectory dontCopyLinks} -body {
     file link abc.link abc.dir
     file copy abc.link abc2.link
-    # abc2.linkdir was a copy of a link to a dir, so it should end up as
-    # a directory, not a link (links trace to endpoint).
-    set res [list [file type abc2.link] [file tail [file link abc.link]]]
+    # abc2.linkdir was a copy of a link to a dir, so it should end up as a
+    # directory, not a link (links trace to endpoint).
+    list [file type abc2.link] [file tail [file link abc.link]]
+} -cleanup {
+    file delete -force abc.link
     cd [workingDirectory]
-    set res
-} {directory abc.dir}
-test fCmd-28.15.2 {file link: copies link not dir} {linkDirectory} {
+} -result {directory abc.dir}
+test fCmd-28.15.2 {file link: copies link not dir} -setup {
     cd [temporaryDirectory]
     file delete -force abc.link
+} -constraints {linkDirectory} -body {
     file link abc.link abc.dir
     file copy abc.link abc2.link
-    set res [list [file type abc2.link] [file tail [file link abc2.link]]]
+    list [file type abc2.link] [file tail [file link abc2.link]]
+} -cleanup {
+    file delete -force abc.link
     cd [workingDirectory]
-    set res
-} {link abc.dir}
+} -result {link abc.dir}
 cd [temporaryDirectory]
 file delete -force abc.link
 file delete -force abc2.link
@@ -2274,65 +2490,119 @@ cd ..
 file copy abc.file abc.dir
 file copy abc2.file abc.dir
 cd [workingDirectory]
-test fCmd-28.16 {file link: glob inside link} {linkDirectory} {
+test fCmd-28.16 {file link: glob inside link} -setup {
     cd [temporaryDirectory]
     file delete -force abc.link
+} -constraints {linkDirectory} -body {
     file link abc.link abc.dir
-    set res [glob -dir abc.link -tails *]
+    lsort [glob -dir abc.link -tails *]
+} -cleanup {
+    file delete -force abc.link
     cd [workingDirectory]
-    lsort $res
-} {abc.file abc2.file}
-test fCmd-28.17 {file link: glob -type l} {linkDirectory} {
+} -result {abc.file abc2.file}
+test fCmd-28.17 {file link: glob -type l} -setup {
     cd [temporaryDirectory]
-    set res [glob -dir [pwd] -type l -tails abc*]
+    file link abc.link abc.dir
+} -constraints {linkDirectory} -body {
+    glob -dir [pwd] -type l -tails abc*
+} -cleanup {
+    file delete -force abc.link
     cd [workingDirectory]
-    set res
-} {abc.link}
-test fCmd-28.18 {file link: glob -type d} {linkDirectory} {
+} -result {abc.link}
+test fCmd-28.18 {file link: glob -type d} -constraints linkDirectory -setup {
     cd [temporaryDirectory]
-    set res [lsort [glob -dir [pwd] -type d -tails abc*]]
+    file link abc.link abc.dir
+} -body {
+    lsort [glob -dir [pwd] -type d -tails abc*]
+} -cleanup {
+    file delete -force abc.link
     cd [workingDirectory]
-    set res
-} [lsort [list abc.link abc.dir abc2.dir]]
-test fCmd-28.19 {file link: relative paths} {win linkDirectory} {
+} -result [lsort [list abc.link abc.dir abc2.dir]]
+test fCmd-28.19 {file link: relative paths} -setup {
     cd [temporaryDirectory]
+} -constraints {win linkDirectory} -body {
     file mkdir d1/d2/d3
-    set res [list [catch {file link d1/l2 d1/d2} err] $err]
-    lappend res [catch {file delete -force d1} err] $err
-} {0 d1/d2 0 {}}
-test fCmd-28.20 {file link: relative paths} {unix linkDirectory} {
+    file link d1/l2 d1/d2
+} -cleanup {
+    catch {file delete -force d1}
+    cd [workingDirectory]
+} -result d1/d2
+test fCmd-28.20 {file link: relative paths} -setup {
     cd [temporaryDirectory]
+} -constraints {unix linkDirectory} -body {
     file mkdir d1/d2/d3
-    list [catch {file link d1/l2 d1/d2} res] $res
-} {1 {could not create new link "d1/l2": target "d1/d2" doesn't exist}}
-test fCmd-28.21 {file link: relative paths} {unix linkDirectory} {
+    file link d1/l2 d1/d2
+} -returnCodes error -cleanup {
+    catch {file delete -force d1}
+    cd [workingDirectory]
+} -result {could not create new link "d1/l2": target "d1/d2" doesn't exist}
+test fCmd-28.21 {file link: relative paths} -setup {
     cd [temporaryDirectory]
+} -constraints {unix linkDirectory} -body {
     file mkdir d1/d2/d3
-    list [catch {file link d1/l2 d2} res] $res
-} {0 d2}
-test fCmd-28.22 {file link: relative paths} {unix linkDirectory} {
+    file link d1/l2 d2
+} -cleanup {
+    catch {file delete -force d1}
+    cd [workingDirectory]
+} -result d2
+test fCmd-28.22 {file link: relative paths} -setup {
     cd [temporaryDirectory]
+} -constraints {unix linkDirectory} -body {
     file mkdir d1/d2/d3
     catch {file delete -force d1/l2}
-    list [catch {file link d1/l2 d2/d3} res] $res
-} {0 d2/d3}
-
-test fCmd-29.1 {weird memory corruption fault} {
-    catch {set res [open [file join ~a_totally_bogus_user_id/foo bar]]}
-} 1
-
-cd [temporaryDirectory]
-file delete -force abc.link
-file delete -force d1/d2
-file delete -force d1
-cd [workingDirectory]
-
+    file link d1/l2 d2/d3
+} -cleanup {
+    catch {file delete -force d1}
+    cd [workingDirectory]
+} -result d2/d3
+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 {win reg} -body {
+    file writable $mydocsname
+} -result 1
+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 {win} -body {
+    set r {}
+    if {[info exists env(SystemDrive)]} {
+        set path $env(SystemDrive)/pagefile.sys
+        lappend r exists [file exists $path]
+        lappend r readable [file readable $path]
+        lappend r stat [catch {file stat $path a} e] $e
+    }
+    return $r
+} -result {exists 1 readable 0 stat 0 {}}
+
 # cleanup
 cleanup
+if {[testConstraint unix]} {
+    removeDirectory tcl[pid] /tmp
+}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/fileName.test b/tests/fileName.test
index 979dd63..51f00d1 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -1,38 +1,55 @@
 # This file tests the filename manipulation routines.
 #
-# 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) 1995-1996 Sun Microsystems, Inc.
 # Copyright (c) 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.
-#
-# RCS: @(#) $Id: fileName.test,v 1.48 2005/07/28 18:42:32 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-testConstraint testsetplatform [string equal testsetplatform [info commands testsetplatform]]
-testConstraint testtranslatefilename [string equal testtranslatefilename [info commands testtranslatefilename]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testsetplatform [llength [info commands testsetplatform]]
+testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
+testConstraint linkDirectory 1
+testConstraint symbolicLinkFile 1
+if {[testConstraint win]} {
+    if {[string index $tcl_platform(osVersion) 0] < 5 \
+	    || [lindex [file system [temporaryDirectory]] 1] ne "NTFS"} {
+	testConstraint linkDirectory 0
+    }
+    testConstraint symbolicLinkFile 0
+    testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
+}
+# This match compares the first two words of the result. If the wanted result
+# is "equal", then this is successful if the words are equal. If the wanted
+# result is "not equal", then this is successful if the words are different.
+customMatch compareWords {apply {{a b} {
+    lassign $b w1 w2
+    expr {$a eq "equal" ? $w1 eq $w2 : $w1 ne $w2}
+}}}
 
+proc touch filename {catch {close [open $filename w]}}
 global env
 if {[testConstraint testsetplatform]} {
     set platform [testgetplatform]
 }
-
-# Caution: when using 'testsetplatform' to test different file
-# name platform descriptions in this file, one must be very
-# careful not to combine such platform manipulation with
-# commands like 'cd', 'pwd'.  That is because the latter commands
-# operate on the real filesystem but will potentially have their
-# logic routed through the wrong generic code paths if we've
-# used 'testsetplatform'.  This can lead to serious problems,
-# even crashes.
+
+# Caution: when using 'testsetplatform' to test different file name platform
+# descriptions in this file, one must be very careful not to combine such
+# platform manipulation with commands like 'cd', 'pwd'. That is because the
+# latter commands operate on the real filesystem but will potentially have
+# their logic routed through the wrong generic code paths if we've used
+# 'testsetplatform'. This can lead to serious problems, even crashes.
 test filename-1.1 {Tcl_GetPathType: unix} {testsetplatform} {
     testsetplatform unix
     file pathtype /
@@ -182,7 +199,7 @@ test filename-4.12 {Tcl_SplitPath: unix} {testsetplatform} {
 test filename-4.13 {Tcl_SplitPath: unix} {testsetplatform} {
     testsetplatform unix
     file split //foo
-} {/ foo}
+} "/ foo"
 test filename-4.14 {Tcl_SplitPath: unix} {testsetplatform} {
     testsetplatform unix
     file split foo//bar
@@ -203,36 +220,33 @@ test filename-4.18 {Tcl_SplitPath: unix} {testsetplatform} {
     testsetplatform unix
     file split foo/bar~/baz
 } {foo bar~ baz}
-
 if {[testConstraint testsetplatform]} {
     testsetplatform $platform
 }
-
-test filename-4.19 {Tcl_SplitPath} {
+test filename-4.19 {Tcl_SplitPath} -setup {
     set oldDir [pwd]
-    set res [catch {
-	cd [temporaryDirectory]
-	file mkdir tildetmp
-	set nastydir [file join tildetmp ./~tilde]
-	file mkdir $nastydir
-	set norm [file normalize $nastydir]
-	cd tildetmp
-	cd ./~tilde
-	glob -nocomplain *
-	set idx [string first tildetmp $norm]
-	set norm [string range $norm $idx end]
-	# fix path away so all platforms are the same
-	regsub {(.*):$} $norm {\1} norm
-	regsub -all ":" $norm "/" norm
-	# make sure we can delete the directory we created
-	cd $oldDir
-	file delete -force $nastydir
-	set norm
-    } err]
+    cd [temporaryDirectory]
+} -body {
+    file mkdir tildetmp
+    set nastydir [file join tildetmp ./~tilde]
+    file mkdir $nastydir
+    set norm [file normalize $nastydir]
+    cd tildetmp
+    cd ./~tilde
+    glob -nocomplain *
+    set idx [string first tildetmp $norm]
+    set norm [string range $norm $idx end]
+    # fix path away so all platforms are the same
+    regsub {(.*):$} $norm {\1} norm
+    regsub -all ":" $norm "/" norm
+    # make sure we can delete the directory we created
+    cd $oldDir
+    file delete -force $nastydir
+    return $norm
+} -cleanup {
     cd $oldDir
     catch {file delete -force [file join [temporaryDirectory] tildetmp]}
-    list $res $err
-} {0 tildetmp/~tilde}
+} -result {tildetmp/~tilde}
 
 test filename-6.1 {Tcl_SplitPath: win} {testsetplatform} {
     testsetplatform win
@@ -422,12 +436,11 @@ test filename-7.16 {Tcl_JoinPath: unix} {testsetplatform} {
 test filename-7.17 {Tcl_JoinPath: unix} {testsetplatform} {
     testsetplatform unix
     file join //a b
-} {/a/b}
+} "/a/b"
 test filename-7.18 {Tcl_JoinPath: unix} {testsetplatform} {
     testsetplatform unix
     file join /// a b
-} {/a/b}
-
+} "/a/b"
 
 test filename-9.1 {Tcl_JoinPath: win} {testsetplatform} {
     testsetplatform win
@@ -505,25 +518,25 @@ test filename-9.19 {Tcl_JoinPath: win} {testsetplatform} {
     testsetplatform win
     set res {}
     lappend res \
-      [file join {C:\foo\bar}] \
-      [file join C:/blah {C:\foo\bar}] \
-      [file join C:/blah C:/blah {C:\foo\bar}]
+	[file join {C:\foo\bar}] \
+	[file join C:/blah {C:\foo\bar}] \
+	[file join C:/blah C:/blah {C:\foo\bar}]
 } {C:/foo/bar C:/foo/bar C:/foo/bar}
 test filename-9.19.1 {Tcl_JoinPath: win} {testsetplatform} {
     testsetplatform win
     set res {}
     lappend res \
-      [file join {foo\bar}] \
-      [file join C:/blah {foo\bar}] \
-      [file join C:/blah C:/blah {foo\bar}]
+	[file join {foo\bar}] \
+	[file join C:/blah {foo\bar}] \
+	[file join C:/blah C:/blah {foo\bar}]
 } {foo/bar C:/blah/foo/bar C:/blah/foo/bar}
 test filename-9.19.2 {Tcl_JoinPath: win} {testsetplatform win} {
     testsetplatform win
     set res {}
     lappend res \
-      [file join {foo\bar}] \
-      [file join [pwd] {foo\bar}] \
-      [file join [pwd] [pwd] {foo\bar}]
+	[file join {foo\bar}] \
+	[file join [pwd] {foo\bar}] \
+	[file join [pwd] [pwd] {foo\bar}]
     set nres {}
     foreach elt $res {
 	lappend nres [string map [list [pwd] pwd] $elt]
@@ -534,614 +547,563 @@ test filename-9.20 {Tcl_JoinPath: unix} {testsetplatform} {
     testsetplatform unix
     set res {}
     lappend res \
-      [file join {/foo/bar}] \
-      [file join /x {/foo/bar}] \
-      [file join /x /x {/foo/bar}]
+	[file join {/foo/bar}] \
+	[file join /x {/foo/bar}] \
+	[file join /x /x {/foo/bar}]
 } {/foo/bar /foo/bar /foo/bar}
 test filename-9.23 {Tcl_JoinPath: win} {testsetplatform} {
     testsetplatform win
     set res {}
     lappend res \
-      [file join {foo\bar}] \
-      [file join C:/blah {foo\bar}] \
-      [file join C:/blah C:/blah {foo\bar}]
+	[file join {foo\bar}] \
+	[file join C:/blah {foo\bar}] \
+	[file join C:/blah C:/blah {foo\bar}]
     string map [list C:/blah ""] $res
 } {foo/bar /foo/bar /foo/bar}
 test filename-9.24 {Tcl_JoinPath: unix} {testsetplatform} {
     testsetplatform unix
     set res {}
     lappend res \
-      [file join {foo/bar}] \
-      [file join /x {foo/bar}] \
-      [file join /x /x {foo/bar}]
+	[file join {foo/bar}] \
+	[file join /x {foo/bar}] \
+	[file join /x /x {foo/bar}]
     string map [list /x ""] $res
 } {foo/bar /foo/bar /foo/bar}
 
-test filename-10.1 {Tcl_TranslateFileName} {testsetplatform} {
+test filename-10.1 {Tcl_TranslateFileName} -body {
     testsetplatform unix
-    list [catch {testtranslatefilename foo} msg] $msg
-} {0 foo}
-test filename-10.2 {Tcl_TranslateFileName} {testsetplatform} {
+    testtranslatefilename foo
+} -result {foo} -constraints {testsetplatform testtranslatefilename}
+test filename-10.2 {Tcl_TranslateFileName} -body {
     testsetplatform windows
-    list [catch {testtranslatefilename {c:/foo}} msg] $msg
-} {0 {c:\foo}}
-test filename-10.3 {Tcl_TranslateFileName} {testsetplatform} {
+    testtranslatefilename {c:/foo}
+} -result {c:\foo} -constraints {testsetplatform testtranslatefilename}
+test filename-10.3 {Tcl_TranslateFileName} -body {
     testsetplatform windows
-    list [catch {testtranslatefilename {c:/\\foo/}} msg] $msg
-} {0 {c:\foo}}
-test filename-10.3.1 {Tcl_TranslateFileName} {testsetplatform} {
+    testtranslatefilename {c:/\\foo/}
+} -result {c:\foo} -constraints {testsetplatform testtranslatefilename}
+test filename-10.3.1 {Tcl_TranslateFileName} -body {
     testsetplatform windows
-    list [catch {testtranslatefilename {c://///}} msg] $msg
-} {0 c:\\}
-test filename-10.6 {Tcl_TranslateFileName} {testsetplatform} {
+    testtranslatefilename {c://///}
+} -result c:\\ -constraints {testsetplatform testtranslatefilename}
+test filename-10.6 {Tcl_TranslateFileName} -setup {
     global env
     set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
     set env(HOME) "/home/test"
     testsetplatform unix
-    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    testtranslatefilename ~/foo
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 /home/test/foo}
-test filename-10.7 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {/home/test/foo}
+test filename-10.7 {Tcl_TranslateFileName} -setup {
     global env
     set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
     unset env(HOME)
     testsetplatform unix
-    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    testtranslatefilename ~/foo
+} -returnCodes error -cleanup {
     set env(HOME) $temp
-    set result
-} {1 {couldn't find HOME environment variable to expand path}}
-test filename-10.8 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {couldn't find HOME environment variable to expand path}
+test filename-10.8 {Tcl_TranslateFileName} -setup {
     global env
     set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
     set env(HOME) "/home/test"
     testsetplatform unix
-    set result [list [catch {testtranslatefilename ~} msg] $msg]
+    testtranslatefilename ~
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 /home/test}
-test filename-10.9 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {/home/test}
+test filename-10.9 {Tcl_TranslateFileName} -setup {
     global env
     set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
     set env(HOME) "/home/test/"
     testsetplatform unix
-    set result [list [catch {testtranslatefilename ~} msg] $msg]
+    testtranslatefilename ~
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 /home/test}
-test filename-10.10 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {/home/test}
+test filename-10.10 {Tcl_TranslateFileName} -setup {
     global env
     set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
     set env(HOME) "/home/test/"
     testsetplatform unix
-    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    testtranslatefilename ~/foo
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 /home/test/foo}
-test filename-10.17 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {/home/test/foo}
+test filename-10.17 {Tcl_TranslateFileName} -setup {
     global env
     set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
     set env(HOME) "\\home\\"
     testsetplatform windows
-    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    testtranslatefilename ~/foo
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 {\home\foo}}
-test filename-10.18 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {\home\foo}
+test filename-10.18 {Tcl_TranslateFileName} -setup {
     global env
     set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
     set env(HOME) "\\home\\"
     testsetplatform windows
-    set result [list [catch {testtranslatefilename ~/foo\\bar} msg] $msg]
+    testtranslatefilename ~/foo\\bar
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 {\home\foo\bar}}
-test filename-10.19 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {\home\foo\bar}
+test filename-10.19 {Tcl_TranslateFileName} -setup {
     global env
     set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
     set env(HOME) "c:"
     testsetplatform windows
-    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    testtranslatefilename ~/foo
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 c:foo}
-test filename-10.20 {Tcl_TranslateFileName} {testtranslatefilename} {
-    list [catch {testtranslatefilename ~blorp/foo} msg] $msg
-} {1 {user "blorp" doesn't exist}}
-test filename-10.21 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {c:foo}
+test filename-10.20 {Tcl_TranslateFileName} -returnCodes error -body {
+    testtranslatefilename ~blorp/foo
+} -constraints {testtranslatefilename testtranslatefilename} \
+    -result {user "blorp" doesn't exist}
+test filename-10.21 {Tcl_TranslateFileName} -setup {
     global env
     set temp $env(HOME)
+} -constraints {testsetplatform testtranslatefilename} -body {
     set env(HOME) "c:\\"
     testsetplatform windows
-    set result [list [catch {testtranslatefilename ~/foo} msg] $msg]
+    testtranslatefilename ~/foo
+} -cleanup {
     set env(HOME) $temp
-    set result
-} {0 {c:\foo}}
-test filename-10.22 {Tcl_TranslateFileName} {testsetplatform} {
+} -result {c:\foo}
+test filename-10.22 {Tcl_TranslateFileName} -body {
     testsetplatform windows
-    list [catch {testtranslatefilename foo//bar} msg] $msg
-} {0 {foo\bar}}
-
+    testtranslatefilename foo//bar
+} -constraints {testsetplatform testtranslatefilename} -result {foo\bar}
 if {[testConstraint testsetplatform]} {
     testsetplatform $platform
 }
-
-test filename-10.23 {Tcl_TranslateFileName} {nonPortable} {
+test filename-10.23 {Tcl_TranslateFileName} -body {
     # this test fails if ~ouster is not /home/ouster
-    list [catch {testtranslatefilename ~ouster} msg] $msg
-} {0 /home/ouster}
-test filename-10.24 {Tcl_TranslateFileName} {nonPortable} {
+    testtranslatefilename ~ouster
+} -constraints {nonPortable testtranslatefilename} -result {/home/ouster}
+test filename-10.24 {Tcl_TranslateFileName} -body {
     # this test fails if ~ouster is not /home/ouster
-    list [catch {testtranslatefilename ~ouster/foo} msg] $msg
-} {0 /home/ouster/foo}
+    testtranslatefilename ~ouster/foo
+} -result {/home/ouster/foo} -constraints {nonPortable testtranslatefilename}
 
-
-test filename-11.1 {Tcl_GlobCmd} {
-    list [catch {glob} msg] $msg
-} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
-test filename-11.2 {Tcl_GlobCmd} {
-    list [catch {glob -gorp} msg] $msg
-} {1 {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
-test filename-11.3 {Tcl_GlobCmd} {
-    list [catch {glob -nocomplai} msg] $msg
-} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
-test filename-11.4 {Tcl_GlobCmd} {
-    list [catch {glob -nocomplain} msg] $msg
-} {1 {wrong # args: should be "glob ?switches? name ?name ...?"}}
-test filename-11.5 {Tcl_GlobCmd} {
-    list [catch {glob -nocomplain ~xyqrszzz} msg] $msg
-} {0 {}}
-test filename-11.6 {Tcl_GlobCmd} {
-    list [catch {glob ~xyqrszzz} msg] $msg
-} {1 {user "xyqrszzz" doesn't exist}}
-test filename-11.7 {Tcl_GlobCmd} {
-    list [catch {glob -- -nocomplain} msg] $msg
-} {1 {no files matched glob pattern "-nocomplain"}}
-test filename-11.8 {Tcl_GlobCmd} {
-    list [catch {glob -nocomplain -- -nocomplain} msg] $msg
-} {0 {}}
-test filename-11.9 {Tcl_GlobCmd} {testsetplatform} {
+test filename-11.1 {Tcl_GlobCmd} -returnCodes error -body {
+    glob
+} -result {no files matched glob patterns ""}
+test filename-11.2 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -gorp
+} -result {bad option "-gorp": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
+test filename-11.3 {Tcl_GlobCmd} -body {
+    glob -nocomplai
+} -result {}
+test filename-11.4 {Tcl_GlobCmd} -body {
+    glob -nocomplain
+} -result {}
+test filename-11.5 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -nocomplain * ~xyqrszzz
+} -result {user "xyqrszzz" doesn't exist}
+test filename-11.6 {Tcl_GlobCmd} -returnCodes error -body {
+    glob ~xyqrszzz
+} -result {user "xyqrszzz" doesn't exist}
+test filename-11.7 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -- -nocomplain
+} -result {no files matched glob pattern "-nocomplain"}
+test filename-11.8 {Tcl_GlobCmd} -body {
+    glob -nocomplain -- -nocomplain
+} -result {}
+test filename-11.9 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
     testsetplatform unix
-    list [catch {glob ~\\xyqrszzz/bar} msg] $msg
-} {1 {user "\xyqrszzz" doesn't exist}}
-test filename-11.10 {Tcl_GlobCmd} {testsetplatform} {
+    glob ~\\xyqrszzz/bar
+} -returnCodes error -result {user "\xyqrszzz" doesn't exist}
+test filename-11.10 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
     testsetplatform unix
-    list [catch {glob -nocomplain ~\\xyqrszzz/bar} msg] $msg
-} {0 {}}
-test filename-11.11 {Tcl_GlobCmd} {testsetplatform} {
+    glob -nocomplain ~\\xyqrszzz/bar
+} -returnCodes error -result {user "\xyqrszzz" doesn't exist}
+test filename-11.11 {Tcl_GlobCmd} -constraints {testsetplatform} -body {
     testsetplatform unix
-    list [catch {glob ~xyqrszzz\\/\\bar} msg] $msg
-} {1 {user "xyqrszzz" doesn't exist}}
-test filename-11.12 {Tcl_GlobCmd} {testsetplatform} {
+    glob ~xyqrszzz\\/\\bar
+} -returnCodes error -result {user "xyqrszzz" doesn't exist}
+test filename-11.12 {Tcl_GlobCmd} -constraints {testsetplatform} -setup {
     testsetplatform unix
     set home $env(HOME)
+} -body {
     unset env(HOME)
-    set x [list [catch {glob ~/*} msg] $msg]
+    glob ~/*
+} -returnCodes error -cleanup {
     set env(HOME) $home
-    set x
-} {1 {couldn't find HOME environment variable to expand path}}
-
+} -result {couldn't find HOME environment variable to expand path}
 if {[testConstraint testsetplatform]} {
     testsetplatform $platform
 }
-
 test filename-11.13 {Tcl_GlobCmd} {
-    list [catch {file join [lindex [glob ~] 0]} msg] $msg
-} [list 0 [file join $env(HOME)]]
-
+    file join [lindex [glob ~] 0]
+} [file join $env(HOME)]
 set oldpwd [pwd]
 set oldhome $env(HOME)
-cd [temporaryDirectory]
+catch {cd [makeDirectory tcl[pid]]}
 set env(HOME) [pwd]
 file delete -force globTest
 file mkdir globTest/a1/b1
 file mkdir globTest/a1/b2
 file mkdir globTest/a2/b3
 file mkdir globTest/a3
-close [open globTest/x1.c w]
-close [open globTest/y1.c w]
-close [open globTest/z1.c w]
-close [open "globTest/weird name.c" w]
-close [open globTest/a1/b1/x2.c w]
-close [open globTest/a1/b2/y2.c w]
-
-catch {close [open globTest/.1 w]}
-catch {close [open globTest/x,z1.c w]}
-
+touch globTest/x1.c
+touch globTest/y1.c
+touch globTest/z1.c
+touch "globTest/weird name.c"
+touch globTest/a1/b1/x2.c
+touch globTest/a1/b2/y2.c
+touch globTest/.1
+touch globTest/x,z1.c
 test filename-11.14 {Tcl_GlobCmd} {
-    list [catch {glob ~/globTest} msg] $msg
-} [list 0 [list [file join $env(HOME) globTest]]]
+    glob ~/globTest
+} [list [file join $env(HOME) globTest]]
 test filename-11.15 {Tcl_GlobCmd} {
-    list [catch {glob ~\\/globTest} msg] $msg
-} [list 0 [list [file join $env(HOME) globTest]]]
+    glob ~\\/globTest
+} [list [file join $env(HOME) globTest]]
 test filename-11.16 {Tcl_GlobCmd} {
-    list [catch {glob globTest} msg] $msg
-} {0 globTest}
-
+    glob globTest
+} {globTest}
 set globname "globTest"
 set horribleglobname "glob\[\{Test"
-
 test filename-11.17 {Tcl_GlobCmd} {unix} {
-    list [catch {lsort [glob -directory $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+    lsort [glob -directory $globname *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.17.1 {Tcl_GlobCmd} {win} {
-    list [catch {lsort [glob -directory $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
-        [file join $globname .1]\
+    lsort [glob -directory $globname *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+	[file join $globname .1]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
-if {[string equal $tcl_platform(platform) "windows"]} {
-    if {[string index $tcl_platform(osVersion) 0] >= 5 \
-      && ([lindex [file system [temporaryDirectory]] 1] == "NTFS")} {
-	testConstraint linkDirectory 1
-    } else {
-	testConstraint linkDirectory 0
-    }
-} else {
-    testConstraint linkDirectory 1
-}
-if {[string equal $tcl_platform(platform) "windows"]} {
-    testConstraint symbolicLinkFile 0
-} else {
-    testConstraint symbolicLinkFile 1
-}
-test filename-11.17.2 {Tcl_GlobCmd} {notRoot linkDirectory} {
+	[file join $globname y1.c] [file join $globname z1.c]]]
+test filename-11.17.2 {Tcl_GlobCmd} -setup {
     set dir [pwd]
-    set ret "error in test"
-    if {[catch {
-	cd $globname
-	file link -symbolic link a1
-	cd $dir
-	set ret [list [catch {
-	    lsort [glob -directory $globname -join * b1]
-	} msg] $msg]
-    }]} {
-	cd $dir
-    }
+} -constraints {notRoot linkDirectory} -body {
+    cd $globname
+    file link -symbolic link a1
+    cd $dir
+    lsort [glob -directory $globname -join * b1]
+} -cleanup {
+    cd $dir
     file delete [file join $globname link]
-    set ret
-} [list 0 [lsort [list [file join $globname a1 b1] \
-  [file join $globname link b1]]]]
+} -result [list [file join $globname a1 b1] \
+	[file join $globname link b1]]
 # Simpler version of the above test to illustrate a given bug.
-test filename-11.17.3 {Tcl_GlobCmd} {notRoot linkDirectory} {
+test filename-11.17.3 {Tcl_GlobCmd} -setup {
     set dir [pwd]
-    set ret "error in test"
-    if {[catch {
-	cd $globname
-	file link -symbolic link a1
-	cd $dir
-	set ret [list [catch {
-	    lsort [glob -directory $globname -type d *]
-	} msg] $msg]
-    }]} {
-	cd $dir
-    }
+} -constraints {notRoot linkDirectory} -body {
+    cd $globname
+    file link -symbolic link a1
+    cd $dir
+    lsort [glob -directory $globname -type d *]
+} -cleanup {
+    cd $dir
     file delete [file join $globname link]
-    set ret
-} [list 0 [lsort [list [file join $globname a1] \
-  [file join $globname a2] \
-  [file join $globname a3] \
-  [file join $globname link]]]]
-# Make sure the bugfix isn't too simple.  We don't want
-# to break 'glob -type l'.
-test filename-11.17.4 {Tcl_GlobCmd} {notRoot linkDirectory} {
+} -result [list [file join $globname a1] \
+	[file join $globname a2] \
+	[file join $globname a3] \
+	[file join $globname link]]
+# Make sure the bugfix isn't too simple. We don't want to break 'glob -type l'
+test filename-11.17.4 {Tcl_GlobCmd} -setup {
     set dir [pwd]
-    set ret "error in test"
-    if {[catch {
-	cd $globname
-	file link -symbolic link a1
-	cd $dir
-	set ret [list [catch {
-	    lsort [glob -directory $globname -type l *]
-	} msg] $msg]
-    }]} {
-	cd $dir
-    }
+} -constraints {notRoot linkDirectory} -body {
+    cd $globname
+    file link -symbolic link a1
+    cd $dir
+    lsort [glob -directory $globname -type l *]
+} -cleanup {
+    cd $dir
     file delete [file join $globname link]
-    set ret
-} [list 0 [list [file join $globname link]]]
+} -result [list [file join $globname link]]
 test filename-11.17.5 {Tcl_GlobCmd} {
-    list [catch {lsort [glob -directory $globname -tails *.c]} msg] $msg
-} [list 0 [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]
+    lsort [glob -directory $globname -tails *.c]
+} [lsort [list "weird name.c" x,z1.c x1.c y1.c z1.c]]
 test filename-11.17.6 {Tcl_GlobCmd} {
-    list [catch {lsort [glob -directory $globname -tails *.c *.c]} msg] $msg
-} [list 0 [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \
-  [list "weird name.c" x,z1.c x1.c y1.c z1.c]]]]
-test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} {linkDirectory} {
+    lsort [glob -directory $globname -tails *.c *.c]
+} [lsort [concat [list "weird name.c" x,z1.c x1.c y1.c z1.c] \
+	[list "weird name.c" x,z1.c x1.c y1.c z1.c]]]
+test filename-11.17.7 {Tcl_GlobCmd: broken link and glob -l} -setup {
     set dir [pwd]
-    set ret "error in test"
-    if {[catch {
-	cd $globname
-	file mkdir nonexistent
-	file link -symbolic link nonexistent
-	file delete nonexistent
-	cd $dir
-	set ret [list [catch {
-	    lsort [glob -nocomplain -directory $globname -type l *]
-	} msg] $msg]
-    }]} {
-	cd $dir
-    }
+} -constraints {linkDirectory} -body {
+    cd $globname
+    file mkdir nonexistent
+    file link -symbolic link nonexistent
+    file delete nonexistent
+    cd $dir
+    lsort [glob -nocomplain -directory $globname -type l *]
+} -cleanup {
+    cd $dir
     file delete [file join $globname link]
-    set ret
-} [list 0 [list [file join $globname link]]]
-test filename-11.17.8 {Tcl_GlobCmd: broken link and glob -l} {symbolicLinkFile} {
+} -result [list [file join $globname link]]
+test filename-11.17.8 {Tcl_GlobCmd: broken link and glob -l} -setup {
     set dir [pwd]
-    set ret "error in test"
-    if {[catch {
-	cd $globname
-	close [open "nonexistent" w]
-	file link -symbolic link nonexistent
-	file delete nonexistent
-	cd $dir
-	set ret [list [catch {
-	    lsort [glob -nocomplain -directory $globname -type l *]
-	} msg] $msg]
-    }]} {
-	cd $dir
-    }
+} -constraints {symbolicLinkFile} -body {
+    cd $globname
+    touch "nonexistent"
+    file link -symbolic link nonexistent
+    file delete nonexistent
+    cd $dir
+    lsort [glob -nocomplain -directory $globname -type l *]
+} -cleanup {
+    cd $dir
     file delete [file join $globname link]
-    set ret
-} [list 0 [list [file join $globname link]]]
+} -result [list [file join $globname link]]
 test filename-11.18 {Tcl_GlobCmd} {unix} {
-    list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+    lsort [glob -path $globname/ *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.18.1 {Tcl_GlobCmd} {win} {
-    list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
-        [file join $globname .1]\
+    lsort [glob -path $globname/ *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+	[file join $globname .1]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.19 {Tcl_GlobCmd} {unix} {
-    list [catch {lsort [glob -join -path \
-	    [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+    lsort [glob -join -path [string range $globname 0 5] * *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.19.1 {Tcl_GlobCmd} {win} {
-    list [catch {lsort [glob -join -path \
-	    [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
-        [file join $globname .1]\
+    lsort [glob -join -path [string range $globname 0 5] * *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+	[file join $globname .1]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.20 {Tcl_GlobCmd} {
-    list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
+    lsort [glob -type d -dir $globname *]
+} [lsort [list [file join $globname a1]\
 	[file join $globname a2]\
-	[file join $globname a3]]]]
+	[file join $globname a3]]]
 test filename-11.21 {Tcl_GlobCmd} {
-    list [catch {lsort [glob -type d -path $globname *]} msg] $msg
-} [list 0 [lsort [list $globname]]]
-
-test filename-11.21.1 {Tcl_GlobCmd} {
-    close [open {[tcl].testremains} w]
-    set res [list [catch {lsort [glob -path {[tcl]} *]} msg] $msg]
+    lsort [glob -type d -path $globname *]
+} [list $globname]
+test filename-11.21.1 {Tcl_GlobCmd} -body {
+    touch {[tcl].testremains}
+    lsort [glob -path {[tcl]} *]
+} -cleanup {
     file delete -force {[tcl].testremains}
-    set res
-} [list 0 {{[tcl].testremains}}]
-
-# Get rid of file/dir if it exists, since it will have
-# been left behind by a previous failed run.
+} -result {{[tcl].testremains}}
+# Get rid of file/dir if it exists, since it will have been left behind by a
+# previous failed run.
 if {[file exists $horribleglobname]} {
     file delete -force $horribleglobname
 }
 file rename globTest $horribleglobname
 set globname $horribleglobname
-
 test filename-11.22 {Tcl_GlobCmd} {unix} {
-    list [catch {lsort [glob -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+    lsort [glob -dir $globname *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.22.1 {Tcl_GlobCmd} {win} {
-    list [catch {lsort [glob -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
-        [file join $globname .1]\
+    lsort [glob -dir $globname *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+	[file join $globname .1]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.23 {Tcl_GlobCmd} {unix} {
-    list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+    lsort [glob -path $globname/ *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.23.1 {Tcl_GlobCmd} {win} {
-    list [catch {lsort [glob -path $globname/ *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
-        [file join $globname .1]\
+    lsort [glob -path $globname/ *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+	[file join $globname .1]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.24 {Tcl_GlobCmd} {unix} {
-    list [catch {lsort [glob -join -path \
-	    [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
+    lsort [glob -join -path [string range $globname 0 5] * *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.24.1 {Tcl_GlobCmd} {win} {
-    list [catch {lsort [glob -join -path \
-	    [string range $globname 0 5] * *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1] [file join $globname a2]\
-        [file join $globname .1]\
+    lsort [glob -join -path [string range $globname 0 5] * *]
+} [lsort [list [file join $globname a1] [file join $globname a2]\
+	[file join $globname .1]\
 	[file join $globname a3]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-11.25 {Tcl_GlobCmd} {
-    list [catch {lsort [glob -type d -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
+    lsort [glob -type d -dir $globname *]
+} [lsort [list [file join $globname a1]\
 	[file join $globname a2]\
-	[file join $globname a3]]]]
+	[file join $globname a3]]]
 test filename-11.25.1 {Tcl_GlobCmd} {
-    list [catch {lsort [glob -type {d r} -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
-  [file join $globname a2]\
-  [file join $globname a3]]]]
+    lsort [glob -type {d r} -dir $globname *]
+} [lsort [list [file join $globname a1]\
+	[file join $globname a2]\
+	[file join $globname a3]]]
 test filename-11.25.2 {Tcl_GlobCmd} {
-    list [catch {lsort [glob -type {d r w} -dir $globname *]} msg] $msg
-} [list 0 [lsort [list [file join $globname a1]\
-  [file join $globname a2]\
-  [file join $globname a3]]]]
+    lsort [glob -type {d r w} -dir $globname *]
+} [lsort [list [file join $globname a1]\
+	[file join $globname a2]\
+	[file join $globname a3]]]
 test filename-11.26 {Tcl_GlobCmd} {
-    list [catch {glob -type d -path $globname *} msg] $msg
-} [list 0 [list $globname]]
-test filename-11.27 {Tcl_GlobCmd} {
-    list [catch {glob -types abcde *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
-test filename-11.28 {Tcl_GlobCmd} {
-    list [catch {glob -types z *} msg] $msg
-} {1 {bad argument to "-types": z}}
-test filename-11.29 {Tcl_GlobCmd} {
-    list [catch {glob -types {abcd efgh} *} msg] $msg
-} {1 {only one MacOS type or creator argument to "-types" allowed}}
-test filename-11.30 {Tcl_GlobCmd} {
-    list [catch {glob -types {{macintosh type TEXT} \
-	    {macintosh creator ALFA} efgh} *} msg] $msg
-} {1 {only one MacOS type or creator argument to "-types" allowed}}
-test filename-11.31 {Tcl_GlobCmd} {
-    list [catch {glob -types} msg] $msg
-} {1 {missing argument to "-types"}}
-test filename-11.32 {Tcl_GlobCmd} {
-    list [catch {glob -path hello -dir hello *} msg] $msg
-} {1 {"-directory" cannot be used with "-path"}}
-test filename-11.33 {Tcl_GlobCmd} {
-    list [catch {glob -path} msg] $msg
-} {1 {missing argument to "-path"}}
-test filename-11.34 {Tcl_GlobCmd} {
-    list [catch {glob -direct} msg] $msg
-} {1 {missing argument to "-directory"}}
-test filename-11.35 {Tcl_GlobCmd} {
-    list [catch {glob -paths *} msg] $msg
-} {1 {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
+    glob -type d -path $globname *
+} [list $globname]
+test filename-11.27 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -types abcde *
+} -result {bad argument to "-types": abcde}
+test filename-11.28 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -types z *
+} -result {bad argument to "-types": z}
+test filename-11.29 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -types {abcd efgh} *
+} -result {only one MacOS type or creator argument to "-types" allowed}
+test filename-11.30 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -types {{macintosh type TEXT} {macintosh creator ALFA} efgh} *
+} -result {only one MacOS type or creator argument to "-types" allowed}
+test filename-11.31 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -types
+} -result {missing argument to "-types"}
+test filename-11.32 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -path hello -dir hello *
+} -result {"-directory" cannot be used with "-path"}
+test filename-11.33 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -path
+} -result {missing argument to "-path"}
+test filename-11.34 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -direct
+} -result {missing argument to "-directory"}
+test filename-11.35 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -paths *
+} -result {bad option "-paths": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
 # Test '-tails' flag to glob.
-test filename-11.36 {Tcl_GlobCmd} {
-    list [catch {glob -tails *} msg] $msg
-} {1 {"-tails" must be used with either "-directory" or "-path"}}
+test filename-11.36 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -tails *
+} -result {"-tails" must be used with either "-directory" or "-path"}
 test filename-11.37 {Tcl_GlobCmd} {
-    list [catch {glob -type d -tails -path $globname *} msg] $msg
-} [list 0 [list $globname]]
+    glob -type d -tails -path $globname *
+} [list $globname]
 test filename-11.38 {Tcl_GlobCmd} {
-    list [catch {glob -tails -path $globname *} msg] $msg
-} [list 0 [list $globname]]
+    glob -tails -path $globname *
+} [list $globname]
 test filename-11.39 {Tcl_GlobCmd} {
-    list [catch {glob -tails -join -path $globname *} msg] $msg
-} [list 0 [list $globname]]
-test filename-11.40 {Tcl_GlobCmd} {
-    expr {[glob -dir [pwd] -tails *] == [glob *]}
-} {1}
-test filename-11.41 {Tcl_GlobCmd} {
-    expr {[glob -dir [pwd] -tails *] != [glob -dir [pwd] *]}
-} {1}
-test filename-11.42 {Tcl_GlobCmd} {
+    glob -tails -join -path $globname *
+} [list $globname]
+test filename-11.40 {Tcl_GlobCmd} -body {
+    list [glob -dir [pwd] -tails *] [glob *]
+} -match compareWords -result equal
+test filename-11.41 {Tcl_GlobCmd} -body {
+    list [glob -dir [pwd] -tails *] [glob -dir [pwd] *]
+} -match compareWords -result "not equal"
+test filename-11.42 {Tcl_GlobCmd} -body {
     set res [list]
     foreach f [glob -dir [pwd] *] {
 	lappend res [file tail $f]
     }
-    expr {$res == [glob *]}
-} {1}
-test filename-11.43 {Tcl_GlobCmd} {
-    list [catch {glob -t *} msg] $msg
-} {1 {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}}
-test filename-11.44 {Tcl_GlobCmd} {
-    list [catch {glob -tails -path hello -directory hello *} msg] $msg
-} {1 {"-directory" cannot be used with "-path"}}
-test filename-11.45 {Tcl_GlobCmd on root volume} {
+    list $res [glob *]
+} -match compareWords -result equal
+test filename-11.43 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -t *
+} -result {ambiguous option "-t": must be -directory, -join, -nocomplain, -path, -tails, -types, or --}
+test filename-11.44 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -tails -path hello -directory hello *
+} -result {"-directory" cannot be used with "-path"}
+test filename-11.45 {Tcl_GlobCmd on root volume} -setup {
     set res1 ""
     set res2 ""
+    set tmpd [pwd]
+} -body {
     catch {
 	set res1 [glob -dir [lindex [file volumes] 0] -tails *]
     }
     catch {
-	set tmpd [pwd]
 	cd [lindex [file volumes] 0]
 	set res2 [glob *]
-	cd $tmpd
     }
-    set res [expr {$res1 == $res2}]
-    if {!$res} {
-	lappend res $res1 $res2
-    }
-    set res
-} {1}
-test filename-11.46 {Tcl_GlobCmd} {
-    list [catch {glob -types abcde -dir foo *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
-test filename-11.47 {Tcl_GlobCmd} {
-    list [catch {glob -types abcde -path foo *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
-test filename-11.48 {Tcl_GlobCmd} {
-    list [catch {glob -types abcde -dir foo -join * *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
-test filename-11.49 {Tcl_GlobCmd} {
-    list [catch {glob -types abcde -path foo -join * *} msg] $msg
-} {1 {bad argument to "-types": abcde}}
+    list $res1 $res2
+} -cleanup {
+    cd $tmpd
+} -match compareWords -result equal
+test filename-11.46 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -types abcde -dir foo *
+} -result {bad argument to "-types": abcde}
+test filename-11.47 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -types abcde -path foo *
+} -result {bad argument to "-types": abcde}
+test filename-11.48 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -types abcde -dir foo -join * *
+} -result {bad argument to "-types": abcde}
+test filename-11.49 {Tcl_GlobCmd} -returnCodes error -body {
+    glob -types abcde -path foo -join * *
+} -result {bad argument to "-types": abcde}
 
 file rename $horribleglobname globTest
 set globname globTest
 unset horribleglobname
 
 test filename-12.1 {simple globbing} {unixOrPc} {
-    list [catch {glob {}} msg] $msg
-} {0 .}
-test filename-12.1.1 {simple globbing} {unixOrPc} {
-    list [catch {glob -types f {}} msg] $msg
-} {1 {no files matched glob pattern ""}}
+    glob {}
+} {.}
+test filename-12.1.1 {simple globbing} -constraints {unixOrPc} -body {
+    glob -types f {}
+} -returnCodes error -result {no files matched glob pattern ""}
 test filename-12.1.2 {simple globbing} {unixOrPc} {
-    list [catch {glob -types d {}} msg] $msg
-} {0 .}
+    glob -types d {}
+} {.}
 test filename-12.1.3 {simple globbing} {unix} {
-    list [catch {glob -types hidden {}} msg] $msg
-} {0 .}
-test filename-12.1.4 {simple globbing} {win} {
-    list [catch {glob -types hidden {}} msg] $msg
-} {1 {no files matched glob pattern ""}}
-test filename-12.1.5 {simple globbing} {win} {
-    list [catch {glob -types hidden c:/} msg] $msg
-} {1 {no files matched glob pattern "c:/"}}
+    glob -types hidden {}
+} {.}
+test filename-12.1.4 {simple globbing} -constraints {win} -body {
+    glob -types hidden {}
+} -returnCodes error -result {no files matched glob pattern ""}
+test filename-12.1.5 {simple globbing} -constraints {win} -body {
+    glob -types hidden c:/
+} -returnCodes error -result {no files matched glob pattern "c:/"}
 test filename-12.1.6 {simple globbing} {win} {
-    list [catch {glob c:/} msg] $msg
-} {0 c:/}
+    glob c:/
+} {c:/}
 test filename-12.3 {simple globbing} {
-    list [catch {glob -nocomplain \{a1,a2\}} msg] $msg
-} {0 {}}
-
+    glob -nocomplain \{a1,a2\}
+} {}
 set globPreResult globTest/
 set x1 x1.c
 set y1 y1.c
@@ -1149,92 +1111,67 @@ test filename-12.4 {simple globbing} {unixOrPc} {
     lsort [glob globTest/x1.c globTest/y1.c globTest/foo]
 } "$globPreResult$x1 $globPreResult$y1"
 test filename-12.5 {simple globbing} {
-    list [catch {glob globTest\\/x1.c} msg] $msg
-} "0 $globPreResult$x1"
+    glob globTest\\/x1.c
+} "$globPreResult$x1"
 test filename-12.6 {simple globbing} {
-    list [catch {glob globTest\\/\\x1.c} msg] $msg
-} "0 $globPreResult$x1"
-test filename-12.7 {globbing at filesystem root} {unix} {
-    set res1 [glob -nocomplain /*]
-    set res2 [glob -path / *]
-    set equal [string equal $res1 $res2]
-    if {!$equal} {
-	lappend equal "not equal" $res1 $res2
-    }
-    set equal
-} {1}
-test filename-12.8 {globbing at filesystem root} {unix} {
-    set dir [lindex [glob -type d /*] 0]
-    set first [string range $dir 0 1]
-    set res1 [glob -nocomplain ${first}*]
-    set res2 [glob -path $first *]
-    set equal [string equal $res1 $res2]
-    if {!$equal} {
-	lappend equal "not equal" $res1 $res2
-    }
-    set equal
-} {1}
-test filename-12.9 {globbing at filesystem root} {win} {
-    # Can't grab just anything from 'file volumes' because we need a dir
-    # that has subdirs - assume that C:/ exists across Windows machines.
-    set dir [lindex [glob -type d C:/*] 0]
-    set first [string range $dir 0 3]
-    set res1 [glob -nocomplain ${first}*]
-    set res2 [glob -path $first *]
-    set equal [string equal $res1 $res2]
-    if {!$equal} {
-	lappend equal "not equal" $res1 $res2
-    }
-    set equal
-} {1}
-
-test filename-12.10 {globbing with volume relative paths} {win} {
-    set dir [lindex [glob -type d C:/*] 0]
+    glob globTest\\/\\x1.c
+} "$globPreResult$x1"
+test filename-12.7 {globbing at filesystem root} -constraints {unix} -body {
+    list [glob -nocomplain /*] [glob -path / *]
+} -match compareWords -result equal
+test filename-12.8 {globbing at filesystem root} -constraints {unix} -body {
+    set first [string range [lindex [glob -type d /*] 0] 0 1]
+    list [glob -nocomplain ${first}*] [glob -path $first *]
+} -match compareWords -result equal
+test filename-12.9 {globbing at filesystem root} -constraints {win} -body {
+    # Can't grab just anything from 'file volumes' because we need a dir that
+    # has subdirs - assume that C:/ exists across Windows machines.
+    set first [string range [lindex [glob -type d C:/*] 0] 0 3]
+    list [glob -nocomplain ${first}*] [glob -path $first *]
+} -match compareWords -result equal
+test filename-12.10 {globbing with volume relative paths} -setup {
     set pwd [pwd]
+} -body {
+    set dir [lindex [glob -type d C:/*] 0]
     cd C:/
-    set res1 [glob -nocomplain [string range $dir 2 end]]
+    list [glob -nocomplain [string range $dir 2 end]] [list $dir]
+} -cleanup {
     cd $pwd
-    set res2 [list $dir]
-    set equal [string equal $res1 $res2]
-    if {!$equal} {
-        lappend equal "not equal" $res1 $res2
-    }
-    set equal
-} {1}
+} -constraints {win} -match compareWords -result equal
 
 test filename-13.1 {globbing with brace substitution} {
-    list [catch {glob globTest/\{\}} msg] $msg
-} "0 $globPreResult"
-test filename-13.2 {globbing with brace substitution} {
-    list [catch {glob globTest/\{} msg] $msg
-} {1 {unmatched open-brace in file name}}
-test filename-13.3 {globbing with brace substitution} {
-    list [catch {glob globTest/\{\\\}} msg] $msg
-} {1 {unmatched open-brace in file name}}
-test filename-13.4 {globbing with brace substitution} {
-    list [catch {glob globTest/\{\\} msg] $msg
-} {1 {unmatched open-brace in file name}}
-test filename-13.5 {globbing with brace substitution} {
-    list [catch {glob globTest/\}} msg] $msg
-} {1 {unmatched close-brace in file name}}
+    glob globTest/\{\}
+} "$globPreResult"
+test filename-13.2 {globbing with brace substitution} -body {
+    glob globTest/\{
+} -returnCodes error -result {unmatched open-brace in file name}
+test filename-13.3 {globbing with brace substitution} -body {
+    glob globTest/\{\\\}
+} -returnCodes error -result {unmatched open-brace in file name}
+test filename-13.4 {globbing with brace substitution} -body {
+    glob globTest/\{\\
+} -returnCodes error -result {unmatched open-brace in file name}
+test filename-13.5 {globbing with brace substitution} -body {
+    glob globTest/\}
+} -returnCodes error -result {unmatched close-brace in file name}
 test filename-13.6 {globbing with brace substitution} {
-    list [catch {glob globTest/\{\}x1.c} msg] $msg
-} "0 $globPreResult$x1"
+    glob globTest/\{\}x1.c
+} "$globPreResult$x1"
 test filename-13.7 {globbing with brace substitution} {
-    list [catch {glob globTest/\{x\}1.c} msg] $msg
-} "0 $globPreResult$x1"
+    glob globTest/\{x\}1.c
+} "$globPreResult$x1"
 test filename-13.8 {globbing with brace substitution} {
-    list [catch {glob globTest/\{x\{\}\}1.c} msg] $msg
-} "0 $globPreResult$x1"
+    glob globTest/\{x\{\}\}1.c
+} "$globPreResult$x1"
 test filename-13.9 {globbing with brace substitution} {
-    list [lsort [catch {glob globTest/\{x,y\}1.c} msg]] $msg
-} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
+    lsort [glob globTest/\{x,y\}1.c]
+} [list $globPreResult$x1 $globPreResult$y1]
 test filename-13.10 {globbing with brace substitution} {
-    list [lsort [catch {glob globTest/\{x,,y\}1.c} msg]] $msg
-} [list 0 [list $globPreResult$x1 $globPreResult$y1]]
+    lsort [glob globTest/\{x,,y\}1.c]
+} [list $globPreResult$x1 $globPreResult$y1]
 test filename-13.11 {globbing with brace substitution} {unixOrPc} {
-    list [lsort [catch {glob globTest/\{x,x\\,z,z\}1.c} msg]] $msg
-} {0 {globTest/x1.c globTest/x,z1.c globTest/z1.c}}
+    lsort [glob globTest/\{x,x\\,z,z\}1.c]
+} [lsort {globTest/x1.c globTest/x,z1.c globTest/z1.c}]
 test filename-13.13 {globbing with brace substitution} {
     lsort [glob globTest/{a,b,x,y}1.c]
 } [list $globPreResult$x1 $globPreResult$y1]
@@ -1250,9 +1187,9 @@ test filename-13.18 {globbing with brace substitution} {unixOrPc} {
 test filename-13.20 {globbing with brace substitution} {unixOrPc} {
     lsort [glob globTest/{a,x}1/*/{x,y}*]
 } {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
-test filename-13.22 {globbing with brace substitution} {
-    list [catch {glob globTest/\{a,x\}1/*/\{} msg] $msg
-} {1 {unmatched open-brace in file name}}
+test filename-13.22 {globbing with brace substitution} -body {
+    glob globTest/\{a,x\}1/*/\{
+} -returnCodes error -result {unmatched open-brace in file name}
 
 test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
     lsort [glob glo*/*.c]
@@ -1260,22 +1197,21 @@ test filename-14.1 {asterisks, question marks, and brackets} {unixOrPc} {
 test filename-14.3 {asterisks, question marks, and brackets} {unixOrPc} {
     lsort [glob globTest/?1.c]
 } {globTest/x1.c globTest/y1.c globTest/z1.c}
-
-# The current directory could be anywhere; do this to stop spurious matches
-file mkdir globTestContext
-file rename globTest [file join globTestContext globTest]
-set savepwd [pwd]
-cd globTestContext
-
-test filename-14.5 {asterisks, question marks, and brackets} {unixOrPc} {
+test filename-14.5 {asterisks, question marks, and brackets} -setup {
+    # The current directory could be anywhere; do this to stop spurious
+    # matches
+    file mkdir globTestContext
+    file rename globTest [file join globTestContext globTest]
+    set savepwd [pwd]
+    cd globTestContext
+} -constraints {unixOrPc} -body {
     lsort [glob */*/*/*.c]
-} {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
-
-# Reset to where we were
-cd $savepwd
-file rename [file join globTestContext globTest] globTest
-file delete globTestContext
-
+} -cleanup {
+    # Reset to where we were
+    cd $savepwd
+    file rename [file join globTestContext globTest] globTest
+    file delete globTestContext
+} -result {globTest/a1/b1/x2.c globTest/a1/b2/y2.c}
 test filename-14.7 {asterisks, question marks, and brackets} {unix} {
     lsort [glob globTest/*]
 } {globTest/a1 globTest/a2 globTest/a3 {globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
@@ -1294,26 +1230,27 @@ test filename-14.13 {asterisks, question marks, and brackets} {unixOrPc} {
 test filename-14.15 {asterisks, question marks, and brackets} {unixOrPc} {
     lsort [glob globTest/*/]
 } {globTest/a1/ globTest/a2/ globTest/a3/}
-test filename-14.17 {asterisks, question marks, and brackets} {
+test filename-14.17 {asterisks, question marks, and brackets} -setup {
     global env
     set temp $env(HOME)
+} -body {
     set env(HOME) [file join $env(HOME) globTest]
-    set result [list [catch {glob ~/z*} msg] $msg]
+    glob ~/z*
+} -cleanup {
     set env(HOME) $temp
-    set result
-} [list 0 [list [file join $env(HOME) globTest z1.c]]]
+} -result [list [file join $env(HOME) globTest z1.c]]
 test filename-14.18 {asterisks, question marks, and brackets} {unixOrPc} {
-    list [catch {lsort [glob globTest/*.c goo/*]} msg] $msg
-} {0 {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}}
+    lsort [glob globTest/*.c goo/*]
+} {{globTest/weird name.c} globTest/x,z1.c globTest/x1.c globTest/y1.c globTest/z1.c}
 test filename-14.20 {asterisks, question marks, and brackets} {
-    list [catch {glob -nocomplain goo/*} msg] $msg
-} {0 {}}
-test filename-14.21 {asterisks, question marks, and brackets} {
-    list [catch {glob globTest/*/gorp} msg] $msg
-} {1 {no files matched glob pattern "globTest/*/gorp"}}
-test filename-14.22 {asterisks, question marks, and brackets} {
-    list [catch {glob goo/* x*z foo?q} msg] $msg
-} {1 {no files matched glob patterns "goo/* x*z foo?q"}}
+    glob -nocomplain goo/*
+} {}
+test filename-14.21 {asterisks, question marks, and brackets} -body {
+    glob globTest/*/gorp
+} -returnCodes error -result {no files matched glob pattern "globTest/*/gorp"}
+test filename-14.22 {asterisks, question marks, and brackets} -body {
+    glob goo/* x*z foo?q
+} -returnCodes error -result {no files matched glob patterns "goo/* x*z foo?q"}
 test filename-14.23 {slash globbing} {unix} {
     glob /
 } /
@@ -1324,88 +1261,116 @@ test filename-14.24 {slash globbing} {win} {
     glob {\\}
 } [file norm /]
 test filename-14.25 {type specific globbing} {unix} {
-    list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
-} [list 0 [lsort [list \
+    lsort [glob -dir globTest -types f *]
+} [lsort [list \
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-14.25.1 {type specific globbing} {win} {
-    list [catch {lsort [glob -dir globTest -types f *]} msg] $msg
-} [list 0 [lsort [list \
-        [file join $globname .1]\
+    lsort [glob -dir globTest -types f *]
+} [lsort [list \
+	[file join $globname .1]\
 	[file join $globname "weird name.c"]\
 	[file join $globname x,z1.c]\
 	[file join $globname x1.c]\
-	[file join $globname y1.c] [file join $globname z1.c]]]]
+	[file join $globname y1.c] [file join $globname z1.c]]]
 test filename-14.26 {type specific globbing} {
-    list [catch {glob -nocomplain -dir globTest -types {readonly} *} msg] $msg
-} [list 0 {}]
+    glob -nocomplain -dir globTest -types {readonly} *
+} {}
+test filename-14.27 {Bug 2710920} {unixOrPc} {
+    file tail [lindex [lsort [glob globTest/*/]] 0]
+} a1
+test filename-14.28 {Bug 2710920} {unixOrPc} {
+    file dirname [lindex [lsort [glob globTest/*/]] 0]
+} globTest
+test filename-14.29 {Bug 2710920} {unixOrPc} {
+    file extension [lindex [lsort [glob globTest/*/]] 0]
+} {}
+test filename-14.30 {Bug 2710920} {unixOrPc} {
+    file rootname [lindex [lsort [glob globTest/*/]] 0]
+} globTest/a1/
+
+test filename-14.31 {Bug 2918610} -setup {
+    set d [makeDirectory foo]
+    makeFile {} bar.soom $d
+} -body {
+    foreach fn [glob $d/bar.soom] {
+        set root [file rootname $fn]
+        close [open $root {WRONLY CREAT}]
+    }
+    llength [glob -directory $d *]
+} -cleanup {
+    file delete -force $d/bar
+    removeFile bar.soom $d
+    removeDirectory foo
+} -result 2
 
 unset globname
 
-# The following tests are only valid for Unix systems.
-# On some systems, like AFS, "000" protection doesn't prevent
-# access by owner, so the following test is not portable.
+# The following tests are only valid for Unix systems. On some systems, like
+# AFS, "000" protection doesn't prevent access by owner, so the following test
+# is not portable.
 
 catch {file attributes globTest/a1 -permissions 0000}
 test filename-15.1 {unix specific globbing} {unix nonPortable} {
-    string tolower [list [catch {glob globTest/a1/*} msg]  $msg $errorCode]
+    string tolower [list [catch {glob globTest/a1/*} msg] $msg $errorCode]
 } {1 {couldn't read directory "globtest/a1": permission denied} {posix eacces {permission denied}}}
 test filename-15.2 {unix specific no complain: no errors} {unix nonPortable} {
     glob -nocomplain globTest/a1/*
 } {}
 test filename-15.3 {unix specific no complain: no errors, good result} \
 	{unix nonPortable} {
-    # test fails because if an error occur , the interp's result
-    # is reset...
+    # test fails because if an error occurs, the interp's result is reset...
     glob -nocomplain globTest/a2 globTest/a1/* globTest/a3
 } {globTest/a2 globTest/a3}
-
 catch {file attributes globTest/a1 -permissions 0755}
 test filename-15.4 {unix specific no complain: no errors, good result} \
 	{unix nonPortable} {
-    # test fails because if an error occurs, the interp's result
-    # is reset... or you don't run at scriptics where the
-    # outser and welch users exists
+    # test fails because if an error occurs, the interp's result is reset...
+    # or you don't run at scriptics where the outser and welch users exists
     glob -nocomplain ~ouster ~foo ~welch
 } {/home/ouster /home/welch}
-test filename-15.4.1 {no complain: no errors, good result} {
-    # test used to fail because if an error occurs, the interp's result
-    # is reset... 
-    string equal [glob -nocomplain ~wontexist ~blah ~] \
-      [glob -nocomplain ~ ~blah ~wontexist]
-} {1}
+test filename-15.4.1 {no complain: errors, sequencing} {
+    # test used to fail because if an error occurs, the interp's result is
+    # reset... But, the sequence means we throw a different error first.
+    list [catch {glob -nocomplain ~wontexist ~blahxyz ~} res1] $res1 \
+	[catch {glob -nocomplain ~ ~blahxyz ~wontexist} res2] $res2
+} {1 {user "wontexist" doesn't exist} 1 {user "blahxyz" doesn't exist}}
+test filename-15.4.2 {no complain: errors, sequencing} -body {
+    # test used to fail because if an error occurs, the interp's result is
+    # reset...
+    list [list [catch {glob -nocomplain ~wontexist *} res1] $res1] \
+	[list [catch {glob -nocomplain * ~wontexist} res2] $res2]
+} -match compareWords -result equal
 test filename-15.5 {unix specific globbing} {unix nonPortable} {
     glob ~ouster/.csh*
 } "/home/ouster/.cshrc"
-catch {close [open globTest/odd\\\[\]*?\{\}name w]} 
-test filename-15.6 {unix specific globbing} {unix} {
+touch globTest/odd\\\[\]*?\{\}name
+test filename-15.6 {unix specific globbing} -constraints {unix} -setup {
     global env
     set temp $env(HOME)
+} -body {
     set env(HOME) $env(HOME)/globTest/odd\\\[\]*?\{\}name
-    set result [list [catch {glob ~} msg] $msg]
+    glob ~
+} -cleanup {
     set env(HOME) $temp
-    set result
-} [list 0 [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]]
+} -result [list [lindex [glob ~] 0]/globTest/odd\\\[\]*?\{\}name]
 catch {file delete -force globTest/odd\\\[\]*?\{\}name}
-test filename-15.7 {win specific globbing} {win} {
-    if {[string index [glob ~] end] == "/"} {
-	set res "glob ~ is [glob ~] but shouldn't end in a separator"
-    } else {
-	set res "ok"
-    }
-} {ok}
-test filename-15.8 {win and unix specific globbing} {unixOrWin} {
+test filename-15.7 {win specific globbing} -constraints {win} -body {
+    glob ~
+} -match regexp -result {[^/]$}
+test filename-15.8 {win and unix specific globbing} -constraints {unixOrWin} -setup {
     global env
     set temp $env(HOME)
-    catch {close [open $env(HOME)/globTest/anyname w]} err
+} -body {
+    touch $env(HOME)/globTest/anyname
     set env(HOME) $env(HOME)/globTest/anyname
-    set result [list [catch {glob ~} msg] $msg]
+    glob ~
+} -cleanup {
     set env(HOME) $temp
     catch {file delete -force $env(HOME)/globTest/anyname}
-    set result
-} [list 0 [list [lindex [glob ~] 0]/globTest/anyname]]
+} -result [list [lindex [glob ~] 0]/globTest/anyname]
 
 # The following tests are only valid for Windows systems.
 set oldDir [pwd]
@@ -1413,24 +1378,25 @@ if {[testConstraint win]} {
     cd c:/
     file delete -force globTest
     file mkdir globTest
-    close [open globTest/x1.BAT w]
-    close [open globTest/y1.Bat w]
-    close [open globTest/z1.bat w]
+    touch globTest/x1.BAT
+    touch globTest/y1.Bat
+    touch globTest/z1.bat
 }
 
 test filename-16.1 {windows specific globbing} {win} {
     lsort [glob globTest/*.bat]
 } {globTest/x1.BAT globTest/y1.Bat globTest/z1.bat}
 test filename-16.2 {windows specific globbing} {win} {
-    list [catch {glob c:} res] $res
-} {0 c:}
-test filename-16.2.1 {windows specific globbing} {win} {
+    glob c:
+} c:
+test filename-16.2.1 {windows specific globbing} -constraints {win} -setup {
     set dir [pwd]
+} -body {
     cd C:/
-    set res [list [catch {glob c:} err] $err]
+    glob c:
+} -cleanup {
     cd $dir
-    set res
-} {0 c:}
+} -result c:
 test filename-16.3 {windows specific globbing} {win} {
     glob -nocomplain c:\\\\
 } c:/
@@ -1458,13 +1424,7 @@ test filename-16.10 {windows specific globbing} {win} {
 test filename-16.11 {windows specific globbing} {win} {
     lsort [glob -nocomplain c:\\\\globTest\\\\*.bat]
 } {c:/globTest/x1.BAT c:/globTest/y1.Bat c:/globTest/z1.bat}
-
 # some tests require a shared C drive
-
-if {[testConstraint win]} {
-    testConstraint sharedCdrive [expr {![catch {cd //[info hostname]/c}]}]
-}
-
 test filename-16.12 {windows specific globbing} {win sharedCdrive} {
     cd //[info hostname]/c
     glob //[info hostname]/c/*Test
@@ -1475,7 +1435,7 @@ test filename-16.13 {windows specific globbing} {win sharedCdrive} {
 } //[info hostname]/c/globTest
 test filename-16.14 {windows specific globbing} {win} {
     cd [lindex [glob -types d -dir C:/ *] 0]
-    expr {[lsearch -exact [glob {{.,*}*}] ".."] != -1}
+    expr {".." in [glob {{.,*}*}]}
 } {1}
 test filename-16.15 {windows specific globbing} {win} {
     cd [lindex [glob -types d -dir C:/ *] 0]
@@ -1484,53 +1444,179 @@ test filename-16.15 {windows specific globbing} {win} {
 test filename-16.16 {windows specific globbing} {win} {
     file tail [lindex [glob -nocomplain "[lindex [glob -types d -dir C:/ *] 0]/.."] 0]
 } {..}
-test filename-16.17 {windows specific globbing} {win} {
+test filename-16.17 {windows specific globbing} -constraints {win} -body {
     cd C:/
-    # Ensure correct trimming of tails with absolute and
-    # volume relative globbing.
-    set res1 [glob -nocomplain -tails -dir C:/ *]
-    set res2 [glob -nocomplain -tails -dir C: *]
-    if {$res1 eq $res2} {
-	concat ok
-    } else {
-        concat $res1 ne $res2
-    }
-} {ok}
+    # Ensure correct trimming of tails with absolute and volume relative
+    # globbing.
+    list [glob -nocomplain -tails -dir C:/ *] \
+	[glob -nocomplain -tails -dir C: *]
+} -match compareWords -result equal
+
+# Put the working directory back now that we're done with globbing in C:/
+if {[testConstraint win]} {
+    cd $oldDir
+}
 
 test filename-17.1 {windows specific special files} {testsetplatform} {
     testsetplatform win
     list [file pathtype com1] [file pathtype con] [file pathtype lpt3] \
-      [file pathtype prn] [file pathtype nul] [file pathtype aux] \
-      [file pathtype foo]
+	[file pathtype prn] [file pathtype nul] [file pathtype aux] \
+	[file pathtype foo]
 } {absolute absolute absolute absolute absolute absolute relative}
 if {[testConstraint testsetplatform]} {
     testsetplatform $platform
 }
-
-test filename-17.2 {windows specific glob with executable} {win} {
+test filename-17.2 {windows specific glob with executable} -body {
     makeDirectory execglob
     makeFile contents execglob/abc.exe
     makeFile contents execglob/abc.notexecutable
-    set res [glob -nocomplain -dir [temporaryDirectory]/execglob \
-      -tails -types x *]
+    glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *
+} -constraints {win} -cleanup {
     removeFile execglob/abc.exe
     removeFile execglob/abc.notexecutable
     removeDirectory execglob
-    set res
-} {abc.exe}
+} -result {abc.exe}
+test filename-17.3 {Bug 2571597} win {
+    set p /a
+    file pathtype $p
+    file normalize $p
+    file pathtype $p
+} volumerelative
 
 test fileName-18.1 {windows - split ADS name correctly} {win} {
     # bug 1194458
     set x [file split c:/c:d]
-    set y [eval [linsert $x 0 file join]]
-    list $x $y
+    list $x [file join {*}$x]
 } {{c:/ ./c:d} c:/c:d}
 
+test fileName-19.1 {ensure that [Bug 1325099] stays fixed} {
+    # Any non-crashing result is OK
+    list [file exists ~//.nonexistant_file] [file exists ~///.nonexistant_file]
+} {0 0}
+
+test fileName-20.1 {Bug 1750300} -setup {
+    set d [makeDirectory foo]
+    makeFile {} TAGS $d
+} -body {
+    llength [glob -nocomplain -directory $d -- TAGS one two]
+} -cleanup {
+    removeFile TAGS $d
+    removeDirectory foo
+} -result 1
+test fileName-20.2 {Bug 1750300} -setup {
+    set d [makeDirectory foo]
+    makeFile {} TAGS $d
+} -body {
+    llength [glob -nocomplain -directory $d -types {} -- TAGS one two]
+} -cleanup {
+    removeFile TAGS $d
+    removeDirectory foo
+} -result 1
+test fileName-20.3 {Bug 1750300} -setup {
+    set d [makeDirectory foo]
+    makeFile {} TAGS $d
+} -body {
+    llength [glob -nocomplain -directory $d -types {} -- *U*]
+} -cleanup {
+    removeFile TAGS $d
+    removeDirectory foo
+} -result 0
+test fileName-20.4 {Bug 1750300} -setup {
+    set d [makeDirectory foo]
+    makeFile {} TAGS $d
+} -body {
+    llength [glob -nocomplain -directory $d -types {} -- URGENT Urkle]
+} -cleanup {
+    removeFile TAGS $d
+    removeDirectory foo
+} -result 0
+test fileName-20.5 {Bug 2837800} -setup {
+    set dd [makeDirectory isolate]
+    set d [makeDirectory ./~foo $dd]
+    makeFile {} test $d
+    set savewd [pwd]
+    cd $dd
+} -body {
+    glob -nocomplain */test
+} -cleanup {
+    cd $savewd
+    removeFile test $d
+    removeDirectory ./~foo $dd
+    removeDirectory isolate
+} -result ~foo/test
+test fileName-20.6 {Bug 2837800} -setup {
+    # Recall that we have $env(HOME) set so that references
+    # to ~ point to [temporaryDirectory]
+    makeFile {} test ~
+    set dd [makeDirectory isolate]
+    set d [makeDirectory ./~ $dd]
+    set savewd [pwd]
+    cd $dd
+} -body {
+    glob -nocomplain */test
+} -cleanup {
+    cd $savewd
+    removeDirectory ./~ $dd
+    removeDirectory isolate
+    removeFile test ~
+} -result {}
+test fileName-20.7 {Bug 2806250} -setup {
+    set savewd [pwd]
+    cd [temporaryDirectory]
+    set d [makeDirectory isolate]
+    makeFile {} ./~test $d
+} -body {
+    file exists [lindex [glob -nocomplain isolate/*] 0]
+} -cleanup {
+    removeFile ./~test $d
+    removeDirectory isolate
+    cd $savewd
+} -result 1
+test fileName-20.8 {Bug 2806250} -setup {
+    set savewd [pwd]
+    cd [temporaryDirectory]
+    set d [makeDirectory isolate]
+    makeFile {} ./~test $d
+} -body {
+    file tail [lindex [glob -nocomplain isolate/*] 0]
+} -cleanup {
+    removeFile ./~test $d
+    removeDirectory isolate
+    cd $savewd
+} -result ./~test
+test fileName-20.9 {globbing for special chars} -setup {
+    makeFile {} test ~
+    set d [makeDirectory isolate]
+    set savewd [pwd]
+    cd $d
+} -body {
+   glob -nocomplain -directory ~ test
+} -cleanup {
+    cd $savewd
+    removeDirectory isolate
+    removeFile test ~
+} -result ~/test
+test fileName-20.10 {globbing for special chars} -setup {
+    set s [makeDirectory sub ~]
+    makeFile {} fileName-20.10 $s
+    set d [makeDirectory isolate]
+    set savewd [pwd]
+    cd $d
+} -body {
+   glob -nocomplain -directory ~ -join * fileName-20.10
+} -cleanup {
+    cd $savewd
+    removeDirectory isolate
+    removeFile fileName-20.10 $s
+    removeDirectory sub ~
+} -result ~/sub/fileName-20.10
+
 # cleanup
 catch {file delete -force C:/globTest}
 cd [temporaryDirectory]
 file delete -force globTest
 cd $oldpwd
+catch {removeDirectory tcl[pid]}
 set env(HOME) $oldhome
 if {[testConstraint testsetplatform]} {
     testsetplatform $platform
@@ -1539,3 +1625,7 @@ if {[testConstraint testsetplatform]} {
 catch {unset oldhome temp result globPreResult}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index 3c0bac2..942a86c 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -1,31 +1,35 @@
 # This file tests the filesystem and vfs internals.
 #
-# 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) 2002 Vincent Darley.
 #
-# 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.
 
 package require tcltest 2
 namespace eval ::tcl::test::fileSystem {
+    namespace import ::tcltest::*
 
-    namespace import ::tcltest::cleanupTests
-    namespace import ::tcltest::makeDirectory
-    namespace import ::tcltest::makeFile
-    namespace import ::tcltest::removeDirectory
-    namespace import ::tcltest::removeFile
-    namespace import ::tcltest::test
-    namespace import ::tcltest::testConstraint
-    
     catch {
 	file delete -force link.file
 	file delete -force dir.link
 	file delete -force [file join dir.dir linkinside.file]
     }
 
+testConstraint loaddll 0
+catch {
+    ::tcltest::loadTestedCommands
+    package require -exact Tcltest [info patchlevel]
+    set ::ddever [package require dde]
+    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]
+    set ::regver  [package require registry]
+    set ::reglib [lindex [package ifneeded registry $::regver] 1]
+    testConstraint loaddll 1
+}
+
 # Test for commands defined in Tcltest executable
 testConstraint testfilesystem  	    [llength [info commands ::testfilesystem]]
 testConstraint testsetplatform 	    [llength [info commands ::testsetplatform]]
@@ -38,44 +42,39 @@ makeDirectory [file join dir.dir dirinside.dir]
 makeFile "test file in directory" [file join dir.dir inside.file]
 
 testConstraint unusedDrive 0
-set drive {}
-if {$::tcl_platform(platform) eq "windows"} {
-    set vols [string map [list :/ {}] [file volumes]]
-    for {set i 0} {$i < 26} {incr i} {
-	set drive [format %c [expr {$i + 65}]]
-	if {[lsearch -exact $vols $drive] == -1} {
-	    testConstraint unusedDrive 1
-	    break
+testConstraint moreThanOneDrive 0
+apply {{} {
+    # The variables 'drive' and 'drives' will be used below.
+    variable drive {} drives {}
+    if {[testConstraint win]} {
+	set vols [string map [list :/ {}] [file volumes]]
+	for {set i 0} {$i < 26} {incr i} {
+	    set drive [format %c [expr {$i + 65}]]
+	    if {$drive ni $vols} {
+		testConstraint unusedDrive 1
+		break
+	    }
 	}
-    }
-    unset i vols
-    # The variable 'drive' will be used below
-}
 
-testConstraint moreThanOneDrive 0
-set drives [list]
-if {$::tcl_platform(platform) eq "windows"} {
-    set dir [pwd]
-    foreach vol [file volumes] {
-        if {![catch {cd $vol}]} {
-            lappend drives $vol
-        }
-    }
-    if {[llength $drives] > 1} {
-        testConstraint moreThanOneDrive 1
+	set dir [pwd]
+	try {
+	    foreach vol [file volumes] {
+		if {![catch {cd $vol}]} {
+		    lappend drives $vol
+		}
+	    }
+	    testConstraint moreThanOneDrive [llength $drives]
+	} finally {
+	    cd $dir
+	}
     }
-    # The variable 'drives' will be used below
-    unset vol
-    cd $dir
-    unset dir
-}
+} ::tcl::test::fileSystem}
 
 proc testPathEqual {one two} {
     if {$one eq $two} {
-	return 1
-    } else {
-	return "not equal: $one $two"
+	return "ok"
     }
+    return "not equal: $one $two"
 }
 
 testConstraint hasLinks [expr {![catch {
@@ -95,6 +94,8 @@ testConstraint hasLinks [expr {![catch {
 if {[testConstraint testsetplatform]} {
     set platform [testgetplatform]
 }
+
+# ----------------------------------------------------------------------
 
 test filesystem-1.0 {link normalisation} {hasLinks} {
    string equal [file normalize gorp.file] [file normalize link.file]
@@ -105,48 +106,54 @@ test filesystem-1.1 {link normalisation} {hasLinks} {
 test filesystem-1.2 {link normalisation} {hasLinks unix} {
     testPathEqual [file normalize [file join gorp.file foo]] \
 	[file normalize [file join link.file foo]]
-} {1}
+} ok
 test filesystem-1.3 {link normalisation} {hasLinks} {
     testPathEqual [file normalize [file join dir.dir foo]] \
 	[file normalize [file join dir.link foo]]
-} {1}
+} ok
 test filesystem-1.4 {link normalisation} {hasLinks} {
     testPathEqual [file normalize [file join dir.dir inside.file]] \
 	[file normalize [file join dir.link inside.file]]
-} {1}
+} ok
 test filesystem-1.5 {link normalisation} {hasLinks} {
     testPathEqual [file normalize [file join dir.dir linkinside.file]] \
 	[file normalize [file join dir.dir linkinside.file]]
-} {1}
+} ok
 test filesystem-1.6 {link normalisation} {hasLinks} {
-   string equal [file normalize [file join dir.dir linkinside.file]] \
-     [file normalize [file join dir.link inside.file]]
+    string equal [file normalize [file join dir.dir linkinside.file]] \
+	[file normalize [file join dir.link inside.file]]
 } {0}
 test filesystem-1.7 {link normalisation} {hasLinks unix} {
     testPathEqual [file normalize [file join dir.link linkinside.file foo]] \
 	[file normalize [file join dir.dir inside.file foo]]
-} {1}
+} ok
 test filesystem-1.8 {link normalisation} {hasLinks} {
-   string equal [file normalize [file join dir.dir linkinside.filefoo]] \
-       [file normalize [file join dir.link inside.filefoo]]
+    string equal [file normalize [file join dir.dir linkinside.filefoo]] \
+	[file normalize [file join dir.link inside.filefoo]]
 } {0}
-test filesystem-1.9 {link normalisation} {unix hasLinks} {
+test filesystem-1.9 {link normalisation} -setup {
     file delete -force dir.link
+} -constraints {unix hasLinks} -body {
     file link dir.link [file nativename dir.dir]
     testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
 	[file normalize [file join dir.link inside.file foo]]
-} {1}
-test filesystem-1.10 {link normalisation: double link} {unix hasLinks} {
+} -result ok
+test filesystem-1.10 {link normalisation: double link} -constraints {
+    unix hasLinks
+} -body {
     file link dir2.link dir.link
     testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
 	[file normalize [file join dir2.link inside.file foo]]
-} {1}
+} -cleanup {
+    file delete dir2.link
+} -result ok 
 makeDirectory dir2.file
 test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
+    file link dir2.link dir.link
     file link [file join dir2.file dir2.link] [file join .. dir2.link]
     testPathEqual [file normalize [file join dir.dir linkinside.file foo]] \
 	[file normalize [file join dir2.file dir2.link inside.file foo]]
-} {1}
+} ok
 test filesystem-1.12 {file new native path} {} {
     for {set i 0} {$i < 10} {incr i} {
 	foreach f [lsort [glob -nocomplain -type l *]] {
@@ -203,62 +210,49 @@ test filesystem-1.25 {file normalisation} {win unusedDrive} {
 test filesystem-1.25.1 {file normalisation} {win unusedDrive} {
     file normalize ${drive}:/./.././..\\..\\a\\bb
 } "${drive}:/a/bb"
-test filesystem-1.26 {link normalisation: link and ..} {hasLinks} {
+test filesystem-1.26 {link normalisation: link and ..} -setup {
     file delete -force dir2.link
+} -constraints {hasLinks} -body {
     set dir [file join dir2 foo bar]
     file mkdir $dir
     file link dir2.link [file join dir2 foo bar]
-    set res [list [file normalize [file join dir2 foo x]] \
-	    [file normalize [file join dir2.link .. x]]]
-    if {![string equal [lindex $res 0] [lindex $res 1]]} {
-	set res "$res not equal"
-    } else {
-	set res "ok"
-    }
-} {ok}
+    testPathEqual [file normalize [file join dir2 foo x]] \
+	    [file normalize [file join dir2.link .. x]]
+} -result ok
 test filesystem-1.27 {file normalisation: up and down with ..} {
     set dir [file join dir2 foo bar]
     file mkdir $dir
     set dir2 [file join dir2 .. dir2 foo .. foo bar]
-    set res [list [file normalize $dir] [file normalize $dir2]]
-    set res2 [list [file exists $dir] [file exists $dir2]]
-    if {![string equal [lindex $res 0] [lindex $res 1]]} {
-	set res "exists: $res2, $res not equal"
-    } else {
-	set res "ok: $res2"
-    }
-} {ok: 1 1}
-test filesystem-1.28 {link normalisation: link with .. and ..} {hasLinks} {
+    list [testPathEqual [file normalize $dir] [file normalize $dir2]] \
+	[file exists $dir] [file exists $dir2]
+} {ok 1 1}
+test filesystem-1.28 {link normalisation: link with .. and ..} -setup {
     file delete -force dir2.link
+} -constraints {hasLinks} -body {
     set dir [file join dir2 foo bar]
     file mkdir $dir
     set to [file join dir2 .. dir2 foo .. foo bar]
     file link dir2.link $to
-    set res [list [file normalize [file join dir2 foo x]] \
-	    [file normalize [file join dir2.link .. x]]]
-    if {![string equal [lindex $res 0] [lindex $res 1]]} {
-	set res "$res not equal"
-    } else {
-	set res "ok"
-    }
-} {ok}
-test filesystem-1.29 {link normalisation: link with ..} {hasLinks} {
+    testPathEqual [file normalize [file join dir2 foo x]] \
+	    [file normalize [file join dir2.link .. x]]
+} -result ok
+test filesystem-1.29 {link normalisation: link with ..} -setup {
     file delete -force dir2.link
+} -constraints {hasLinks} -body {
     set dir [file join dir2 foo bar]
     file mkdir $dir
     set to [file join dir2 .. dir2 foo .. foo bar]
     file link dir2.link $to
     set res [file normalize [file join dir2.link x yyy z]]
-    if {[string first ".." $res] != -1} {
-	set res "$res must not contain '..'"
-    } else {
-	set res "ok"
+    if {[string match *..* $res]} {
+	return "$res must not contain '..'"
     }
-} {ok}
+    return "ok"
+} -result {ok}
 test filesystem-1.29.1 {link normalisation with two consecutive links} {hasLinks} {
     testPathEqual [file normalize [file join dir.link dirinside.link abc]] \
 	[file normalize [file join dir.dir dirinside.dir abc]]
-} {1}
+} ok
 file delete -force dir2.file
 file delete -force dir2.link
 file delete -force link.file dir.link
@@ -267,9 +261,9 @@ file delete -force [file join dir.dir dirinside.link]
 removeFile [file join dir.dir inside.file]
 removeDirectory [file join dir.dir dirinside.dir]
 removeDirectory dir.dir
-test filesystem-1.30 {normalisation of nonexistent user} {
-    list [catch {file normalize ~noonewiththisname} err] $err
-} {1 {user "noonewiththisname" doesn't exist}}
+test filesystem-1.30 {normalisation of nonexistent user} -body {
+    file normalize ~noonewiththisname
+} -returnCodes error -result {user "noonewiththisname" doesn't exist}
 test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
     testsetplatform unix
     file normalize /foo/../bar
@@ -281,9 +275,9 @@ test filesystem-1.32 {link normalisation: link near filesystem root} {testsetpla
 test filesystem-1.33 {link normalisation: link near filesystem root} {testsetplatform} {
     testsetplatform windows
     set res [file normalize C:/../bar]
-    if {$::tcl_platform(platform) == "unix"} {
-	# Some unices go further in normalizing this -- not really
-	# a problem since this is a Windows test
+    if {[testConstraint unix]} {
+	# Some unices go further in normalizing this -- not really a problem
+	# since this is a Windows test.
 	regexp {C:/bar$} $res res
     }
     set res
@@ -291,391 +285,347 @@ test filesystem-1.33 {link normalisation: link near filesystem root} {testsetpla
 if {[testConstraint testsetplatform]} {
     testsetplatform $platform
 }
-test filesystem-1.34 {file normalisation with '/./'} {
-    set res [file normalize /foo/bar/anc/./.tml]
-    if {[string first "/./" $res] != -1} {
-	set res "normalization of /foo/bar/anc/./.tml is: $res"
-    } else {
-	set res "ok"
-    }
-    set res
-} {ok}
-test filesystem-1.35 {file normalisation with '/./'} {
-    set res [file normalize /ffo/bar/anc/./foo/.tml]
-    if {[string first "/./" $res] != -1 || ([regsub -all "foo" $res "" reg] == 2)} {
-	set res "normalization of /ffo/bar/anc/./foo/.tml is: $res"
-    } else {
-	set res "ok"
-    }
-    set res
-} {ok}
-test filesystem-1.36 {file normalisation with '/./'} {
-    set res [file normalize /foo/bar/anc/././asdasd/.tml]
-    if {[string first "/./" $res] != -1 || ([regsub -all "asdasd" $res "" reg] == 2) } {
-	set res "normalization of /foo/bar/anc/././asdasd/.tml is: $res"
-    } else {
-	set res "ok"
-    }
-    set res
-} {ok}
-test filesystem-1.37 {file normalisation with '/./'} {
+test filesystem-1.34 {file normalisation with '/./'} -body {
+    file normalize /foo/bar/anc/./.tml
+} -match regexp -result {^(?:(?!/\./).)*$}
+test filesystem-1.35a {file normalisation with '/./'} -body {
+    file normalize /ffo/bar/anc/./foo/.tml
+} -match regexp -result {^(?:(?!/\./).)*$}
+test filesystem-1.35b {file normalisation with '/./'} {
+    llength [regexp -all foo [file normalize /ffo/bar/anc/./foo/.tml]]
+} 1
+test filesystem-1.36a {file normalisation with '/./'} -body {
+    file normalize /foo/bar/anc/././asdasd/.tml
+} -match regexp -result {^(?:(?!/\./).)*$}
+test filesystem-1.36b {file normalisation with '/./'} {
+    llength [regexp -all asdasd [file normalize /foo/bar/anc/././asdasd/.tml]]
+} 1
+test filesystem-1.37 {file normalisation with '/./'} -body {
     set fname "/abc/./def/./ghi/./asda/.././.././asd/x/../../../../....."
-    set res [file norm $fname]
-    if {[string first "//" $res] != -1} {
-	set res "normalization of $fname is: $res"
-    } else {
-	set res "ok"
-    }
-    set res
-} {ok}
-test filesystem-1.38 {file normalisation with volume relative} \
-  {win moreThanOneDrive} {
-    set path "[string range [lindex $drives 0] 0 1]foo"
+    file norm $fname
+} -match regexp -result {^(?:[^/]|/(?:[^/]|$))+$}
+test filesystem-1.38 {file normalisation with volume relative} -setup {
     set dir [pwd]
+} -constraints {win moreThanOneDrive} -body {
+    set path "[string range [lindex $drives 0] 0 1]foo"
     cd [lindex $drives 1]
-    set res [file norm $path]
+    file norm $path
+} -cleanup {
     cd $dir
-    set res
-} "[lindex $drives 0]foo"
-test filesystem-1.39 {file normalisation with volume relative} {win} {
-    set drv C:/
-    set dir [lindex [glob -type d -dir $drv *] 0]
+} -result "[lindex $drives 0]foo"
+test filesystem-1.39 {file normalisation with volume relative} -setup {
     set old [pwd]
-    cd $dir
-    set res [file norm [string range $drv 0 1]]
+} -constraints {win} -body {
+    set drv C:/
+    cd [lindex [glob -type d -dir $drv *] 0]
+    file norm [string range $drv 0 1]
+} -cleanup {
     cd $old
-    if {[string index $res end] eq "/"} {
-        set res "Bad normalized path: $res"
-    } else {
-        set res "ok"
-    }
-} {ok}
+} -match regexp -result {.*[^/]}
 test filesystem-1.40 {file normalisation with repeated separators} {
-    set a [file norm foo////bar]
-    set b [file norm foo/bar]
-    
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm foo////bar] [file norm foo/bar]
+} ok
 test filesystem-1.41 {file normalisation with repeated separators} {win} {
-    set a [file norm foo\\\\\\bar]
-    set b [file norm foo/bar]
-    
-    if {![string equal $a $b]} {
-        set res "Paths should be equal: $a , $b"
-    } else {
-        set res "ok"
-    }
-} {ok}
+    testPathEqual [file norm foo\\\\\\bar] [file norm foo/bar]
+} ok
+test filesystem-1.42 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /xxx/..] [file norm /]
+} ok
+test filesystem-1.42.1 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /xxx/../] [file norm /]
+} ok
+test filesystem-1.43 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /xxx/foo/../..] [file norm /]
+} ok
+test filesystem-1.43.1 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /xxx/foo/../../] [file norm /]
+} ok
+test filesystem-1.44 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /xxx/foo/../../bar] [file norm /bar]
+} ok
+test filesystem-1.45 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /xxx/../../bar] [file norm /bar]
+} ok
+test filesystem-1.46 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /xxx/../bar] [file norm /bar]
+} ok
+test filesystem-1.47 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /..] [file norm /]
+} ok
+test filesystem-1.48 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /../] [file norm /]
+} ok
+test filesystem-1.49 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /.] [file norm /]
+} ok
+test filesystem-1.50 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /./] [file norm /]
+} ok
+test filesystem-1.51 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /../..] [file norm /]
+} ok
+test filesystem-1.51.1 {file normalisation .. beyond root (Bug 1379287)} {
+    testPathEqual [file norm /../../] [file norm /]
+} ok
 
 test filesystem-2.0 {new native path} {unix} {
    foreach f [lsort [glob -nocomplain /usr/bin/c*]] {
        catch {file readlink $f}
    }
    # If we reach here we've succeeded. We used to crash above.
-   expr 1
-} {1}
+   return ok
+} ok
 
 # Make sure the testfilesystem hasn't been registered.
 if {[testConstraint testfilesystem]} {
+  proc resetfs {} {
     while {![catch {testfilesystem 0}]} {}
+  }
 }
 
-test filesystem-3.0 {Tcl_FSRegister} testfilesystem {
-    testfilesystem 1
-} {registered}
-test filesystem-3.1 {Tcl_FSUnregister} testfilesystem {
-    testfilesystem 0
-} {unregistered}
-test filesystem-3.2 {Tcl_FSUnregister} testfilesystem {
-    list [catch {testfilesystem 0} err] $err
-} {1 failed}
+test filesystem-3.1 {Tcl_FSRegister & Tcl_FSUnregister} testfilesystem {
+    set result {}
+    lappend result [testfilesystem 1]
+    lappend result [testfilesystem 0]
+    lappend result [catch {testfilesystem 0} msg] $msg
+} {registered unregistered 1 failed}
 test filesystem-3.3 {Tcl_FSRegister} testfilesystem {
     testfilesystem 1
     testfilesystem 1
     testfilesystem 0
     testfilesystem 0
 } {unregistered}
-test filesystem-3.4 {Tcl_FSRegister} testfilesystem {
+test filesystem-3.4 {Tcl_FSRegister} -constraints testfilesystem -body {
     testfilesystem 1
     file system bar
-} {reporting}
-test filesystem-3.5 {Tcl_FSUnregister} testfilesystem {
+} -cleanup {
     testfilesystem 0
+} -result {reporting}
+test filesystem-3.5 {Tcl_FSUnregister} testfilesystem {
+    resetfs
     lindex [file system bar] 0
 } {native}
 
-test filesystem-4.0 {testfilesystem} {
-    -constraints testfilesystem
-    -match glob
-    -body {
-	testfilesystem 1
-	set filesystemReport {}
-	file exists foo
-	testfilesystem 0
-	set filesystemReport
-    }
-    -result {*{access foo}}
-}
-test filesystem-4.1 {testfilesystem} {
-    -constraints testfilesystem
-    -match glob
-    -body {
-	testfilesystem 1
-	set filesystemReport {}
-	catch {file stat foo bar}
-	testfilesystem 0
-	set filesystemReport
-    }
-    -result {*{stat foo}}
-}
-test filesystem-4.2 {testfilesystem} {
-    -constraints testfilesystem
-    -match glob
-    -body {
-	testfilesystem 1
-	set filesystemReport {}
-	catch {file lstat foo bar}
-	testfilesystem 0
-	set filesystemReport
-    }
-    -result {*{lstat foo}}
-}
-test filesystem-4.3 {testfilesystem} {
-    -constraints testfilesystem
-    -match glob
-    -body {
-	testfilesystem 1
-	set filesystemReport {}
-	catch {glob *}
-	testfilesystem 0
-	set filesystemReport
-    }
-    -result {*{matchindirectory *}*}
-}
+test filesystem-4.0 {testfilesystem} -constraints testfilesystem -body {
+    testfilesystem 1
+    set filesystemReport {}
+    file exists foo
+    testfilesystem 0
+    return $filesystemReport
+} -match glob -result {*{access foo}}
+test filesystem-4.1 {testfilesystem} -constraints testfilesystem -body {
+    testfilesystem 1
+    set filesystemReport {}
+    catch {file stat foo bar}
+    testfilesystem 0
+    return $filesystemReport
+} -match glob -result {*{stat foo}}
+test filesystem-4.2 {testfilesystem} -constraints testfilesystem -body {
+    testfilesystem 1
+    set filesystemReport {}
+    catch {file lstat foo bar}
+    testfilesystem 0
+    return $filesystemReport
+} -match glob -result {*{lstat foo}}
+test filesystem-4.3 {testfilesystem} -constraints testfilesystem -body {
+    testfilesystem 1
+    set filesystemReport {}
+    catch {glob *}
+    testfilesystem 0
+    return $filesystemReport
+} -match glob -result {*{matchindirectory *}*}
 
-test filesystem-5.1 {cache and ~} {
-    -constraints testfilesystem
-    -match regexp
-    -body {
-	set orig $env(HOME)
-	set ::env(HOME) /foo/bar/blah
-	set testdir ~
-	set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
-	set ::env(HOME) /a/b/c
-	set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
-	set ::env(HOME) $orig
-	list $res1 $res2
-    }
-    -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/a/b|a:b)}}
-}
+test filesystem-5.1 {cache and ~} -constraints testfilesystem -setup {
+    set orig $::env(HOME)
+} -body {
+    set ::env(HOME) /foo/bar/blah
+    set testdir ~
+    set res1 "Parent of ~ (/foo/bar/blah) is [file dirname $testdir]"
+    set ::env(HOME) /a/b/c
+    set res2 "Parent of ~ (/a/b/c) is [file dirname $testdir]"
+    list $res1 $res2
+} -cleanup {
+    set ::env(HOME) $orig
+} -match regexp -result {{Parent of ~ \(/foo/bar/blah\) is ([a-zA-Z]:)?(/cygwin)?(/foo/bar|foo:bar)} {Parent of ~ \(/a/b/c\) is ([a-zA-Z]:)?(/cygwin)?(/a/b|a:b)}}
 
-test filesystem-6.1 {empty file name} {
-    list [catch {open ""} msg] $msg
-} {1 {couldn't open "": no such file or directory}}
-test filesystem-6.2 {empty file name} {
-    list [catch {file stat "" arr} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.3 {empty file name} {
-    list [catch {file atime ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.4 {empty file name} {
-    list [catch {file attributes ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.5 {empty file name} {
-    list [catch {file copy "" ""} msg] $msg
-} {1 {error copying "": no such file or directory}}
-test filesystem-6.6 {empty file name} {
-    list [catch {file delete ""} msg] $msg
-} {0 {}}
-test filesystem-6.7 {empty file name} {
-    list [catch {file dirname ""} msg] $msg
-} {0 .}
-test filesystem-6.8 {empty file name} {
-    list [catch {file executable ""} msg] $msg
-} {0 0}
-test filesystem-6.9 {empty file name} {
-    list [catch {file exists ""} msg] $msg
-} {0 0}
-test filesystem-6.10 {empty file name} {
-    list [catch {file extension ""} msg] $msg
-} {0 {}}
-test filesystem-6.11 {empty file name} {
-    list [catch {file isdirectory ""} msg] $msg
-} {0 0}
-test filesystem-6.12 {empty file name} {
-    list [catch {file isfile ""} msg] $msg
-} {0 0}
-test filesystem-6.13 {empty file name} {
-    list [catch {file join ""} msg] $msg
-} {0 {}}
-test filesystem-6.14 {empty file name} {
-    list [catch {file link ""} msg] $msg
-} {1 {could not read link "": no such file or directory}}
-test filesystem-6.15 {empty file name} {
-    list [catch {file lstat "" arr} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.16 {empty file name} {
-    list [catch {file mtime ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.17 {empty file name} {
-    list [catch {file mtime "" 0} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.18 {empty file name} {
-    list [catch {file mkdir ""} msg] $msg
-} {1 {can't create directory "": no such file or directory}}
-test filesystem-6.19 {empty file name} {
-    list [catch {file nativename ""} msg] $msg
-} {0 {}}
-test filesystem-6.20 {empty file name} {
-    list [catch {file normalize ""} msg] $msg
-} {0 {}}
-test filesystem-6.21 {empty file name} {
-    list [catch {file owned ""} msg] $msg
-} {0 0}
-test filesystem-6.22 {empty file name} {
-    list [catch {file pathtype ""} msg] $msg
-} {0 relative}
-test filesystem-6.23 {empty file name} {
-    list [catch {file readable ""} msg] $msg
-} {0 0}
-test filesystem-6.24 {empty file name} {
-    list [catch {file readlink ""} msg] $msg
-} {1 {could not readlink "": no such file or directory}}
-test filesystem-6.25 {empty file name} {
-    list [catch {file rename "" ""} msg] $msg
-} {1 {error renaming "": no such file or directory}}
-test filesystem-6.26 {empty file name} {
-    list [catch {file rootname ""} msg] $msg
-} {0 {}}
-test filesystem-6.27 {empty file name} {
-    list [catch {file separator ""} msg] $msg
-} {1 {Unrecognised path}}
-test filesystem-6.28 {empty file name} {
-    list [catch {file size ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.29 {empty file name} {
-    list [catch {file split ""} msg] $msg
-} {0 {}}
-test filesystem-6.30 {empty file name} {
-    list [catch {file system ""} msg] $msg
-} {1 {Unrecognised path}}
-test filesystem-6.31 {empty file name} {
-    list [catch {file tail ""} msg] $msg
-} {0 {}}
-test filesystem-6.32 {empty file name} {
-    list [catch {file type ""} msg] $msg
-} {1 {could not read "": no such file or directory}}
-test filesystem-6.33 {empty file name} {
-    list [catch {file writable ""} msg] $msg
-} {0 0}
+test filesystem-6.1 {empty file name} -returnCodes error -body {
+    open ""
+} -result {couldn't open "": no such file or directory}
+test filesystem-6.2 {empty file name} -returnCodes error -body {
+    file stat "" arr
+} -result {could not read "": no such file or directory}
+test filesystem-6.3 {empty file name} -returnCodes error -body {
+    file atime ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.4 {empty file name} -returnCodes error -body {
+    file attributes ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.5 {empty file name} -returnCodes error -body {
+    file copy "" ""
+} -result {error copying "": no such file or directory}
+test filesystem-6.6 {empty file name} {file delete ""} {}
+test filesystem-6.7 {empty file name} {file dirname ""} .
+test filesystem-6.8 {empty file name} {file executable ""} 0
+test filesystem-6.9 {empty file name} {file exists ""} 0
+test filesystem-6.10 {empty file name} {file extension ""} {}
+test filesystem-6.11 {empty file name} {file isdirectory ""} 0
+test filesystem-6.12 {empty file name} {file isfile ""} 0
+test filesystem-6.13 {empty file name} {file join ""} {}
+test filesystem-6.14 {empty file name} -returnCodes error -body {
+    file link ""
+} -result {could not read link "": no such file or directory}
+test filesystem-6.15 {empty file name} -returnCodes error -body {
+    file lstat "" arr
+} -result {could not read "": no such file or directory}
+test filesystem-6.16 {empty file name} -returnCodes error -body {
+    file mtime ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.17 {empty file name} -returnCodes error -body {
+    file mtime "" 0
+} -result {could not read "": no such file or directory}
+test filesystem-6.18 {empty file name} -returnCodes error -body {
+    file mkdir ""
+} -result {can't create directory "": no such file or directory}
+test filesystem-6.19 {empty file name} {file nativename ""} {}
+test filesystem-6.20 {empty file name} {file normalize ""} {}
+test filesystem-6.21 {empty file name} {file owned ""} 0
+test filesystem-6.22 {empty file name} {file pathtype ""} relative
+test filesystem-6.23 {empty file name} {file readable ""} 0
+test filesystem-6.24 {empty file name} -returnCodes error -body {
+    file readlink ""
+} -result {could not read link "": no such file or directory}
+test filesystem-6.25 {empty file name} -returnCodes error -body {
+    file rename "" ""
+} -result {error renaming "": no such file or directory}
+test filesystem-6.26 {empty file name} {file rootname ""} {}
+test filesystem-6.27 {empty file name} -returnCodes error -body {
+    file separator ""
+} -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}
+test filesystem-6.31 {empty file name} {file tail ""} {}
+test filesystem-6.32 {empty file name} -returnCodes error -body {
+    file type ""
+} -result {could not read "": no such file or directory}
+test filesystem-6.33 {empty file name} {file writable ""} 0
 
 # Make sure the testfilesystem hasn't been registered.
 if {[testConstraint testfilesystem]} {
     while {![catch {testfilesystem 0}]} {}
 }
 
-test filesystem-7.1 {load from vfs} {win testsimplefilesystem} {
-    # This may cause a crash on exit
+test filesystem-7.1.1 {load from vfs} -setup {
     set dir [pwd]
-    cd [file dirname [info nameof]]
-    set dde [lindex [glob *dde*[info sharedlib]] 0]
+} -constraints {win testsimplefilesystem loaddll} -body {
+    # This may cause a crash on exit
+    cd [file dirname $::ddelib]
     testsimplefilesystem 1
     # This loads dde via a complex copy-to-temp operation
-    load simplefs:/$dde dde
+    load simplefs:/[file tail $::ddelib] dde
     testsimplefilesystem 0
+    return ok
+    # The real result of this test is what happens when Tcl exits.
+} -cleanup {
     cd $dir
-    set res "ok"
+} -result ok
+test filesystem-7.1.2 {load from vfs, and then unload again} -setup {
+    set dir [pwd]
+} -constraints {win testsimplefilesystem loaddll} -body {
+    # This may cause a crash on exit
+    cd [file dirname $::reglib]
+    testsimplefilesystem 1
+    # This loads reg via a complex copy-to-temp operation
+    load simplefs:/[file tail $::reglib] Registry
+    unload simplefs:/[file tail $::reglib]
+    testsimplefilesystem 0
+    return ok
     # The real result of this test is what happens when Tcl exits.
-} {ok}
-test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} \
-  {testsimplefilesystem} {
+} -cleanup {
+    cd $dir
+} -result ok
+test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
     # We created this file several tests ago.
     set origtime [file mtime gorp.file]
     set res [file exists gorp.file]
-    if {[catch {
-	testsimplefilesystem 1
-	file delete -force theCopy
-	file copy simplefs:/gorp.file theCopy
-	testsimplefilesystem 0
-	set newtime [file mtime theCopy]
-	file delete theCopy
-    } err]} {
-	lappend res $err
-	set newtime ""
-    }
+    testsimplefilesystem 1
+    file delete -force theCopy
+    file copy simplefs:/gorp.file theCopy
+    testsimplefilesystem 0
+    set newtime [file mtime theCopy]
+    lappend res [expr {$origtime == $newtime ? 1 : "$origtime != $newtime"}]
+} -cleanup {
+    catch {file delete theCopy}
     cd $dir
-    lappend res [expr {$origtime == $newtime}]
-} {1 1}
-test filesystem-7.3 {glob in simplefs} testsimplefilesystem {
+} -result {1 1}
+test filesystem-7.3 {glob in simplefs} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
     file mkdir simpledir
     close [open [file join simpledir simplefile] w]
     testsimplefilesystem 1
-    set res [glob -nocomplain -dir simplefs:/simpledir *]
-    testsimplefilesystem 0
+    glob -nocomplain -dir simplefs:/simpledir *
+} -cleanup {
+    catch {testsimplefilesystem 0}
     file delete -force simpledir
     cd $dir
-    set res
-} {simplefs:/simpledir/simplefile}
-test filesystem-7.3.1 {glob in simplefs: no path/dir} testsimplefilesystem {
+} -result {simplefs:/simpledir/simplefile}
+test filesystem-7.3.1 {glob in simplefs: no path/dir} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
     file mkdir simpledir
     close [open [file join simpledir simplefile] w]
     testsimplefilesystem 1
     set res [glob -nocomplain simplefs:/simpledir/*]
-    eval lappend res [glob -nocomplain simplefs:/simpledir]
-    testsimplefilesystem 0
+    lappend res {*}[glob -nocomplain simplefs:/simpledir]
+} -cleanup {
+    catch {testsimplefilesystem 0}
     file delete -force simpledir
     cd $dir
-    set res
-} {simplefs:/simpledir/simplefile simplefs:/simpledir}
-test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} testsimplefilesystem {
+} -result {simplefs:/simpledir/simplefile simplefs:/simpledir}
+test filesystem-7.3.2 {glob in simplefs: no path/dir, no subdirectory} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
     file mkdir simpledir
     close [open [file join simpledir simplefile] w]
     testsimplefilesystem 1
-    set res [glob -nocomplain simplefs:/s*]
-    testsimplefilesystem 0
+    glob -nocomplain simplefs:/s*
+} -cleanup {
+    catch {testsimplefilesystem 0}
     file delete -force simpledir
     cd $dir
-    if {[llength $res] > 0} {
-	set res "ok"
-    } else {
-        set res "no files found with 'glob -nocomplain simplefs:/s*'"
-    }
-} {ok}
-test filesystem-7.3.3 {glob in simplefs: pattern is a volume} testsimplefilesystem {
+} -match glob -result ?*
+test filesystem-7.3.3 {glob in simplefs: pattern is a volume} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
+} -constraints testsimplefilesystem -body {
     file mkdir simpledir
     close [open [file join simpledir simplefile] w]
     testsimplefilesystem 1
-    set res [glob -nocomplain simplefs:/*]
+    glob -nocomplain simplefs:/*
+} -cleanup {
     testsimplefilesystem 0
     file delete -force simpledir
     cd $dir
-    if {[llength $res] > 0} {
-	set res "ok"
-    } else {
-	set res "no files found with 'glob -nocomplain simplefs:/*'"
-    }
-} {ok}
-test filesystem-7.4 {cross-filesystem file copy with -force} testsimplefilesystem {
+} -match glob -result ?*
+test filesystem-7.4 {cross-filesystem file copy with -force} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
     set fout [open [file join simplefile] w]
     puts -nonewline $fout "1234567890"
     close $fout
     testsimplefilesystem 1
+} -constraints testsimplefilesystem -body {
     # First copy should succeed
     set res [catch {file copy simplefs:/simplefile file2} err]
     lappend res $err
@@ -686,19 +636,20 @@ test filesystem-7.4 {cross-filesystem file copy with -force} testsimplefilesyste
     lappend res [catch {file copy -force simplefs:/simplefile file2} err]
     lappend res $err
     lappend res [file exists file2]
-    testsimplefilesystem 0
+} -cleanup {
+    catch {testsimplefilesystem 0}
     file delete -force simplefile
     file delete -force file2
     cd $dir
-    set res
-} {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
-test filesystem-7.5 {cross-filesystem file copy with -force} {testsimplefilesystem unix} {
+} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
+test filesystem-7.5 {cross-filesystem file copy with -force} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
     set fout [open [file join simplefile] w]
     puts -nonewline $fout "1234567890"
     close $fout
     testsimplefilesystem 1
+} -constraints {testsimplefilesystem unix} -body {
     # First copy should succeed
     set res [catch {file copy simplefs:/simplefile file2} err]
     lappend res $err
@@ -710,13 +661,13 @@ test filesystem-7.5 {cross-filesystem file copy with -force} {testsimplefilesyst
     lappend res [catch {file copy -force simplefs:/simplefile file2} err]
     lappend res $err
     lappend res [file exists file2]
+} -cleanup {
     testsimplefilesystem 0
     file delete -force simplefile
     file delete -force file2
     cd $dir
-    set res
-} {0 10 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 10 1}
-test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem {
+} -result {0 {} 1 {error copying "simplefs:/simplefile" to "file2": file already exists} 0 {} 1}
+test filesystem-7.6 {cross-filesystem dir copy with -force} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
     file delete -force simpledir
@@ -726,6 +677,7 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem
     puts -nonewline $fout "1234567890"
     close $fout
     testsimplefilesystem 1
+} -constraints testsimplefilesystem -body {
     # First copy should succeed
     set res [catch {file copy simplefs:/simpledir dir2} err]
     lappend res $err
@@ -737,13 +689,13 @@ test filesystem-7.6 {cross-filesystem dir copy with -force} testsimplefilesystem
     lappend res $err
     lappend res [file exists [file join dir2 simpledir]] \
 	    [file exists [file join dir2 simpledir simplefile]]
+} -cleanup {
     testsimplefilesystem 0
     file delete -force simpledir
     file delete -force dir2
     cd $dir
-    set res
-} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
-test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesystem unix} {
+} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
+test filesystem-7.7 {cross-filesystem dir copy with -force} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
     file delete -force simpledir
@@ -753,6 +705,7 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesyste
     puts -nonewline $fout "1234567890"
     close $fout
     testsimplefilesystem 1
+} -constraints {testsimplefilesystem unix} -body {
     # First copy should succeed
     set res [catch {file copy simplefs:/simpledir dir2} err]
     lappend res $err
@@ -760,40 +713,41 @@ test filesystem-7.7 {cross-filesystem dir copy with -force} {testsimplefilesyste
     lappend res [catch {file copy simplefs:/simpledir dir2} err]
     lappend res $err
     # Third copy should succeed (-force)
-    # I've noticed on some Unices that this only succeeds
-    # intermittently (some runs work, some fail).  This needs
-    # examining further.
+    # I've noticed on some Unices that this only succeeds intermittently (some
+    # runs work, some fail). This needs examining further.
     lappend res [catch {file copy -force simplefs:/simpledir dir2} err]
     lappend res $err
     lappend res [file exists [file join dir2 simpledir]] \
 	    [file exists [file join dir2 simpledir simplefile]]
+} -cleanup {
     testsimplefilesystem 0
     file delete -force simpledir
     file delete -force dir2
     cd $dir
-    set res
-} {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
+} -result {0 {} 1 {error copying "simplefs:/simpledir" to "dir2/simpledir": file already exists} 0 {} 1 1}
 removeFile gorp.file
-test filesystem-7.8 {vfs cd} testsimplefilesystem {
+test filesystem-7.8 {vfs cd} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
     file delete -force simpledir
     file mkdir simpledir
     testsimplefilesystem 1
-    # This can variously cause an infinite loop or simply have
-    # no effect at all (before certain bugs were fixed, of course).
+} -constraints testsimplefilesystem -body {
+    # This can variously cause an infinite loop or simply have no effect at
+    # all (before certain bugs were fixed, of course).
     cd simplefs:/simpledir
-    set res [pwd]
+    pwd
+} -cleanup {
     cd [tcltest::temporaryDirectory]
     testsimplefilesystem 0
     file delete -force simpledir
     cd $dir
-    set res
-} {simplefs:/simpledir}
+} -result {simplefs:/simpledir}
 
-test filesystem-8.1 {relative path objects and caching of pwd} {
+test filesystem-8.1 {relative path objects and caching of pwd} -setup {
     set dir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     makeDirectory abc
     makeDirectory def
     makeFile "contents" [file join abc foo]
@@ -804,35 +758,35 @@ test filesystem-8.1 {relative path objects and caching of pwd} {
     lappend res [file exists $f]
     cd ..
     cd def
-    # If we haven't cleared the object's cwd cache, Tcl 
-    # will think it still exists.
+    # If we haven't cleared the object's cwd cache, Tcl will think it still
+    # exists.
     lappend res [file exists $f]
     lappend res [file exists $f]
+} -cleanup {
     removeFile [file join abc foo]
     removeDirectory abc
     removeDirectory def
     cd $dir
-    set res
-} {1 1 0 0}
-test filesystem-8.2 {relative path objects and use of pwd} {
+} -result {1 1 0 0}
+test filesystem-8.2 {relative path objects and use of pwd} -setup {
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     set dir "abc"
     makeDirectory $dir
     makeFile "contents" [file join abc foo]
     cd $dir
-    set res [file exists [lindex [glob *] 0]]
-    cd ..
+    file exists [lindex [glob *] 0]
+} -cleanup {
+    cd [tcltest::temporaryDirectory]
     removeFile [file join abc foo]
     removeDirectory abc
     cd $origdir
-    set res
-} {1}
+} -result 1
 test filesystem-8.3 {path objects and empty string} {
     set anchor ""
     set dst foo
     set res $dst
-
     set yyy [file split $anchor]
     set dst [file join  $anchor $dst]
     lappend res $dst $yyy
@@ -844,7 +798,7 @@ proc TestFind1 {d f} {
     lappend res "is dir a dir? [file isdirectory $d]"
     set r2 [file exists [file join $d $f]]
     lappend res "[file join $d $f] found: $r2"
-    set res
+    return $res
 }
 proc TestFind2 {d f} {
     set r1 [file exists [file join $d $f]]
@@ -852,67 +806,74 @@ proc TestFind2 {d f} {
     lappend res "is dir a dir? [file isdirectory [file join $d]]"
     set r2 [file exists [file join $d $f]]
     lappend res "[file join $d $f] found: $r2"
-    set res
+    return $res
 }
 
-test filesystem-9.1 {path objects and join and object rep} {
+test filesystem-9.1 {path objects and join and object rep} -setup {
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     file mkdir [file join a b c]
-    set res [TestFind1 a [file join b . c]]
+    TestFind1 a [file join b . c]
+} -cleanup {
     file delete -force a
     cd $origdir
-    set res
-} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
-test filesystem-9.2 {path objects and join and object rep} {
+} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
+test filesystem-9.2 {path objects and join and object rep} -setup {
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     file mkdir [file join a b c]
-    set res [TestFind2 a [file join b . c]]
+    TestFind2 a [file join b . c]
+} -cleanup {
     file delete -force a
     cd $origdir
-    set res
-} {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
-test filesystem-9.2.1 {path objects and join and object rep} {
+} -result {{a/b/./c found: 1} {is dir a dir? 1} {a/b/./c found: 1}}
+test filesystem-9.2.1 {path objects and join and object rep} -setup {
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     file mkdir [file join a b c]
-    set res [TestFind2 a [file join b .]]
+    TestFind2 a [file join b .]
+} -cleanup {
     file delete -force a
     cd $origdir
-    set res
-} {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
-test filesystem-9.3 {path objects and join and object rep} {
+} -result {{a/b/. found: 1} {is dir a dir? 1} {a/b/. found: 1}}
+test filesystem-9.3 {path objects and join and object rep} -setup {
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     file mkdir [file join a b c]
-    set res [TestFind1 a [file join b .. b c]]
+    TestFind1 a [file join b .. b c]
+} -cleanup {
     file delete -force a
     cd $origdir
-    set res
-} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
-test filesystem-9.4 {path objects and join and object rep} {
+} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
+test filesystem-9.4 {path objects and join and object rep} -setup {
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     file mkdir [file join a b c]
-    set res [TestFind2 a [file join b .. b c]]
+    TestFind2 a [file join b .. b c]
+} -cleanup {
     file delete -force a
     cd $origdir
-    set res
-} {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
-test filesystem-9.5 {path objects and file tail and object rep} {
+} -result {{a/b/../b/c found: 1} {is dir a dir? 1} {a/b/../b/c found: 1}}
+test filesystem-9.5 {path objects and file tail and object rep} -setup {
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     file mkdir dgp
     close [open dgp/test w]
     foreach relative [glob -nocomplain [file join * test]] {
 	set absolute [file join [pwd] $relative]
 	set res [list [file tail $absolute] "test"]
     }
+    return $res
+} -cleanup {
     file delete -force dgp 
     cd $origdir
-    set res
-} {test test}
+} -result {test test}
 test filesystem-9.6 {path objects and file tail and object rep} win {
     set res {}
     set p "C:\\toto"
@@ -920,10 +881,11 @@ test filesystem-9.6 {path objects and file tail and object rep} win {
     file isdirectory $p
     lappend res [file join $p toto]
 } {C:/toto/toto C:/toto/toto}
-test filesystem-9.7 {path objects and glob and file tail and tilde} {
+test filesystem-9.7 {path objects and glob and file tail and tilde} -setup {
     set res {}
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     file mkdir tilde
     close [open tilde/~testNotExist w]
     cd tilde
@@ -932,15 +894,16 @@ test filesystem-9.7 {path objects and glob and file tail and tilde} {
     lappend res $file
     lappend res [file exists $file] [catch {file tail $file} r] $r
     lappend res [catch {file tail $file} r] $r
-    cd ..
+} -cleanup {
+    cd [tcltest::temporaryDirectory]
     file delete -force tilde
     cd $origdir
-    set res
-} {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
-test filesystem-9.8 {path objects and glob and file tail and tilde} {
+} -result {0 1 {user "testNotExist" doesn't exist} ~testNotExist 0 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
+test filesystem-9.8 {path objects and glob and file tail and tilde} -setup {
     set res {}
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     file mkdir tilde
     close [open tilde/~testNotExist w]
     cd tilde
@@ -949,15 +912,16 @@ test filesystem-9.8 {path objects and glob and file tail and tilde} {
     lappend res $file1 $file2
     lappend res [catch {file tail $file1} r] $r
     lappend res [catch {file tail $file2} r] $r
-    cd ..
+} -cleanup {
+    cd [tcltest::temporaryDirectory]
     file delete -force tilde
     cd $origdir
-    set res
-} {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
-test filesystem-9.9 {path objects and glob and file tail and tilde} {
+} -result {~testNotExist ~testNotExist 1 {user "testNotExist" doesn't exist} 1 {user "testNotExist" doesn't exist}}
+test filesystem-9.9 {path objects and glob and file tail and tilde} -setup {
     set res {}
     set origdir [pwd]
     cd [tcltest::temporaryDirectory]
+} -body {
     file mkdir tilde
     close [open tilde/~testNotExist w]
     cd tilde
@@ -966,14 +930,24 @@ test filesystem-9.9 {path objects and glob and file tail and tilde} {
     lappend res [catch {file exists $file1} r] $r
     lappend res [catch {file exists $file2} r] $r
     lappend res [string equal $file1 $file2]
-    cd ..
+} -cleanup {
+    cd [tcltest::temporaryDirectory]
     file delete -force tilde
     cd $origdir
-    set res
-} {0 0 0 0 1}
+} -result {0 0 0 0 1}
+
+# ----------------------------------------------------------------------
+
+test filesystem-10.1 {Bug 3414754} {
+    string match */ [file join [pwd] foo/]
+} 0
 
 cleanupTests
-unset -nocomplain drive
+unset -nocomplain drive drives
 }
 namespace delete ::tcl::test::fileSystem
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/for-old.test b/tests/for-old.test
index db63a16..a11a791 100644
--- a/tests/for-old.test
+++ b/tests/for-old.test
@@ -11,8 +11,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: for-old.test,v 1.6 2004/05/19 12:25:30 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
diff --git a/tests/for.test b/tests/for.test
index 7c968f6..8abd270 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -8,21 +8,25 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: for.test,v 1.12 2005/06/20 07:49:11 mdejong Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+# Used for constraining memory leak tests
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc meminfo {} {lindex [split [memory info] "\n"] 3 3}
+}
+
 # Basic "for" operation.
 
 test for-1.1 {TclCompileForCmd: missing initial command} {
     list [catch {for} msg] $msg
 } {1 {wrong # args: should be "for start test next command"}}
 test for-1.2 {TclCompileForCmd: error in initial command} -body {
-    list [catch {for {set}} msg] $msg $errorInfo
+    list [catch {for {set}} msg] $msg $::errorInfo
 } -match glob -result {1 {wrong # args: should be "for start test next command"} {wrong # args: should be "for start test next command"
     while *ing
 "for {set}"}}
@@ -33,7 +37,7 @@ test for-1.3 {TclCompileForCmd: missing test expression} {
 } {wrong # args: should be "for start test next command"}
 test for-1.4 {TclCompileForCmd: error in test expression} -body {
     catch {for {set i 0} {$i<}} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {wrong # args: should be "for start test next command"
     while *ing
 "for {set i 0} {$i<}"}
@@ -51,7 +55,7 @@ test for-1.7 {TclCompileForCmd: missing command body} {
 } {wrong # args: should be "for start test next command"}
 test for-1.8 {TclCompileForCmd: error compiling command body} -body {
     catch {for {set i 0} {$i < 5} {incr i} {set}} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
@@ -82,7 +86,7 @@ test for-1.11 {TclCompileForCmd: computed command body} {
 } {x1}
 test for-1.12 {TclCompileForCmd: error in "next" command} -body {
     catch {for {set i 0} {$i < 5} {set} {format $i}} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
@@ -199,6 +203,19 @@ test for-2.6 {continue tests, long command body} {
     }
     set a
 } {1 3}
+test for-2.7 {continue tests, uncompiled [for]} -body {
+    set file [makeFile {
+    	set guard 0
+	for {set i 20} {$i > 0} {incr i -1} {
+	    if {[incr guard]>30} {return BAD}
+	    continue
+	}
+	return GOOD
+    } source.file]
+    source $file
+} -cleanup {
+    removeFile source.file
+} -result GOOD
 
 # Check "for" and "break".
 
@@ -334,7 +351,6 @@ proc formatMail {} {
         64 {        UNIX (Solaris 2.* and SunOS, other systems soon to follow). Easy to install} \
         65 {     binary packages are now for sale at the Sun Labs Tcl/Tk Shop. Check it out!} \
     }
-
     set result ""
     set NL "
 "
@@ -354,7 +370,6 @@ proc formatMail {} {
     } else {
 	set break 1
     }
-
     set xmailer 0
     set inheaders 1
     set last [array size lines]
@@ -375,9 +390,7 @@ proc formatMail {} {
 	    set limit 55
 	} else {
 	    set limit 55
-
 	    # Decide whether or not to break the body line
-
 	    if {$plen > 0} {
 		if {[string first {> } $line] == 0} {
 		    # This is quoted text from previous message, don't reformat
@@ -420,7 +433,7 @@ proc formatMail {} {
 	set climit [expr $limit-1]
 	set cutoff 50
 	set continuation 0
-	
+
 	while {[string length $line] > $limit} {
 	    for {set c [expr $limit-1]} {$c >= $cutoff} {incr c -1} {
 		set char [string index $line $c]
@@ -652,19 +665,18 @@ test for-6.5 {Tcl_ForObjCmd: number of args} {
 } {wrong # args: should be "for start test next command"}
 test for-6.6 {Tcl_ForObjCmd: error in initial command} -body {
     set z for
-    list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $errorInfo
+    list [catch {$z {set} {$i < 5} {incr i} {body}} msg] $msg $::errorInfo
 } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"
     ("for" initial command)
     invoked from within
 "$z {set} {$i < 5} {incr i} {body}"}}
-test for-6.7 {Tcl_ForObjCmd: error in test expression} -match glob -body {
+test for-6.7 {Tcl_ForObjCmd: error in test expression} -body {
     set z for
-    list [catch {$z {set i 0} {i < 5} {incr i} {body}} msg] $msg $errorInfo
-} -result {1 {syntax error in expression "i < 5": * preceding $*} {syntax error in expression "i < 5": * preceding $*
-    while executing
-"$z {set i 0} {i < 5} {incr i} {body}"}}
+    catch {$z {set i 0} {i < 5} {incr i} {body}}
+    set ::errorInfo
+} -match glob -result {*"$z {set i 0} {i < 5} {incr i} {body}"}
 test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
     set z for
     set i 0
@@ -674,7 +686,7 @@ test for-6.8 {Tcl_ForObjCmd: test expression is enclosed in quotes} {
 test for-6.9 {Tcl_ForObjCmd: error executing command body} -body {
     set z for
     catch {$z {set i 0} {$i < 5} {incr i} {set}} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"
@@ -711,7 +723,7 @@ test for-6.12 {Tcl_ForObjCmd: computed command body} {
 test for-6.13 {Tcl_ForObjCmd: error in "next" command} -body {
     set z for
     catch {$z {set i 0} {$i < 5} {set} {set j 4}} msg
-    set errorInfo
+    set ::errorInfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"
@@ -814,7 +826,369 @@ test for-6.18 {Tcl_ForObjCmd: for command result} {
     1 {invoked "continue" outside of a loop} \
     ]
 
-
+test for-7.1 {Bug 3614226: ensure that break cleans up the stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [break] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.2 {Bug 3614226: ensure that continue cleans up the stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [continue] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.3 {Bug 3614226: ensure that break cleans up the expansion stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[break] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.4 {Bug 3614226: ensure that continue cleans up the expansion stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[continue] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.5 {Bug 3614226: ensure that break cleans up the combination of main and expansion stack} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.6 {Bug 3614226: ensure that continue cleans up the combination of main and expansion stack} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.7 {Bug 3614226: ensure that break only cleans up the right amount} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[break] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.8 {Bug 3614226: ensure that continue only cleans up the right amount} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[continue] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.9 {Bug 3614226: ensure that break from invoked command cleans up the stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [apply {{} {return -code break}}] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.10 {Bug 3614226: ensure that continue from invoked command cleans up the stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [apply {{} {return -code continue}}] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.11 {Bug 3614226: ensure that break from invoked command cleans up the expansion stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[apply {{} {return -code break}}] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.12 {Bug 3614226: ensure that continue from invoked command cleans up the expansion stack} memory {
+    apply {{} {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[apply {{} {
+		    return -code continue
+		}}] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.13 {Bug 3614226: ensure that break from invoked command cleans up the combination of main and expansion stack} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+		    return -code break
+		}}] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.14 {Bug 3614226: ensure that continue from invoked command cleans up the combination of main and expansion stack} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+		    return -code continue
+		}}] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.15 {Bug 3614226: ensure that break from invoked command only cleans up the right amount} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+		    return -code break
+		}}] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.16 {Bug 3614226: ensure that continue from invoked command only cleans up the right amount} memory {
+    apply {{} {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[apply {{} {
+		    return -code continue
+		}}] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }}
+} 0
+test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory {
+    apply {op {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [{*}$op] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code break}
+} 0
+test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory {
+    apply {op {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {$x < 5} {incr x} {
+		list a b c [{*}$op] d e f
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code continue}
+} 0
+test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory {
+    apply {op {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[{*}$op] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code break}
+} 0
+test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory {
+    apply {op {
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts {*}[puts a b c {*}[{*}$op] d e f]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code continue}
+} 0
+test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory {
+    apply {op {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code break}
+} 0
+test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory {
+    apply {op {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+	    }
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code continue}
+} 0
+test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory {
+    apply {op {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code break}
+} 0
+test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory {
+    apply {op {
+	set l [lrepeat 50 p q r]
+	# Can't use [memtest]; must be careful when we change stack frames
+	set end [meminfo]
+	for {set i 0} {$i < 5} {incr i} {
+	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
+		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
+	    }]
+	    set tmp $end
+	    set end [meminfo]
+	}
+	expr {$end - $tmp}
+    }} {return -level 0 -code continue}
+} 0
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/foreach.test b/tests/foreach.test
index 9f4b5b0..6fd5476 100644
--- a/tests/foreach.test
+++ b/tests/foreach.test
@@ -9,8 +9,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: foreach.test,v 1.9 2003/03/27 13:19:15 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -73,8 +71,11 @@ catch {unset a}
 test foreach-1.14 {foreach errors} {
     catch {unset a}
     set a(0) 44
-    list [catch {foreach a {1 2 3} {}} msg] $msg
-} {1 {couldn't set loop variable: "a"}}
+    list [catch {foreach a {1 2 3} {}} msg o] $msg $::errorInfo
+} {1 {can't set "a": variable is array} {can't set "a": variable is array
+    (setting foreach loop variable "a")
+    invoked from within
+"foreach a {1 2 3} {}"}}
 test foreach-1.15 {foreach errors} {
     list [catch {foreach {} {} {}} msg] $msg
 } {1 {foreach varlist is empty}}
@@ -163,7 +164,7 @@ test foreach-3.1 {compiled foreach backward jump works correctly} {
 test foreach-4.1 {noncompiled foreach and shared variable or value list objects that are converted to another type} {
     catch {unset x}
     foreach {12.0} {a b c} {
-        set x 12.0  
+        set x 12.0
         set x [expr $x + 1]
     }
     set x
@@ -210,7 +211,7 @@ test foreach-6.4 {break tests} {
     catch {break foo} msg
     set msg
 } {wrong # args: should be "break"}
-# Check for bug #406709 
+# Check for bug #406709
 test foreach-6.5 {break tests} {
     proc a {} {
 	set a 1
@@ -221,7 +222,6 @@ test foreach-6.5 {break tests} {
 } {2}
 
 # Test for incorrect "double evaluation" semantics
-
 test foreach-7.1 {delayed substitution of body} {
     proc foo {} {
        set a 0
@@ -233,8 +233,62 @@ test foreach-7.1 {delayed substitution of body} {
     foo
 } {0}
 
+# Test for [Bug 1189274]; crash on failure
+test foreach-8.1 {empty list handling} {
+    proc crash {} {
+	rename crash {}
+	set a "x y z"
+	set b ""
+	foreach aa $a bb $b { set x "aa = $aa bb = $bb" }
+    }
+    crash
+} {}
+
+# [Bug 1671138]; infinite loop with empty var list in bytecompiled version
+test foreach-9.1 {compiled empty var list} {
+    proc foo {} {
+	foreach {} x {
+	    error "reached body"
+	}
+    }
+    list [catch { foo } msg] $msg
+} {1 {foreach varlist is empty}}
+
+test foreach-9.2 {line numbers} -setup {
+    proc linenumber {} {dict get [info frame -1] line}
+} -body {
+    apply {n {
+        foreach x y {*}{
+        } {return [incr n -[linenumber]]}
+    }} [linenumber]
+} -cleanup {
+    rename linenumber {}
+} -result 1
+
+test foreach-10.1 {foreach: [Bug 1671087]} -setup {
+    proc demo {} {
+	set vals {1 2 3 4}
+	trace add variable x write {string length $vals ;# }
+	foreach {x y} $vals {format $y}
+    }
+} -body {
+    demo
+} -cleanup {
+    rename demo {}
+} -result {}
+
+test foreach-11.1 {error then dereference loop var (dev bug)} {
+  catch { foreach a 0 b {1 2 3} { error x } }
+  set a
+} 0
+test foreach-11.2 {error then dereference loop var (dev bug)} {
+  catch { foreach a 0 b {1 2 3} { incr a $b; error x } }
+  set a
+} 1
+
 # cleanup
 catch {unset a}
 catch {unset x}
+catch {rename foo {}}
 ::tcltest::cleanupTests
 return
diff --git a/tests/format.test b/tests/format.test
index a6e2242..27eac31 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -9,25 +9,25 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: format.test,v 1.21 2005/07/28 18:42:32 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+# %u output depends on word length, so this test is not portable.
+testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
+testConstraint wideIs64bit \
+	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
+testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
+
 test format-1.1 {integer formatting} {
     format "%*d %d %d %d" 6 34 16923 -12 -1
 } {    34 16923 -12 -1}
 test format-1.2 {integer formatting} {
     format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
 } {   6   34 16923  -12 -1 0xe 0XC}
-
-# %u output depends on word length, so this test is not portable.
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-
 test format-1.3 {integer formatting} longIs32bit {
     format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
 } {   6   34 16923 4294967284 -1 0}
@@ -43,10 +43,8 @@ test format-1.5 {integer formatting} {
 test format-1.6 {integer formatting} {
     format "%00*d" 6 34
 } {000034}
-
 # Printing negative numbers in hex or octal format depends on word
 # length, so these tests are not portable.
-
 test format-1.7 {integer formatting} longIs32bit {
     format "%4x %4x %4x %4x" 6 34 16923 -12 -1
 } {   6   22 421b fffffff4}
@@ -77,6 +75,9 @@ test format-1.11 {integer formatting} longIs32bit {
 test format-1.11.1 {integer formatting} longIs64bit {
     format "%-#20o %#-20o %#-20o %#-20o" 6 34 16923 -12 -1
 } {06                   042                  041033               01777777777777777777764}
+test format-1.12 {integer formatting} {
+    format "%b %#b %llb" 5 5 [expr {2**100}]
+} {101 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
 
 test format-2.1 {string formatting} {
     format "%s %s %c %s" abcd {This is a very long test string.} 120 x
@@ -288,7 +289,7 @@ test format-8.1 {error conditions} {
 test format-8.2 {error conditions} {
     catch format msg
     set msg
-} {wrong # args: should be "format formatString ?arg arg ...?"}
+} {wrong # args: should be "format formatString ?arg ...?"}
 test format-8.3 {error conditions} {
     catch {format %*d}
 } 1
@@ -381,6 +382,10 @@ test format-10.4 {"h" format specifier} {
     # Bug 1154163: This is minimal behaviour for %hx specifier!
     format %hx 1
 } 1
+test format-10.5 {"h" format specifier} {
+    # Bug 1284178: Highly out-of-range values shouldn't cause errors
+    format %hu 0x100000000
+} 0
 
 test format-11.1 {XPG3 %$n specifiers} {
     format {%2$d %1$d} 4 5
@@ -422,6 +427,7 @@ test format-11.12 {XPG3 %$n specifiers} {
 test format-12.1 {negative width specifiers} {
     format "%*d" -47 25
 } {25                                             }
+
 test format-13.1 {tcl_precision fuzzy comparison} {
     catch {unset a}
     catch {unset b}
@@ -471,6 +477,7 @@ test format-13.5 {tcl_precision fuzzy comparison} {
     set c [expr $a + $b]
     format {%0.10f %0.12f %0.15f} $c $c $c
 } {1.4444444444 1.444444444444 1.444444444443990}
+
 test format-14.1 {testing MAX_FLOAT_SIZE for 0 and 1} {
     format {%s} ""
 } {}
@@ -490,6 +497,12 @@ test format-15.3 {testing %0..s 0 padding for chars/strings} {
 test format-15.4 {testing %0..s 0 padding for chars/strings} {
     format %05c 61
 } {0000=}
+test format-15.5 {testing %d space padding for integers} {
+    format "(% 1d) (% 1d)" 10 -10
+} {( 10) (-10)}
+test format-15.6 {testing %d plus padding for integers} {
+    format "(%+1d) (%+1d)" 10 -10
+} {(+10) (-10)}
 
 set a "0123456789"
 set b ""
@@ -498,19 +511,14 @@ for {set i 0} {$i < 290} {incr i} {
 }
 for {set i 290} {$i < 400} {incr i} {
     test format-16.[expr $i -289] {testing MAX_FLOAT_SIZE} {
-        format {%s} $b    
+        format {%s} $b
     } $b
     append b "x"
 }
 
-::tcltest::testConstraint wideIs64bit \
-	[expr {(0x80000000 > 0) && (0x8000000000000000 < 0)}]
-::tcltest::testConstraint wideBiggerThanInt \
-	[expr {wide(0x80000000) != int(0x80000000)}]
-
 test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} {
-    list [catch {format %d 7810179016327718216} msg] $msg
-} {1 {integer value too large to represent}}
+    format %d 7810179016327718216
+} 1819043144
 test format-17.2 {testing %ld with wide} {wideIs64bit} {
     format %ld 7810179016327718216
 } 7810179016327718216
@@ -526,14 +534,11 @@ test format-18.1 {do not demote existing numeric values} {
     # Ensure $a and $b are separate objects
     set b 0xaaaa
     append b aaaa
-
     set result [expr {$a == $b}]
     format %08lx $b
     lappend result [expr {$a == $b}]
-
     set b 0xaaaa
     append b aaaa
-
     lappend result [expr {$a == $b}]
     format %08x $b
     lappend result [expr {$a == $b}]
@@ -541,17 +546,28 @@ test format-18.1 {do not demote existing numeric values} {
 test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
     set a [expr {0xaaaaaaaaaa + 1}]
     set b 0xaaaaaaaaab
-    list [catch {format %08x $a} msg] $msg [expr {$a == $b}]
-} {1 {integer value too large to represent} 1}
+    list [format %08x $a] [expr {$a == $b}]
+} {aaaaaaab 1}
 
-test format-19.1 {
-    regression test - tcl-core message by Brian Griffin on
-    26 0ctober 2004
-} -body {
+test format-19.1 {regression test - tcl-core message by Brian Griffin on 26 0ctober 2004} -body {
     set x 0x8fedc654
     list [expr { ~ $x }] [format %08x [expr { ~$x }]]
 } -match regexp -result {-2414724693 f*701239ab}
+test format-19.2 {Bug 1867855} {
+    format %llx 0
+} 0
+test format-19.3 {Bug 2830354} {
+    string length [format %340f 0]
+} 340
 
+# Note that this test may fail in future versions
+test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
+    set x [dict create a b c d]
+    format %s $x
+    # After this, obj in $x should be a dict with a non-NULL bytes field
+    tcl::unsupported::representation $x
+} -match glob -result {value is a dict with *, string representation "*"}
+
 # cleanup
 catch {unset a}
 catch {unset b}
@@ -559,3 +575,7 @@ catch {unset c}
 catch {unset d}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/get.test b/tests/get.test
index 46301e8..d51ec6d 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -9,18 +9,18 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: get.test,v 1.11 2005/07/28 18:42:32 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testgetint [llength [info commands testgetint]]
 testConstraint longIs32bit [expr {int(0x80000000) < 0}]
 testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-#testConstraint longIsMoreThan32bit [expr {![testConstraint longIs32bit]}]
 
 test get-1.1 {Tcl_GetInt procedure} testgetint {
     testgetint 44 { 	  22}
diff --git a/tests/history.test b/tests/history.test
index b283b1a..c562796 100644
--- a/tests/history.test
+++ b/tests/history.test
@@ -1,17 +1,15 @@
 # Commands covered:  history
 #
-# 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.
-#
-# RCS: @(#) $Id: history.test,v 1.6 2004/05/19 12:43:03 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
   
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -35,7 +33,7 @@ if {[testConstraint history]} {
     # Dummy value, must be numeric
     set num 0
 }
-
+
 # "history event"
 
 test history-1.1 {event option} history {history event -1} \
@@ -245,8 +243,8 @@ test history-9.1 {miscellaneous} history {catch {history gorp} msg} 1
 test history-9.2 {miscellaneous} history {
     catch {history gorp} msg
     set msg
-} {bad option "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
-
+} {unknown or ambiguous subcommand "gorp": must be add, change, clear, event, info, keep, nextid, or redo}
+
 # cleanup
 ::tcltest::cleanupTests
 return
diff --git a/tests/http.test b/tests/http.test
index 86811f4..a0a26de 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -1,23 +1,18 @@
 # Commands covered:  http::config, http::geturl, http::wait, http::reset
 #
 # This file contains a collection of tests for the http script library.
-# 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) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-2000 by Ajuba Solutions.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-#
-# RCS: @(#) $Id: http.test,v 1.38 2004/05/25 22:56:33 hobbs Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
 
 if {[catch {package require http 2} version]} {
     if {[info exists http2]} {
@@ -56,14 +51,13 @@ if {![file exists $httpdFile]} {
     set removeHttpd 1
 }
 
-if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
-    set httpthread [testthread create "
-	source [list $httpdFile]
-	testthread wait
-    "]
-    testthread send $httpthread [list set port $port]
-    testthread send $httpthread [list set bindata $bindata]
-    testthread send $httpthread {httpd_init $port}
+catch {package require Thread 2.7-}
+if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
+    set httpthread [thread::create -preserved]
+    thread::send $httpthread [list source $httpdFile]
+    thread::send $httpthread [list set port $port]
+    thread::send $httpthread [list set bindata $bindata]
+    thread::send $httpthread {httpd_init $port}
     puts "Running httpd in thread $httpthread"
 } else {
     if {![file exists $httpdFile]} {
@@ -81,117 +75,118 @@ if {[info commands testthread] == "testthread" && [file exists $httpdFile]} {
 	set port [lindex [fconfigure $listen -sockname] 2]
     }
 }
-
-
+
 test http-1.1 {http::config} {
+    http::config -useragent UserAgent
     http::config
-} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "Tcl http client package $version"]
-
+} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
 test http-1.2 {http::config} {
     http::config -proxyfilter
 } http::ProxyRequired
-
 test http-1.3 {http::config} {
     catch {http::config -junk}
 } 1
-
 test http-1.4 {http::config} {
     set savedconf [http::config]
     http::config -proxyhost nowhere.come -proxyport 8080 \
 	-proxyfilter myFilter -useragent "Tcl Test Suite" \
 	-urlencoding iso8859-1
     set x [http::config]
-    http::config {expand}$savedconf
+    http::config {*}$savedconf
     set x
 } {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
-
-test http-1.5 {http::config} {
-    list [catch {http::config -proxyhost {} -junk 8080} msg] $msg
-} {1 {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}}
-
-test http-1.6 {http::config} {
+test http-1.5 {http::config} -returnCodes error -body {
+    http::config -proxyhost {} -junk 8080
+} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
+test http-1.6 {http::config} -setup {
+    set oldenc [http::config -urlencoding]
+} -body {
     set enc [list [http::config -urlencoding]]
     http::config -urlencoding iso8859-1
     lappend enc [http::config -urlencoding]
-    http::config -urlencoding [lindex $enc 0]
-    set enc
-} {utf-8 iso8859-1}
-
+} -cleanup {
+    http::config -urlencoding $oldenc
+} -result {utf-8 iso8859-1}
 
 test http-2.1 {http::reset} {
     catch {http::reset http#1}
 } 0
 
-test http-3.1 {http::geturl} {
-    list [catch {http::geturl -bogus flag} msg] $msg
-} {1 {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -progress, -query, -queryblocksize, -querychannel, -queryprogress, -validate, -timeout, -type}}
-
-test http-3.2 {http::geturl} {
-    catch {http::geturl http:junk} err
-    set err
-} {Unsupported URL: http:junk}
-
-set url [info hostname]:$port
-set badurl [info hostname]:6666
-test http-3.3 {http::geturl} {
+test http-3.1 {http::geturl} -returnCodes error -body {
+    http::geturl -bogus flag
+} -result {Unknown option flag, can be: -binary, -blocksize, -channel, -command, -handler, -headers, -keepalive, -method, -myaddr, -progress, -protocol, -query, -queryblocksize, -querychannel, -queryprogress, -strict, -timeout, -type, -validate}
+test http-3.2 {http::geturl} -returnCodes error -body {
+    http::geturl http:junk
+} -result {Unsupported URL: http:junk}
+set url //[info hostname]:$port
+set badurl //[info hostname]:[expr $port+1]
+test http-3.3 {http::geturl} -body {
     set token [http::geturl $url]
     http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
 <h2>GET /</h2>
 </body></html>"
-
 set tail /a/b/c
-set url [info hostname]:$port/a/b/c
-set fullurl http://user:pass@[info hostname]:$port/a/b/c
-set binurl [info hostname]:$port/binary
-set posturl [info hostname]:$port/post
-set badposturl [info hostname]:$port/droppost
-
-test http-3.4 {http::geturl} {
+set url //[info hostname]:$port/a/b/c
+set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c
+set binurl //[info hostname]:$port/binary
+set posturl //[info hostname]:$port/post
+set badposturl //[info hostname]:$port/droppost
+set authorityurl //[info hostname]:$port
+set ipv6url http://\[::1\]:$port/
+test http-3.4 {http::geturl} -body {
     set token [http::geturl $url]
     http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
 <h2>GET $tail</h2>
 </body></html>"
-
 proc selfproxy {host} {
     global port
     return [list [info hostname] $port]
 }
-test http-3.5 {http::geturl} {
+test http-3.5 {http::geturl} -body {
     http::config -proxyfilter selfproxy
     set token [http::geturl $url]
-    http::config -proxyfilter http::ProxyRequired
     http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+    http::config -proxyfilter http::ProxyRequired
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
-<h2>GET http://$url</h2>
+<h2>GET http:$url</h2>
 </body></html>"
-
-test http-3.6 {http::geturl} {
+test http-3.6 {http::geturl} -body {
     http::config -proxyfilter bogus
     set token [http::geturl $url]
-    http::config -proxyfilter http::ProxyRequired
     http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+    http::config -proxyfilter http::ProxyRequired
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
 <h2>GET $tail</h2>
 </body></html>"
-
-test http-3.7 {http::geturl} {
+test http-3.7 {http::geturl} -body {
     set token [http::geturl $url -headers {Pragma no-cache}]
     http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
 <h2>GET $tail</h2>
 </body></html>"
-
-test http-3.8 {http::geturl} {
+test http-3.8 {http::geturl} -body {
     set token [http::geturl $url -query Name=Value&Foo=Bar -timeout 2000]
     http::data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
 <h2>POST $tail</h2>
 <h2>Query</h2>
@@ -200,13 +195,13 @@ test http-3.8 {http::geturl} {
 <dt>Foo<dd>Bar
 </dl>
 </body></html>"
-
-test http-3.9 {http::geturl} {
+test http-3.9 {http::geturl} -body {
     set token [http::geturl $url -validate 1]
     http::code $token
-} "HTTP/1.0 200 OK"
-
-test http-3.10 {http::geturl queryprogress} {
+} -cleanup {
+    http::cleanup $token
+} -result "HTTP/1.0 200 OK"
+test http-3.10 {http::geturl queryprogress} -setup {
     set query foo=bar
     set sep ""
     set i 0
@@ -216,19 +211,20 @@ test http-3.10 {http::geturl queryprogress} {
 	append query $sep$query
 	set sep &
     }
-
+} -body {
     proc postProgress {token x y} {
 	global postProgress
 	lappend postProgress $y
     }
     set postProgress {}
-    set t [http::geturl $posturl -query $query \
+    set t [http::geturl $posturl -keepalive 0 -query $query \
 	    -queryprogress postProgress -queryblocksize 16384]
     http::wait $t
     list [http::status $t] [string length $query] $postProgress [http::data $t]
-} {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
-
-test http-3.11 {http::geturl querychannel with -command} {
+} -cleanup {
+    http::cleanup $t
+} -result {ok 122879 {16384 32768 49152 65536 81920 98304 114688 122879} {Got 122879 bytes}}
+test http-3.11 {http::geturl querychannel with -command} -setup {
     set query foo=bar
     set sep ""
     set i 0
@@ -239,8 +235,8 @@ test http-3.11 {http::geturl querychannel with -command} {
 	set sep &
     }
     set file [makeFile $query outdata]
+} -body {
     set fp [open $file]
-
     proc asyncCB {token} {
 	global postResult
 	lappend postResult [http::data $token]
@@ -249,7 +245,6 @@ test http-3.11 {http::geturl querychannel with -command} {
     set t [http::geturl $posturl -querychannel $fp]
     http::wait $t
     set testRes [list [http::status $t] [string length $query] [http::data $t]]
-
     # Now do async
     http::cleanup $t
     close $fp
@@ -258,20 +253,17 @@ test http-3.11 {http::geturl querychannel with -command} {
     set postResult [list PostStart]
     http::wait $t
     close $fp
-
     lappend testRes [http::status $t] $postResult
+} -cleanup {
     removeFile outdata
-    set testRes
-} {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
-
-# On Linux platforms when the client and server are on the same
-# host, the client is unable to read the server's response one
-# it hits the write error.  The status is "eof"
-
-# On Windows, the http::wait procedure gets a
-# "connection reset by peer" error while reading the reply
-
-test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
+    http::cleanup $t
+} -result {ok 122879 {Got 122880 bytes} ok {PostStart {Got 122880 bytes}}}
+# On Linux platforms when the client and server are on the same host, the
+# client is unable to read the server's response one it hits the write error.
+# The status is "eof".
+# On Windows, the http::wait procedure gets a "connection reset by peer" error
+# while reading the reply.
+test http-3.12 {http::geturl querychannel with aborted request} -setup {
     set query foo=bar
     set sep ""
     set i 0
@@ -282,8 +274,8 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
 	set sep &
     }
     set file [makeFile $query outdata]
+} -constraints {nonPortable} -body {
     set fp [open $file]
-
     proc asyncCB {token} {
 	global postResult
 	lappend postResult [http::data $token]
@@ -301,86 +293,198 @@ test http-3.12 {http::geturl querychannel with aborted request} {nonPortable} {
 	http::wait $t
 	upvar #0 $t state
     } err]} {
-	puts $errorInfo
+	puts $::errorInfo
 	error $err
     }
-
-    removeFile outdata
     list [http::status $t] [http::code $t]
-} {ok {HTTP/1.0 200 Data follows}}
-
+} -cleanup {
+    removeFile outdata
+    http::cleanup $t
+} -result {ok {HTTP/1.0 200 Data follows}}
 test http-3.13 {http::geturl socket leak test} {
     set chanCount [llength [file channels]]
     for {set i 0} {$i < 3} {incr i} {
-	catch {http::geturl $badurl -timeout 5000} 
+	catch {http::geturl $badurl -timeout 5000}
     }
 
     # No extra channels should be taken
     expr {[llength [file channels]] == $chanCount}
 } 1
-
-test http-3.14 "http::geturl $fullurl" {
+test http-3.14 "http::geturl $fullurl" -body {
     set token [http::geturl $fullurl -validate 1]
     http::code $token
-} "HTTP/1.0 200 OK"
-
-test http-4.1 {http::Event} {
-    set token [http::geturl $url]
+} -cleanup {
+    http::cleanup $token
+} -result "HTTP/1.0 200 OK"
+test http-3.15 {http::geturl parse failures} -body {
+    http::geturl "{invalid}:url"
+} -returnCodes error -result {Unsupported URL: {invalid}:url}
+test http-3.16 {http::geturl parse failures} -body {
+    http::geturl http:relative/url
+} -returnCodes error -result {Unsupported URL: http:relative/url}
+test http-3.17 {http::geturl parse failures} -body {
+    http::geturl /absolute/url
+} -returnCodes error -result {Missing host part: /absolute/url}
+test http-3.18 {http::geturl parse failures} -body {
+    http::geturl http://somewhere:123456789/
+} -returnCodes error -result {Invalid port number: 123456789}
+test http-3.19 {http::geturl parse failures} -body {
+    http::geturl http://{user}@somewhere
+} -returnCodes error -result {Illegal characters in URL user}
+test http-3.20 {http::geturl parse failures} -body {
+    http::geturl http://%user@somewhere
+} -returnCodes error -result {Illegal encoding character usage "%us" in URL user}
+test http-3.21 {http::geturl parse failures} -body {
+    http::geturl http://somewhere/{path}
+} -returnCodes error -result {Illegal characters in URL path}
+test http-3.22 {http::geturl parse failures} -body {
+    http::geturl http://somewhere/%path
+} -returnCodes error -result {Illegal encoding character usage "%pa" in URL path}
+test http-3.23 {http::geturl parse failures} -body {
+    http::geturl http://somewhere/path?{query}?
+} -returnCodes error -result {Illegal characters in URL path}
+test http-3.24 {http::geturl parse failures} -body {
+    http::geturl http://somewhere/path?%query
+} -returnCodes error -result {Illegal encoding character usage "%qu" in URL path}
+test http-3.25 {http::meta} -setup {
+    unset -nocomplain m token
+} -body {
+    set token [http::geturl $url -timeout 2000]
+    array set m [http::meta $token]
+    lsort [array names m]
+} -cleanup {
+    http::cleanup $token
+    unset -nocomplain m token
+} -result {Content-Length Content-Type Date}
+test http-3.26 {http::meta} -setup {
+    unset -nocomplain m token
+} -body {
+    set token [http::geturl $url -headers {X-Check 1} -timeout 2000]
+    array set m [http::meta $token]
+    lsort [array names m]
+} -cleanup {
+    http::cleanup $token
+    unset -nocomplain m token
+} -result {Content-Length Content-Type Date X-Check}
+test http-3.27 {http::geturl: -headers override -type} -body {
+    set token [http::geturl $url/headers -type "text/plain" -query dummy \
+	    -headers [list "Content-Type" "text/plain;charset=utf-8"]]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -match regexp -result {(?n)Accept \*/\*
+Host .*
+User-Agent .*
+Connection close
+Content-Type {text/plain;charset=utf-8}
+Accept-Encoding .*
+Content-Length 5}
+test http-3.28 {http::geturl: -headers override -type default} -body {
+    set token [http::geturl $url/headers -query dummy \
+	    -headers [list "Content-Type" "text/plain;charset=utf-8"]]
+    http::data $token
+} -cleanup {
+    http::cleanup $token
+} -match regexp -result {(?n)Accept \*/\*
+Host .*
+User-Agent .*
+Connection close
+Content-Type {text/plain;charset=utf-8}
+Accept-Encoding .*
+Content-Length 5}
+test http-3.29 {http::geturl IPv6 address} -body {
+    # We only want to see if the URL gets parsed correctly. This is
+    # the case if http::geturl succeeds or returns a socket related
+    # error. If the parsing is wrong, we'll get a parse error.
+    # It'd be better to separate the URL parser from http::geturl, so
+    # that it can be tested without also trying to make a connection.
+    set error [catch {http::geturl $ipv6url -validate 1} token]
+    if {$error && [string match "couldn't open socket: *" $token]} {
+            set error 0
+    }
+    set error
+} -cleanup {
+    catch { http::cleanup $token }
+} -result 0
+test http-3.30 {http::geturl query without path} -body {
+    set token [http::geturl $authorityurl?var=val]
+    http::ncode $token
+} -cleanup {
+    catch { http::cleanup $token }
+} -result 200
+test http-3.31 {http::geturl fragment without path} -body {
+    set token [http::geturl "$authorityurl#fragment42"]
+    http::ncode $token
+} -cleanup {
+    catch { http::cleanup $token }
+} -result 200
+test http-4.1 {http::Event} -body {
+    set token [http::geturl $url -keepalive 0]
     upvar #0 $token data
     array set meta $data(meta)
-    expr ($data(totalsize) == $meta(Content-Length))
-} 1
-
-test http-4.2 {http::Event} {
+    expr {($data(totalsize) == $meta(Content-Length))}
+} -cleanup {
+    http::cleanup $token
+} -result 1
+test http-4.2 {http::Event} -body {
     set token [http::geturl $url]
     upvar #0 $token data
     array set meta $data(meta)
     string compare $data(type) [string trim $meta(Content-Type)]
-} 0
-
-test http-4.3 {http::Event} {
+} -cleanup {
+    http::cleanup $token
+} -result 0
+test http-4.3 {http::Event} -body {
     set token [http::geturl $url]
     http::code $token
-} {HTTP/1.0 200 Data follows}
-
-test http-4.4 {http::Event} {
+} -cleanup {
+    http::cleanup $token
+} -result {HTTP/1.0 200 Data follows}
+test http-4.4 {http::Event} -setup {
     set testfile [makeFile "" testfile]
+} -body {
     set out [open $testfile w]
     set token [http::geturl $url -channel $out]
     close $out
     set in [open $testfile]
     set x [read $in]
-    close $in
+} -cleanup {
+    catch {close $in}
+    catch {close $out}
     removeFile $testfile
-    set x
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
 <h2>GET $tail</h2>
 </body></html>"
-
-test http-4.5 {http::Event} {
+test http-4.5 {http::Event} -setup {
     set testfile [makeFile "" testfile]
+} -body {
     set out [open $testfile w]
+    fconfigure $out -translation lf
     set token [http::geturl $url -channel $out]
     close $out
     upvar #0 $token data
+    expr {$data(currentsize) == $data(totalsize)}
+} -cleanup {
     removeFile $testfile
-    expr $data(currentsize) == $data(totalsize)
-} 1
-
-test http-4.6 {http::Event} {
+    http::cleanup $token
+} -result 1
+test http-4.6 {http::Event} -setup {
     set testfile [makeFile "" testfile]
+} -body {
     set out [open $testfile w]
     set token [http::geturl $binurl -channel $out]
     close $out
     set in [open $testfile]
     fconfigure $in -translation binary
-    set x [read $in]
-    close $in
+    read $in
+} -cleanup {
+    catch {close $in}
+    catch {close $out}
     removeFile $testfile
-    set x
-} "$bindata$binurl"
-
+    http::cleanup $token
+} -result "$bindata[string trimleft $binurl /]"
 proc myProgress {token total current} {
     global progress httpLog
     if {[info exists httpLog] && $httpLog} {
@@ -388,161 +492,152 @@ proc myProgress {token total current} {
     }
     set progress [list $total $current]
 }
-if 0 {
-    # This test hangs on Windows95 because the client never gets EOF
-    set httpLog 1
-    test http-4.6 {http::Event} {
-	set token [http::geturl $url -blocksize 50 -progress myProgress]
-	set progress
-    } {111 111}
-}
-test http-4.7 {http::Event} {
-    set token [http::geturl $url -progress myProgress]
-    set progress
+test http-4.6.1 {http::Event} knownBug {
+    set token [http::geturl $url -blocksize 50 -progress myProgress]
+    return $progress
 } {111 111}
-test http-4.8 {http::Event} {
+test http-4.7 {http::Event} -body {
+    set token [http::geturl $url -keepalive 0 -progress myProgress]
+    return $progress
+} -cleanup {
+    http::cleanup $token
+} -result {111 111}
+test http-4.8 {http::Event} -body {
     set token [http::geturl $url]
     http::status $token
-} {ok}
-test http-4.9 {http::Event} {
+} -cleanup {
+    http::cleanup $token
+} -result {ok}
+test http-4.9 {http::Event} -body {
     set token [http::geturl $url -progress myProgress]
     http::code $token
-} {HTTP/1.0 200 Data follows}
-test http-4.10 {http::Event} {
+} -cleanup {
+    http::cleanup $token
+} -result {HTTP/1.0 200 Data follows}
+test http-4.10 {http::Event} -body {
     set token [http::geturl $url -progress myProgress]
     http::size $token
-} {111}
-
+} -cleanup {
+    http::cleanup $token
+} -result {111}
 # Timeout cases
-
-#	Short timeout to working server  (the test server)
-#	This lets us try a reset during the connection
-
-test http-4.11 {http::Event} {
-    set token [http::geturl $url -timeout 1 -command {#}]
+#	Short timeout to working server (the test server). This lets us try a
+#	reset during the connection.
+test http-4.11 {http::Event} -body {
+    set token [http::geturl $url -timeout 1 -keepalive 0 -command \#]
     http::reset $token
     http::status $token
-} {reset}
-
-#	Longer timeout with reset
-
-test http-4.12 {http::Event} {
-    set token [http::geturl $url/?timeout=10 -command {#}]
+} -cleanup {
+    http::cleanup $token
+} -result {reset}
+#	Longer timeout with reset.
+test http-4.12 {http::Event} -body {
+    set token [http::geturl $url/?timeout=10 -keepalive 0 -command \#]
     http::reset $token
     http::status $token
-} {reset}
-
-#	Medium timeout to working server that waits even longer
-#	The timeout hits while waiting for a reply
-
-test http-4.13 {http::Event} {
-    set token [http::geturl $url?timeout=30 -timeout 10 -command {#}]
+} -cleanup {
+    http::cleanup $token
+} -result {reset}
+#	Medium timeout to working server that waits even longer. The timeout
+#	hits while waiting for a reply.
+test http-4.13 {http::Event} -body {
+    set token [http::geturl $url?timeout=30 -keepalive 0 -timeout 10 -command \#]
     http::wait $token
     http::status $token
-} {timeout}
-
-#	Longer timeout to good host, bad port, gets an error
-#	after the connection "completes" but the socket is bad
-
-test http-4.14 {http::Event} {
-    set code [catch {
-	set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command {#}]
-	if {[string length $token] == 0} {
-	    error "bogus return from http::geturl"
-	}
-	http::wait $token
-	http::status $token
-    } err]
-    # error code varies among platforms.
-    list $code [regexp {(connect failed|couldn't open socket)} $err]
-} {1 1}
-
+} -cleanup {
+    http::cleanup $token
+} -result {timeout}
+#	Longer timeout to good host, bad port, gets an error after the
+#	connection "completes" but the socket is bad.
+test http-4.14 {http::Event} -body {
+    set token [http::geturl $badurl/?timeout=10 -timeout 10000 -command \#]
+    if {$token eq ""} {
+	error "bogus return from http::geturl"
+    }
+    http::wait $token
+    lindex [http::error $token] 0
+} -cleanup {
+    catch {http::cleanup $token}
+} -result {connect failed connection refused}
 # Bogus host
-
-test http-4.15 {http::Event} {
-    # This test may fail if you use a proxy server.  That is to be
+test http-4.15 {http::Event} -body {
+    # This test may fail if you use a proxy server. That is to be
     # expected and is not a problem with Tcl.
-    set code [catch {
-	set token [http::geturl not_a_host.tcl.tk -timeout 1000 -command {#}]
-	http::wait $token
-	http::status $token
-    } err]
-    # error code varies among platforms.
-    list $code [string match "couldn't open socket*" $err]
-} {1 1}
+    set token [http::geturl //not_a_host.tcl.tk -timeout 1000 -command \#]
+    http::wait $token
+    http::status $token
+    # error codes vary among platforms.
+} -cleanup {
+    catch {http::cleanup $token}
+} -returnCodes 1 -match glob -result "couldn't open socket*"
 
 test http-5.1 {http::formatQuery} {
     http::formatQuery name1 value1 name2 "value two"
-} {name1=value1&name2=value+two}
-
+} {name1=value1&name2=value%20two}
 # test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
-
 test http-5.3 {http::formatQuery} {
     http::formatQuery lines "line1\nline2\nline3"
-} {lines=line1%0d%0aline2%0d%0aline3}
-
+} {lines=line1%0D%0Aline2%0D%0Aline3}
 test http-5.4 {http::formatQuery} {
     http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
-} {name1=%7ebwelch&name2=%c2%a1%c2%a2%c2%a2}
-
+} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2}
 test http-5.5 {http::formatQuery} {
     set enc [http::config -urlencoding]
     http::config -urlencoding iso8859-1
     set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
     http::config -urlencoding $enc
     set res
-} {name1=%7ebwelch&name2=%a1%a2%a2}
+} {name1=~bwelch&name2=%A1%A2%A2}
 
-test http-6.1 {http::ProxyRequired} {
+test http-6.1 {http::ProxyRequired} -body {
     http::config -proxyhost [info hostname] -proxyport $port
     set token [http::geturl $url]
     http::wait $token
-    http::config -proxyhost {} -proxyport {}
     upvar #0 $token data
     set data(body)
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
+} -cleanup {
+    http::config -proxyhost {} -proxyport {}
+    http::cleanup $token
+} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
 <h1>Hello, World!</h1>
-<h2>GET http://$url</h2>
+<h2>GET http:$url</h2>
 </body></html>"
 
 test http-7.1 {http::mapReply} {
     http::mapReply "abc\$\[\]\"\\()\}\{"
-} {abc%24%5b%5d%22%5c%28%29%7d%7b}
-
+} {abc%24%5B%5D%22%5C%28%29%7D%7B}
 test http-7.2 {http::mapReply} {
     # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
     # so make sure this gets converted to utf-8 then urlencoded.
     http::mapReply "\u2208"
-} {%e2%88%88}
-
-test http-7.3 {http::formatQuery} {
+} {%E2%88%88}
+test http-7.3 {http::formatQuery} -setup {
     set enc [http::config -urlencoding]
+} -returnCodes error -body {
     # this would be reverting to http <=2.4 behavior
     http::config -urlencoding ""
-    set res [list [catch {http::mapReply "\u2208"} msg] $msg]
+    http::mapReply "\u2208"
+} -cleanup {
     http::config -urlencoding $enc
-    set res
-} [list 1 "can't read \"formMap(\u2208)\": no such element in array"]
-
-test http-7.4 {http::formatQuery} {
+} -result "can't read \"formMap(\u2208)\": no such element in array"
+test http-7.4 {http::formatQuery} -setup {
     set enc [http::config -urlencoding]
+} -body {
     # this would be reverting to http <=2.4 behavior w/o errors
     # (unknown chars become '?')
     http::config -urlencoding "iso8859-1"
-    set res [http::mapReply "\u2208"]
+    http::mapReply "\u2208"
+} -cleanup {
     http::config -urlencoding $enc
-    set res
-} {%3f}
-
+} -result {%3F}
+
 # cleanup
 catch {unset url}
 catch {unset badurl}
 catch {unset port}
 catch {unset data}
 if {[info exists httpthread]} {
-    testthread send -async $httpthread {
-	testthread exit
-    }
+    thread::release $httpthread
 } else {
     close $listen
 }
@@ -553,3 +648,7 @@ if {[info exists removeHttpd]} {
 
 rename bgerror {}
 ::tcltest::cleanupTests
+
+# Local variables:
+# mode: tcl
+# End:
diff --git a/tests/http11.test b/tests/http11.test
new file mode 100644
index 0000000..230ce5a
--- /dev/null
+++ b/tests/http11.test
@@ -0,0 +1,656 @@
+# http11.test --                                                -*- tcl-*-
+#
+#	Test HTTP/1.1 features.
+#
+# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcltest 2
+namespace import -force ::tcltest::*
+
+package require http 2.8
+
+# start the server
+variable httpd_output
+proc create_httpd {} {
+    proc httpd_read {chan} {
+        variable httpd_output
+        if {[gets $chan line] != -1} {
+            #puts stderr "read '$line'"
+            set httpd_output $line
+        }
+        if {[eof $chan]} {
+            puts stderr "eof from httpd"
+            fileevent $chan readable {}
+            close $chan
+        }
+    }
+    variable httpd_output
+    set httpd_script [file join [pwd] [file dirname [info script]] httpd11.tcl]
+    set httpd [open "|[list [interpreter] -encoding utf-8 $httpd_script]" r+]
+    fconfigure $httpd -buffering line -blocking 0
+    fileevent $httpd readable [list httpd_read $httpd]
+    vwait httpd_output
+    variable httpd_port [lindex $httpd_output 2]
+    return $httpd
+}
+
+proc halt_httpd {} {
+    variable httpd_output
+    variable httpd
+    if {[info exists httpd]} {
+        puts $httpd "quit"
+        vwait httpd_output
+        close $httpd
+    }
+    unset -nocomplain httpd_output httpd
+}
+
+proc meta {tok {key ""}} {
+    set meta [http::meta $tok]
+    if {$key ne ""} {
+        if {[dict exists $meta $key]} {
+            return [dict get $meta $key]
+        } else {
+            return ""
+        }
+    }
+    return $meta
+}
+
+proc check_crc {tok args} {
+    set crc [meta $tok x-crc32]
+    set data [expr {[llength $args] ? [lindex $args 0] : [http::data $tok]}]
+    set chk [format %x [zlib crc32 $data]]
+    if {$crc ne $chk} {
+        return  "crc32 mismatch: $crc ne $chk"
+    }
+    return "ok"
+}
+
+makeFile "<html><head><title>test</title></head>\
+<body><p>this is a test</p>\n\
+[string repeat {<p>This is a tcl test file.</p>} 4192]\n\
+</body></html>" testdoc.html
+
+# -------------------------------------------------------------------------
+
+test http11-1.0 "normal request for document " -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html -timeout 10000]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] [meta $tok connection]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close}
+
+test http11-1.1 "normal,gzip,non-chunked" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 10000 -headers {accept-encoding gzip}]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok gzip {}}
+
+test http11-1.2 "normal,deflated,non-chunked" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 10000 -headers {accept-encoding deflate}]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok deflate {}}
+
+test http11-1.3 "normal,compressed,non-chunked" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 10000 -headers {accept-encoding compress}]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok compress {}}
+
+test http11-1.4 "normal,identity,non-chunked" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 10000 -headers {accept-encoding identity}]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} {}}
+
+test http11-1.5 "normal request for document, unsupported coding" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 10000 -headers {accept-encoding unsupported}]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok content-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {}}
+
+test http11-1.6 "normal, specify 1.1 " -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -protocol 1.1 -timeout 10000]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok connection] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close chunked}
+
+test http11-1.7 "normal, 1.1 and keepalive " -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -protocol 1.1 -keepalive 1 -timeout 10000]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok connection] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} chunked}
+
+test http11-1.8 "normal, 1.1 and keepalive, server close" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -protocol 1.1 -keepalive 1 -timeout 10000]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok connection] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {}}
+
+test http11-1.9 "normal,gzip,chunked" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 10000 -headers {accept-encoding gzip}]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok gzip chunked}
+
+test http11-1.10 "normal,deflate,chunked" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 10000 -headers {accept-encoding deflate}]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok deflate chunked}
+
+test http11-1.11 "normal,compress,chunked" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 10000 -headers {accept-encoding compress}]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok compress chunked}
+
+test http11-1.12 "normal,identity,chunked" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 10000 -headers {accept-encoding identity}]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok] \
+        [meta $tok content-encoding] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} chunked}
+
+# -------------------------------------------------------------------------
+
+test http11-2.0 "-channel" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 5000 -channel $chan]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close chunked}
+
+test http11-2.1 "-channel, encoding gzip" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 5000 -channel $chan -headers {accept-encoding gzip}]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close gzip chunked}
+
+test http11-2.2 "-channel, encoding deflate" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 5000 -channel $chan -headers {accept-encoding deflate}]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close deflate chunked}
+
+test http11-2.3 "-channel,encoding compress" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 5000 -channel $chan \
+                 -headers {accept-encoding compress}]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close compress chunked}
+
+test http11-2.4 "-channel,encoding identity" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 5000 -channel $chan \
+                 -headers {accept-encoding identity}]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {} chunked}
+
+test http11-2.5 "-channel,encoding unsupported" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 5000 -channel $chan \
+                 -headers {accept-encoding unsupported}]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {} chunked}
+
+test http11-2.6 "-channel,encoding gzip,non-chunked" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 5000 -channel $chan -headers {accept-encoding gzip}]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]\
+        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close gzip {} 0}
+
+test http11-2.7 "-channel,encoding deflate,non-chunked" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 5000 -channel $chan -headers {accept-encoding deflate}]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]\
+        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close deflate {} 0}
+
+test http11-2.8 "-channel,encoding compress,non-chunked" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 5000 -channel $chan -headers {accept-encoding compress}]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]\
+        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close compress {} 0}
+
+test http11-2.9 "-channel,encoding identity,non-chunked" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 5000 -channel $chan -headers {accept-encoding identity}]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]\
+        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok close {} {} 0}
+
+test http11-2.10 "-channel,deflate,keepalive" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 5000 -channel $chan -keepalive 1]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]\
+        [expr {[file size testdoc.html]-[file size testfile.tmp]}]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} deflate chunked 0}
+
+test http11-2.11 "-channel,identity,keepalive" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -headers {accept-encoding identity} \
+                 -timeout 5000 -channel $chan -keepalive 1]
+    http::wait $tok
+    seek $chan 0
+    set data [read $chan]
+    list [http::status $tok] [http::code $tok] [check_crc $tok $data]\
+        [meta $tok connection] [meta $tok content-encoding]\
+        [meta $tok transfer-encoding]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {ok {HTTP/1.1 200 OK} ok {} {} chunked}
+
+# -------------------------------------------------------------------------
+#
+# The following tests for the -handler option will require changes in
+# the future. At the moment we cannot handler chunked data with this
+# option. Therefore we currently force HTTP/1.0 protocol version.
+#
+# Once this is solved, these tests should be fixed to assume chunked
+# returns in 3.2 and 3.3 and HTTP/1.1 in all but test 3.1
+
+proc handler {var sock token} {
+    upvar #0 $var data
+    set chunk [read $sock]
+    append data $chunk
+    #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
+    if {[eof $sock]} {
+        #::http::Log "handler eof $sock"
+	chan event $sock readable {}
+    }
+}
+
+test http11-3.0 "-handler,close,identity" -setup {
+    variable httpd [create_httpd]
+    set testdata ""
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 10000 -handler [namespace code [list handler testdata]]]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+        [meta $tok connection] [meta $tok content-encoding] \
+        [meta $tok transfer-encoding] \
+        [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+    http::cleanup $tok
+    unset -nocomplain testdata
+    halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+
+test http11-3.1 "-handler,protocol1.0" -setup {
+    variable httpd [create_httpd]
+    set testdata ""
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html?close=1 \
+                 -timeout 10000 -protocol 1.0 \
+                 -handler [namespace code [list handler testdata]]]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+        [meta $tok connection] [meta $tok content-encoding] \
+        [meta $tok transfer-encoding] \
+        [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+    http::cleanup $tok
+    unset -nocomplain testdata
+    halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+
+test http11-3.2 "-handler,close,chunked" -setup {
+    variable httpd [create_httpd]
+    set testdata ""
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 10000 -keepalive 0 -binary 1\
+                 -handler [namespace code [list handler testdata]]]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+        [meta $tok connection] [meta $tok content-encoding] \
+        [meta $tok transfer-encoding] \
+        [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+    http::cleanup $tok
+    unset -nocomplain testdata
+    halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+
+test http11-3.3 "-handler,keepalive,chunked" -setup {
+    variable httpd [create_httpd]
+    set testdata ""
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -timeout 10000 -keepalive 1 -binary 1\
+                 -handler [namespace code [list handler testdata]]]
+    http::wait $tok
+    list [http::status $tok] [http::code $tok] [check_crc $tok $testdata]\
+        [meta $tok connection] [meta $tok content-encoding] \
+        [meta $tok transfer-encoding] \
+        [expr {[file size testdoc.html]-[string length $testdata]}]
+} -cleanup {
+    http::cleanup $tok
+    unset -nocomplain testdata
+    halt_httpd
+} -result {ok {HTTP/1.0 200 OK} ok close {} {} 0}
+
+test http11-4.0 "normal post request" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set query [http::formatQuery q 1 z 2]
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -query $query -timeout 10000]
+    http::wait $tok
+    list status [http::status $tok] code [http::code $tok]\
+        crc [check_crc $tok]\
+        connection [meta $tok connection]\
+        query-length [meta $tok x-query-length]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}
+
+test http11-4.1 "normal post request, check query length" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set query [http::formatQuery q 1 z 2]
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html \
+                 -headers [list x-check-query yes] \
+                 -query $query -timeout 10000]
+    http::wait $tok
+    list status [http::status $tok] code [http::code $tok]\
+        crc [check_crc $tok]\
+        connection [meta $tok connection]\
+        query-length [meta $tok x-query-length]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 7}
+
+test http11-4.2 "normal post request, check long query length" -setup {
+    variable httpd [create_httpd]
+} -body {
+    set query [string repeat a 24576]
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
+                 -headers [list x-check-query yes]\
+                 -query $query -timeout 10000]
+    http::wait $tok
+    list status [http::status $tok] code [http::code $tok]\
+        crc [check_crc $tok]\
+        connection [meta $tok connection]\
+        query-length [meta $tok x-query-length]
+} -cleanup {
+    http::cleanup $tok
+    halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 24576}
+
+test http11-4.3 "normal post request, check channel query length" -setup {
+    variable httpd [create_httpd]
+    set chan [open [makeFile {} testfile.tmp] wb+]
+    puts -nonewline $chan [string repeat [encoding convertto utf-8 "This is a test\n"] 8192]
+    flush $chan
+    seek $chan 0
+} -body {
+    set tok [http::geturl http://localhost:$httpd_port/testdoc.html\
+                 -headers [list x-check-query yes]\
+                 -querychannel $chan -timeout 10000]
+    http::wait $tok
+    list status [http::status $tok] code [http::code $tok]\
+        crc [check_crc $tok]\
+        connection [meta $tok connection]\
+        query-length [meta $tok x-query-length]
+} -cleanup {
+    http::cleanup $tok
+    close $chan
+    removeFile testfile.tmp
+    halt_httpd
+} -result {status ok code {HTTP/1.1 200 OK} crc ok connection close query-length 122880}
+
+# -------------------------------------------------------------------------
+
+foreach p {create_httpd httpd_read halt_httpd meta check_crc} {
+    if {[llength [info proc $p]]} {rename $p {}}
+}
+removeFile testdoc.html
+unset -nocomplain httpd_port httpd p
+
+::tcltest::cleanupTests
diff --git a/tests/httpd b/tests/httpd
index f41c3c1..232e80a 100644
--- a/tests/httpd
+++ b/tests/httpd
@@ -1,3 +1,4 @@
+# -*- tcl -*-
 #
 # The httpd_ procedures implement a stub http server.
 #
@@ -6,8 +7,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# SCCS: @(#) httpd 1.2 98/02/20 14:51:59
 
 #set httpLog 1
 
@@ -27,7 +26,7 @@ array set httpdErrors {
     404 {Not Found}
     503 {Service Unavailable}
     504 {Service Temporarily Unavailable}
-    }
+}
 
 proc httpdError {sock code args} {
     global httpdErrors
@@ -41,7 +40,7 @@ proc httpdAccept {newsock ipaddr port} {
     fconfigure $newsock -blocking 0 -translation {auto crlf}
     httpd_log $newsock Connect $ipaddr $port
     set data(ipaddr) $ipaddr
-    fileevent $newsock readable [list httpdRead $newsock]
+    after 50 [list fileevent $newsock readable [list httpdRead $newsock]]
 }
 
 # read data from a client request
@@ -56,8 +55,8 @@ proc httpdRead { sock } {
 	# Read the protocol line and parse out the URL and query
 
 	set readCount [gets $sock line]
-	if [regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} \
-		$line x data(proto) data(url) data(query) data(httpversion)] {
+	if {[regexp {(POST|GET|HEAD) ([^?]+)\??([^ ]*) HTTP/(1.[01])} $line \
+		-> data(proto) data(url) data(query) data(httpversion)]} {
 	    set data(state) mime
 	    httpd_log $sock Query $line
 	} else {
@@ -71,6 +70,10 @@ proc httpdRead { sock } {
 	# Read the HTTP headers
 
 	set readCount [gets $sock line]
+        if {[regexp {^([^:]+):(.*)$} $line -> key val]} {
+            lappend data(meta) $key [string trim $val]
+        }
+
     } elseif {$data(state) == "query"} {
 
 	# Read the query data
@@ -96,7 +99,7 @@ proc httpdRead { sock } {
 	}
 	0,mime,HEAD	-
 	0,mime,GET	-
-	0,query,POST	{ 
+	0,query,POST	{
 	    # Empty line at end of headers,
 	    # or eof after query data
 	    httpdRespond $sock
@@ -172,6 +175,14 @@ proc httpdRespond { sock } {
 	    set html "Got [string length $data(query)] bytes"
 	    set type text/plain
 	}
+	*headers* {
+	    set html ""
+	    set type text/plain
+	    foreach {key value} $data(meta) {
+		append html [list $key $value] "\n"
+	    }
+	    set html [string trim $html]
+	}
 	default {
 	    set type text/html
 
@@ -192,19 +203,27 @@ proc httpdRespond { sock } {
 	    append html </body></html>
 	}
     }
-    
-    # Catch errors from premature client closes
 
+    # Catch errors from premature client closes
+    
     catch {
 	if {$data(proto) == "HEAD"} {
 	    puts $sock "HTTP/1.0 200 OK"
 	} else {
-	    puts $sock "HTTP/1.0 200 Data follows"
+            # Split the response to test for [Bug 26245326]
+	    puts -nonewline $sock "HT"
+            flush $sock
+            puts $sock "TP/1.0 200 Data follows"
 	}
 	puts $sock "Date: [clock format [clock seconds] \
                               -format {%a, %d %b %Y %H:%M:%S %Z}]"
 	puts $sock "Content-Type: $type"
 	puts $sock "Content-Length: [string length $html]"
+        foreach {key val} $data(meta) {
+            if {[string match "X-*" $key]} {
+                puts $sock "$key: $val"
+            }
+        }
 	puts $sock ""
 	flush $sock
 	if {$data(proto) != "HEAD"} {
@@ -215,5 +234,3 @@ proc httpdRespond { sock } {
     httpd_log $sock Done ""
     httpdSockDone $sock
 }
-
-
diff --git a/tests/httpd11.tcl b/tests/httpd11.tcl
new file mode 100644
index 0000000..9c543dc
--- /dev/null
+++ b/tests/httpd11.tcl
@@ -0,0 +1,254 @@
+# httpd11.tcl --                                                -*- tcl -*-
+#
+#	A simple httpd for testing HTTP/1.1 client features.
+#	Not suitable for use on a internet connected port.
+#
+# Copyright (C) 2009 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.6
+
+proc ::tcl::dict::get? {dict key} {
+    if {[dict exists $dict $key]} {
+        return [dict get $dict $key]
+    }
+    return
+}
+namespace ensemble configure dict \
+    -map [linsert [namespace ensemble configure dict -map] end get? ::tcl::dict::get?]
+
+proc make-chunk-generator {data {size 4096}} {
+    variable _chunk_gen_uid
+    if {![info exists _chunk_gen_uid]} {set _chunk_gen_uid 0}
+    set lambda {{data size} {
+        set pos 0
+        yield
+        while {1} {
+            set payload [string range $data $pos [expr {$pos + $size - 1}]]
+            incr pos $size
+            set chunk [format %x [string length $payload]]\r\n$payload\r\n
+            yield $chunk
+            if {![string length $payload]} {return}
+        }
+    }}
+    set name chunker[incr _chunk_gen_uid]
+    coroutine $name ::apply $lambda $data $size
+    return $name
+}
+
+proc get-chunks {data {compression gzip}} {
+    switch -exact -- $compression {
+        gzip     { set data [zlib gzip $data] }
+        deflate  { set data [zlib deflate $data] }
+        compress { set data [zlib compress $data] }
+    }
+    
+    set data ""
+    set chunker [make-chunk-generator $data 512]
+    while {[string length [set chunk [$chunker]]]} {
+        append data $chunk
+    }
+    return $data
+}
+
+proc blow-chunks {data {ochan stdout} {compression gzip}} {
+    switch -exact -- $compression {
+        gzip     { set data [zlib gzip $data] }
+        deflate  { set data [zlib deflate $data] }
+        compress { set data [zlib compress $data] }
+    }
+    
+    set chunker [make-chunk-generator $data 512]
+    while {[string length [set chunk [$chunker]]]} {
+        puts -nonewline $ochan $chunk
+    }
+    return
+}
+
+proc mime-type {filename} {
+    switch -exact -- [file extension $filename] {
+        .htm - .html { return {text text/html}}
+        .png { return {binary image/png} }
+        .jpg { return {binary image/jpeg} }
+        .gif { return {binary image/gif} }
+        .css { return {text   text/css} }
+        .xml { return {text   text/xml} }
+        .xhtml {return {text  application/xml+html} }
+        .svg { return {text image/svg+xml} }
+        .txt - .tcl - .c - .h { return {text text/plain}}
+    }
+    return {binary text/plain}
+}
+
+proc Puts {chan s} {puts $chan $s; puts $s}
+
+proc Service {chan addr port} {
+    chan event $chan readable [info coroutine]
+    while {1} {
+        set meta {}
+        chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
+        chan configure $chan -blocking 0
+        yield
+        while {[gets $chan line] < 0} {
+            if {[eof $chan]} {chan event $chan readable {}; close $chan; return}
+            yield
+        }
+        if {[eof $chan]} {chan event $chan readable {}; close $chan; return}
+        foreach {req url protocol} {GET {} HTTP/1.1} break
+        regexp {^(\S+)\s+(.*)\s(\S+)?$} $line -> req url protocol
+
+        puts $line
+        while {[gets $chan line] > 0} {
+            if {[regexp {^([^:]+):(.*)$} $line -> key val]} {
+                puts [list $key [string trim $val]]
+                lappend meta [string tolower $key] [string trim $val]
+            }
+            yield
+        }
+
+        set encoding identity
+        set transfer ""
+        set close 1
+        set type text/html
+        set code "404 Not Found"
+        set data "<html><head><title>Error 404</title></head>"
+        append data "<body><h1>Not Found</h1><p>Try again.</p></body></html>"
+
+        if {[scan $url {%[^?]?%s} path query] < 2} {
+            set query ""
+        }
+
+        switch -exact -- $req {
+            GET - HEAD {
+            }
+            POST {
+                # Read the query.
+                set qlen [dict get? $meta content-length]
+                if {[string is integer -strict $qlen]} {
+                    chan configure $chan -buffering none -translation binary
+                    while {[string length $query] < $qlen} {
+                        append query [read $chan $qlen]
+                        if {[string length $query] < $qlen} {yield}
+                    }
+                    # Check for excess query bytes [Bug 2715421]
+                    if {[dict get? $meta x-check-query] eq "yes"} {
+                        chan configure $chan -blocking 0
+                        append query [read $chan]
+                    }
+                }
+            }
+            default {
+                # invalid request error 5??
+            }
+        }
+        if {$query ne ""} {puts $query}
+
+        set path [string trimleft $path /]
+        set path [file join [pwd] $path]
+        if {[file exists $path] && [file isfile $path]} {
+            foreach {what type} [mime-type $path] break
+            set f [open $path r]
+            if {$what eq "binary"} {chan configure $f -translation binary}
+            set data [read $f]
+            close $f
+            set code "200 OK"
+            set close [expr {[dict get? $meta connection] eq "close"}]
+        }
+        
+        if {$protocol eq "HTTP/1.1"} {
+            if {[string match "*deflate*" [dict get? $meta accept-encoding]]} {
+                set encoding deflate
+            } elseif {[string match "*gzip*" [dict get? $meta accept-encoding]]} {
+                set encoding gzip
+            } elseif {[string match "*compress*" [dict get? $meta accept-encoding]]} {
+                set encoding compress
+            }
+            set transfer chunked
+        } else {
+            set close 1
+        }
+        
+        foreach pair [split $query &] {
+            if {[scan $pair {%[^=]=%s} key val] != 2} {set val ""}
+            switch -exact -- $key {
+                close        {set close 1 ; set transfer 0}
+                transfer     {set transfer $val}
+                content-type {set type $val}
+            }
+        }
+
+        chan configure $chan -buffering line -encoding iso8859-1 -translation crlf
+        Puts $chan "$protocol $code"
+        Puts $chan "content-type: $type"
+        Puts $chan [format "x-crc32: %08x" [zlib crc32 $data]]
+        if {$req eq "POST"} {
+            Puts $chan [format "x-query-length: %d" [string length $query]]
+        }
+        if {$close} {
+            Puts $chan "connection: close"
+        }
+        if {$encoding eq "identity"} {
+            Puts $chan "content-length: [string length $data]"
+        } else {
+            Puts $chan "content-encoding: $encoding"
+        }
+        if {$transfer eq "chunked"} {
+            Puts $chan "transfer-encoding: chunked"
+        }
+        puts $chan ""
+        flush $chan
+
+        chan configure $chan -buffering full -translation binary
+        if {$transfer eq "chunked"} {
+            blow-chunks $data $chan $encoding
+        } elseif {$encoding ne "identity"} {
+            puts -nonewline $chan [zlib $encoding $data]
+        } else {
+            puts -nonewline $chan $data
+        }
+        
+        if {$close} {
+            chan event $chan readable {}
+            close $chan
+            puts "close $chan"
+            return
+        } else {
+            flush $chan
+        }
+        puts "pipeline $chan"
+    }
+}
+
+proc Accept {chan addr port} {
+    coroutine client$chan Service $chan $addr $port
+    return
+}
+
+proc Control {chan} {
+    if {[gets $chan line] != -1} {
+        if {[string trim $line] eq "quit"} {
+            set ::forever 1
+        }
+    }
+    if {[eof $chan]} {
+        chan event $chan readable {}
+    }
+}
+
+proc Main {{port 0}} {
+    set server [socket -server Accept -myaddr localhost $port]
+    puts [chan configure $server -sockname]
+    flush stdout
+    chan event stdin readable [list Control stdin]
+    vwait ::forever
+    close $server
+    return "done"
+}
+
+if {!$tcl_interactive} {
+    set r [catch [linsert $argv 0 Main] err]
+    if {$r} {puts stderr $errorInfo} elseif {[string length $err]} {puts $err}
+    exit $r
+}
diff --git a/tests/httpold.test b/tests/httpold.test
index fe7c607..aeba311 100644
--- a/tests/httpold.test
+++ b/tests/httpold.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: httpold.test,v 1.12 2004/05/19 12:44:27 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
diff --git a/tests/if-old.test b/tests/if-old.test
index 3a850b9..fbcf56c 100644
--- a/tests/if-old.test
+++ b/tests/if-old.test
@@ -12,8 +12,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: if-old.test,v 1.6 2003/03/27 13:19:15 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
diff --git a/tests/if.test b/tests/if.test
index aec98f4..040364a 100644
--- a/tests/if.test
+++ b/tests/if.test
@@ -9,8 +9,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: if.test,v 1.8 2004/09/26 16:36:06 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -20,85 +18,109 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 # Basic "if" operation.
 
 catch {unset a}
-test if-1.1 {TclCompileIfCmd: missing if/elseif test} {
-    list [catch {if} msg] $msg
-} {1 {wrong # args: no expression after "if" argument}}
-test if-1.2 {TclCompileIfCmd: error in if/elseif test} {
-    list [catch {if {[error "error in condition"]} foo} msg] $msg
-} {1 {error in condition}}
+test if-1.1 {TclCompileIfCmd: missing if/elseif test} -body {
+    if
+} -returnCodes error -result {wrong # args: no expression after "if" argument}
+test if-1.2 {TclCompileIfCmd: error in if/elseif test} -body {
+    if {[error "error in condition"]} foo
+} -returnCodes error -result {error in condition}
 test if-1.3 {TclCompileIfCmd: error in if/elseif test} -body {
-    list [catch {if {1+}} msg] $msg $errorInfo
-} -match glob -result {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression*
-    while *ing
-"if {1+}"}}
-test if-1.4 {TclCompileIfCmd: if/elseif test in braces} {
+    list [catch {if {1+}} msg] $msg $::errorInfo
+} -match glob -cleanup {
+    unset msg
+} -result {1 * {*"if {1+}"}}
+test if-1.4 {TclCompileIfCmd: if/elseif test in braces} -body {
     set a {}
     if {1<2} {set a 1}
-    set a
-} {1}
-test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} {
+    return $a
+} -cleanup {
+    unset a
+} -result {1}
+test if-1.5 {TclCompileIfCmd: if/elseif test not in braces} -body {
     set a {}
     if 1<2 {set a 1}
-    set a
-} {1}
-test if-1.6 {TclCompileIfCmd: multiline test expr} {
+    return $a
+} -cleanup {
+    unset a
+} -result {1}
+test if-1.6 {TclCompileIfCmd: multiline test expr} -setup {
     set a {}
+} -body {
     if {($tcl_platform(platform) != "foobar1") && \
 	($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
-    set a
-} 3
-test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} {
+    return $a
+} -cleanup {
+    unset a
+} -result 3
+test if-1.7 {TclCompileIfCmd: "then" after if/elseif test} -body {
     set a {}
     if 4>3 then {set a 1}
-    set a
-} {1}
-test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} {
+    return $a
+} -cleanup {
+    unset a
+} -result {1}
+test if-1.8 {TclCompileIfCmd: keyword other than "then" after if/elseif test} -setup {
     set a {}
-    catch {if 1<2 therefore {set a 1}} msg 
-    set msg
-} {invalid command name "therefore"}
-test if-1.9 {TclCompileIfCmd: missing "then" body} {
+} -body {
+    if 1<2 therefore {set a 1}
+} -cleanup {
+    unset a
+} -returnCodes error -result {invalid command name "therefore"}
+test if-1.9 {TclCompileIfCmd: missing "then" body} -setup {
     set a {}
-    catch {if 1<2 then} msg 
-    set msg
-} {wrong # args: no script following "then" argument}
+} -body {
+    if 1<2 then
+} -cleanup {
+    unset a
+} -returnCodes error -result {wrong # args: no script following "then" argument}
 test if-1.10 {TclCompileIfCmd: error in "then" body} -body {
     set a {}
-    list [catch {if {$a!="xxx"} then {set}} msg] $msg $errorInfo
-} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+    list [catch {if {$a!="xxx"} then {set}} msg] $msg $::errorInfo
+} -match glob -cleanup {
+    unset a msg
+} -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}}
-test if-1.11 {TclCompileIfCmd: error in "then" body} {
-    list [catch {if 2 then {[error "error in then clause"]}} msg] $msg
-} {1 {error in then clause}}
-test if-1.12 {TclCompileIfCmd: "then" body in quotes} {
+test if-1.11 {TclCompileIfCmd: error in "then" body} -body {
+    if 2 then {[error "error in then clause"]}
+} -returnCodes error -result {error in then clause}
+test if-1.12 {TclCompileIfCmd: "then" body in quotes} -body {
     set a {}
     if 27>17 "append a x"
-    set a
-} {x}
-test if-1.13 {TclCompileIfCmd: computed "then" body} {
+    return $a
+} -cleanup {
+    unset a
+} -result {x}
+test if-1.13 {TclCompileIfCmd: computed "then" body} -setup {
     catch {unset x1}
     catch {unset x2}
-    set a {}
+} -body {
     set x1 {append a x1}
     set x2 {; append a x2}
     set a {}
     if 1 $x1$x2
-    set a
-} {x1x2}
-test if-1.14 {TclCompileIfCmd: taking proper branch} {
+    return $a
+} -cleanup {
+    unset a x1 x2
+} -result {x1x2}
+test if-1.14 {TclCompileIfCmd: taking proper branch} -body {
     set a {}
     if 1<2 {set a 1}
-    set a
-} 1
-test if-1.15 {TclCompileIfCmd: taking proper branch} {
+    return $a
+} -cleanup {
+    unset a
+} -result 1
+test if-1.15 {TclCompileIfCmd: taking proper branch} -body {
     set a {}
     if 1>2 {set a 1}
-    set a
-} {}
-test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} {
+    return $a
+} -cleanup {
+    unset a
+} -result {}
+test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long "then" body} -setup {
     catch {unset i}
     set a {}
+} -body {
     if 1<2 {
 	set a 1
 	while {$a != "xxx"} {
@@ -148,40 +170,54 @@ test if-1.16 {TclCompileIfCmd: test jumpFalse instruction replacement after long
 	}
 	set a 3
     }
-    set a
-} 3
-test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} {
+    return $a
+} -cleanup {
+    unset a
+    unset -nocomplain i
+} -result 3
+test if-1.17 {TclCompileIfCmd: if/elseif test in quotes} -setup {
     set a {}
-    list [catch {if {"0 < 3"} {set a 1}} msg] $msg
-} {1 {expected boolean value but got "0 < 3"}}
-
+} -body {
+    if {"0 < 3"} {set a 1}
+} -returnCodes error -cleanup {
+    unset a
+} -result {expected boolean value but got "0 < 3"}
 
-test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} {
+test if-2.1 {TclCompileIfCmd: "elseif" after if/elseif test} -setup {
     set a {}
+} -body {
     if 3>4 {set a 1} elseif 1 {set a 2}
-    set a
-} {2}
+    return $a
+} -cleanup {
+    unset a
+} -result {2}
 # Since "else" is optional, the "elwood" below is treated as a command.
 # But then there shouldn't be any additional argument words for the "if".
-test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} {
+test if-2.2 {TclCompileIfCmd: keyword other than "elseif"} -setup {
     set a {}
-    catch {if 1<2 {set a 1} elwood {set a 2}} msg 
-    set msg
-} {wrong # args: extra words after "else" clause in "if" command}
-test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} {
+} -body {
+    if 1<2 {set a 1} elwood {set a 2}
+} -returnCodes error -cleanup {
+    unset a
+} -result {wrong # args: extra words after "else" clause in "if" command}
+test if-2.3 {TclCompileIfCmd: missing expression after "elseif"} -setup {
     set a {}
-    catch {if 1<2 {set a 1} elseif} msg 
-    set msg
-} {wrong # args: no expression after "elseif" argument}
-test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -body {
+} -body {
+    if 1<2 {set a 1} elseif
+} -returnCodes error -cleanup {
+    unset a
+} -result {wrong # args: no expression after "elseif" argument}
+test if-2.4 {TclCompileIfCmd: error in expression after "elseif"} -setup {
     set a {}
-    list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
-} -match glob -result {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression*
-    while *ing
-"if 3>4 {set a 1} elseif {1>}"}}
-test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} {
+} -body {
+    list [catch {if 3>4 {set a 1} elseif {1>}} msg] $msg $::errorInfo
+} -match glob -cleanup {
+    unset a msg
+} -result {1 * {*"if 3>4 {set a 1} elseif {1>}"}}
+test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long "elseif" body} -setup {
     catch {unset i}
     set a {}
+} -body {
     if 1>2 {
 	set a 1
 	while {$a != "xxx"} {
@@ -279,44 +315,59 @@ test if-2.5 {TclCompileIfCmd: test jumpFalse instruction replacement after long
 	}
 	set a 6
     }
-    set a
-} 6
+    return $a
+} -cleanup {
+    unset a
+    unset -nocomplain i
+} -result 6
 
-test if-3.1 {TclCompileIfCmd: "else" clause} {
+test if-3.1 {TclCompileIfCmd: "else" clause} -body {
     set a {}
     if 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
-    set a
-} 3
+    return $a
+} -cleanup {
+    unset a
+} -result 3
 # Since "else" is optional, the "elsex" below is treated as a command.
 # But then there shouldn't be any additional argument words for the "if".
-test if-3.2 {TclCompileIfCmd: keyword other than "else"} {
+test if-3.2 {TclCompileIfCmd: keyword other than "else"} -setup {
     set a {}
-    catch {if 1<2 then {set a 1} elsex {set a 2}} msg 
-    set msg
-} {wrong # args: extra words after "else" clause in "if" command}
-test if-3.3 {TclCompileIfCmd: missing body after "else"} {
+} -body {
+    if 1<2 then {set a 1} elsex {set a 2}
+} -returnCodes error -cleanup {
+    unset a
+} -result {wrong # args: extra words after "else" clause in "if" command}
+test if-3.3 {TclCompileIfCmd: missing body after "else"} -setup {
     set a {}
-    catch {if 2<1 {set a 1} else} msg 
-    set msg
-} {wrong # args: no script following "else" argument}
-test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -body {
+} -body {
+    if 2<1 {set a 1} else
+} -returnCodes error -cleanup {
+    unset a
+} -result {wrong # args: no script following "else" argument}
+test if-3.4 {TclCompileIfCmd: error compiling body after "else"} -setup {
     set a {}
-    catch {if 2<1 {set a 1} else {set}} msg 
-    set errorInfo
-} -match glob -result {wrong # args: should be "set varName ?newValue?"
+} -body {
+    catch {if 2<1 {set a 1} else {set}}
+    set ::errorInfo
+} -match glob -cleanup {
+    unset a
+} -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
-test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} {
+test if-3.5 {TclCompileIfCmd: extra arguments after "else" argument} -setup {
     set a {}
-    catch {if 2<1 {set a 1} else {set a 2} or something} msg 
-    set msg
-} {wrong # args: extra words after "else" clause in "if" command}
+} -body {
+    if 2<1 {set a 1} else {set a 2} or something
+} -returnCodes error -cleanup {
+    unset a
+} -result {wrong # args: extra words after "else" clause in "if" command}
 # The following test also checks whether contained loops and other
 # commands are properly relocated because a short jump must be replaced
 # by a "long distance" one.
-test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} {
+test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long "else" clause} -setup {
     catch {unset i}
     set a {}
+} -body {
     if 1>2 {
 	set a 1
 	while {$a != "xxx"} {
@@ -462,134 +513,185 @@ test if-3.6 {TclCompileIfCmd: test jumpFalse instruction replacement after long
 	}
 	set a 9
     }
-    set a
-} 9
+    return $a
+} -cleanup {
+    unset a
+    unset -nocomplain i
+} -result 9
 
-test if-4.1 {TclCompileIfCmd: "if" command result} {
+test if-4.1 {TclCompileIfCmd: "if" command result} -setup {
     set a {}
+} -body {
     set a [if 3<4 {set i 27}]
-    set a
-} 27
-test if-4.2 {TclCompileIfCmd: "if" command result} {
+    return $a
+} -cleanup {
+    unset a
+    unset -nocomplain i
+} -result 27
+test if-4.2 {TclCompileIfCmd: "if" command result} -setup {
     set a {}
+} -body {
     set a [if 3>4 {set i 27}]
-    set a
-} {}
-test if-4.3 {TclCompileIfCmd: "if" command result} {
+    return $a
+} -cleanup {
+    unset a
+    unset -nocomplain i
+} -result {}
+test if-4.3 {TclCompileIfCmd: "if" command result} -setup {
     set a {}
+} -body {
     set a [if 0 {set i 1} elseif 1 {set i 2}]
-    set a
-} 2
-test if-4.4 {TclCompileIfCmd: "if" command result} {
+    return $a
+} -cleanup {
+    unset a
+    unset -nocomplain i
+} -result 2
+test if-4.4 {TclCompileIfCmd: "if" command result} -setup {
     set a {}
+} -body {
     set a [if 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
-    set a
-} 4
-test if-4.5 {TclCompileIfCmd: return value} {
+    return $a
+} -cleanup {
+    unset a i
+} -result 4
+test if-4.5 {TclCompileIfCmd: return value} -body {
     if 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
-} def
+} -cleanup {
+    unset -nocomplain a
+} -result def
 
 # Check "if" and computed command names.
 
-catch {unset a}
-test if-5.1 {if cmd with computed command names: missing if/elseif test} {
+test if-5.1 {if cmd with computed command names: missing if/elseif test} -body {
     set z if
-    list [catch {$z} msg] $msg
-} {1 {wrong # args: no expression after "if" argument}}
-
-test if-5.2 {if cmd with computed command names: error in if/elseif test} {
+    $z
+} -returnCodes error -cleanup {
+    unset z
+} -result {wrong # args: no expression after "if" argument}
+test if-5.2 {if cmd with computed command names: error in if/elseif test} -body {
     set z if
-    list [catch {$z {[error "error in condition"]} foo} msg] $msg
-} {1 {error in condition}}
-test if-5.3 {if cmd with computed command names: error in if/elseif test} {
-    set z if
-    list [catch {$z {1+}} msg] $msg $errorInfo
-} {1 {syntax error in expression "1+": premature end of expression} {syntax error in expression "1+": premature end of expression
-    while executing
-"$z {1+}"}}
-test if-5.4 {if cmd with computed command names: if/elseif test in braces} {
+    $z {[error "error in condition"]} foo
+} -returnCodes error -cleanup {
+    unset z
+} -result {error in condition}
+test if-5.3 {if cmd with computed command names: error in if/elseif test} -body {
     set z if
+    list [catch {$z {1+}}] $::errorInfo
+} -match glob -cleanup {
+    unset z
+} -result {1 {*"$z {1+}"}}
+test if-5.4 {if cmd with computed command names: if/elseif test in braces} -setup {
     set a {}
-    $z {1<2} {set a 1}
-    set a
-} {1}
-test if-5.5 {if cmd with computed command names: if/elseif test not in braces} {
+} -body {
     set z if
+    $z {1<2} {set a 1}
+    return $a
+} -cleanup {
+    unset a z
+} -result {1}
+test if-5.5 {if cmd with computed command names: if/elseif test not in braces} -setup {
     set a {}
+} -body {
+    set z if
     $z 1<2 {set a 1}
-    set a
-} {1}
-test if-5.6 {if cmd with computed command names: multiline test expr} {
+    return $a
+} -cleanup {
+    unset a z
+} -result {1}
+test if-5.6 {if cmd with computed command names: multiline test expr} -body {
     set z if
-    set a {}
     $z {($tcl_platform(platform) != "foobar1") && \
 	($tcl_platform(platform) != "foobar2")} {set a 3} else {set a 4}
-    set a
-} 3
-test if-5.7 {if cmd with computed command names: "then" after if/elseif test} {
-    set z if
+    return $a
+} -cleanup {
+    unset a z
+} -result 3
+test if-5.7 {if cmd with computed command names: "then" after if/elseif test} -setup {
     set a {}
-    $z 4>3 then {set a 1}
-    set a
-} {1}
-test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} {
+} -body {
     set z if
+    $z 4>3 then {set a 1}
+    return $a
+} -cleanup {
+    unset a z
+} -result {1}
+test if-5.8 {if cmd with computed command names: keyword other than "then" after if/elseif test} -setup {
     set a {}
-    catch {$z 1<2 therefore {set a 1}} msg 
-    set msg
-} {invalid command name "therefore"}
-test if-5.9 {if cmd with computed command names: missing "then" body} {
+} -body {
     set z if
+    $z 1<2 therefore {set a 1}
+} -returnCodes error -cleanup {
+    unset a z
+} -result {invalid command name "therefore"}
+test if-5.9 {if cmd with computed command names: missing "then" body} -setup {
     set a {}
-    catch {$z 1<2 then} msg 
-    set msg
-} {wrong # args: no script following "then" argument}
+} -body {
+    set z if
+    $z 1<2 then
+} -returnCodes error -cleanup {
+    unset a z
+} -result {wrong # args: no script following "then" argument}
 test if-5.10 {if cmd with computed command names: error in "then" body} -body {
     set z if
     set a {}
-    list [catch {$z {$a!="xxx"} then {set}} msg] $msg $errorInfo
-} -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
+    list [catch {$z {$a!="xxx"} then {set}} msg] $msg $::errorInfo
+} -match glob -cleanup {
+    unset a z msg
+} -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"
     invoked from within
 "$z {$a!="xxx"} then {set}"}}
-test if-5.11 {if cmd with computed command names: error in "then" body} {
-    set z if
-    list [catch {$z 2 then {[error "error in then clause"]}} msg] $msg
-} {1 {error in then clause}}
-test if-5.12 {if cmd with computed command names: "then" body in quotes} {
+test if-5.11 {if cmd with computed command names: error in "then" body} -body {
     set z if
+    $z 2 then {[error "error in then clause"]}
+} -returnCodes error -cleanup {
+    unset z
+} -result {error in then clause}
+test if-5.12 {if cmd with computed command names: "then" body in quotes} -setup {
     set a {}
-    $z 27>17 "append a x"
-    set a
-} {x}
-test if-5.13 {if cmd with computed command names: computed "then" body} {
+} -body {
     set z if
+    $z 27>17 "append a x"
+    return $a
+} -cleanup {
+    unset a z
+} -result {x}
+test if-5.13 {if cmd with computed command names: computed "then" body} -setup {
     catch {unset x1}
     catch {unset x2}
-    set a {}
+} -body {
+    set z if
     set x1 {append a x1}
     set x2 {; append a x2}
     set a {}
     $z 1 $x1$x2
-    set a
-} {x1x2}
-test if-5.14 {if cmd with computed command names: taking proper branch} {
-    set z if
+    return $a
+} -cleanup {
+    unset a z x1 x2
+} -result {x1x2}
+test if-5.14 {if cmd with computed command names: taking proper branch} -setup {
     set a {}
-    $z 1<2 {set a 1}
-    set a
-} 1
-test if-5.15 {if cmd with computed command names: taking proper branch} {
+} -body {
     set z if
+    $z 1<2 {set a 1}
+    return $a
+} -cleanup {
+    unset a z
+} -result 1
+test if-5.15 {if cmd with computed command names: taking proper branch} -body {
     set a {}
-    $z 1>2 {set a 1}
-    set a
-} {}
-test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} {
     set z if
+    $z 1>2 {set a 1}
+    return $a
+} -cleanup {
+    unset a z
+} -result {}
+test if-5.16 {if cmd with computed command names: test jumpFalse instruction replacement after long "then" body} -setup {
     catch {unset i}
     set a {}
+} -body {
+    set z if
     $z 1<2 {
 	set a 1
 	while {$a != "xxx"} {
@@ -639,46 +741,60 @@ test if-5.16 {if cmd with computed command names: test jumpFalse instruction rep
 	}
 	set a 3
     }
-    set a
-} 3
-test if-5.17 {if cmd with computed command names: if/elseif test in quotes} {
-    set z if
+    return $a
+} -cleanup {
+    unset a z
+    unset -nocomplain i
+} -result 3
+test if-5.17 {if cmd with computed command names: if/elseif test in quotes} -setup {
     set a {}
-    list [catch {$z {"0 < 3"} {set a 1}} msg] $msg
-} {1 {expected boolean value but got "0 < 3"}}
-
-
-test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} {
+} -body {
     set z if
+    $z {"0 < 3"} {set a 1}
+} -returnCodes error -cleanup {
+    unset a z
+} -result {expected boolean value but got "0 < 3"}
+
+test if-6.1 {if cmd with computed command names: "elseif" after if/elseif test} -setup {
     set a {}
+} -body {
+    set z if
     $z 3>4 {set a 1} elseif 1 {set a 2}
-    set a
-} {2}
+    return $a
+} -cleanup {
+    unset a z
+} -result {2}
 # Since "else" is optional, the "elwood" below is treated as a command.
 # But then there shouldn't be any additional argument words for the "if".
-test if-6.2 {if cmd with computed command names: keyword other than "elseif"} {
-    set z if
+test if-6.2 {if cmd with computed command names: keyword other than "elseif"} -setup {
     set a {}
-    catch {$z 1<2 {set a 1} elwood {set a 2}} msg 
-    set msg
-} {wrong # args: extra words after "else" clause in "if" command}
-test if-6.3 {if cmd with computed command names: missing expression after "elseif"} {
+} -body {
     set z if
+    $z 1<2 {set a 1} elwood {set a 2}
+} -returnCodes error -cleanup {
+    unset a z
+} -result {wrong # args: extra words after "else" clause in "if" command}
+test if-6.3 {if cmd with computed command names: missing expression after "elseif"} -setup {
     set a {}
-    catch {$z 1<2 {set a 1} elseif} msg 
-    set msg
-} {wrong # args: no expression after "elseif" argument}
-test if-6.4 {if cmd with computed command names: error in expression after "elseif"} {
+} -body {
     set z if
+    $z 1<2 {set a 1} elseif
+} -returnCodes error -cleanup {
+    unset a z
+} -result {wrong # args: no expression after "elseif" argument}
+test if-6.4 {if cmd with computed command names: error in expression after "elseif"} -setup {
     set a {}
-    list [catch {$z 3>4 {set a 1} elseif {1>}} msg] $msg $errorInfo
-} {1 {syntax error in expression "1>": premature end of expression} {syntax error in expression "1>": premature end of expression
-    while executing
-"$z 3>4 {set a 1} elseif {1>}"}}
-test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} {
+} -body {
     set z if
+    list [catch {$z 3>4 {set a 1} elseif {1>}}] $::errorInfo
+} -match glob -cleanup {
+    unset a z
+} -result {1 {*"$z 3>4 {set a 1} elseif {1>}"}}
+test if-6.5 {if cmd with computed command names: test jumpFalse instruction replacement after long "elseif" body} -setup {
     catch {unset i}
     set a {}
+} -body {
+    set z if
     $z 1>2 {
 	set a 1
 	while {$a != "xxx"} {
@@ -776,52 +892,68 @@ test if-6.5 {if cmd with computed command names: test jumpFalse instruction repl
 	}
 	set a 6
     }
-    set a
-} 6
+    return $a
+} -cleanup {
+    unset a z
+    unset -nocomplain i
+} -result 6
 
-test if-7.1 {if cmd with computed command names: "else" clause} {
-    set z if
+test if-7.1 {if cmd with computed command names: "else" clause} -setup {
     set a {}
+} -body {
+    set z if
     $z 3>4 {set a 1} elseif {$a == "foo"} {set a 2} else {set a 3}
-    set a
-} 3
+    return $a
+} -cleanup {
+    unset a z
+} -result 3
 # Since "else" is optional, the "elsex" below is treated as a command.
 # But then there shouldn't be any additional argument words for the "if".
-test if-7.2 {if cmd with computed command names: keyword other than "else"} {
-    set z if
+test if-7.2 {if cmd with computed command names: keyword other than "else"} -setup {
     set a {}
-    catch {$z 1<2 then {set a 1} elsex {set a 2}} msg 
-    set msg
-} {wrong # args: extra words after "else" clause in "if" command}
-test if-7.3 {if cmd with computed command names: missing body after "else"} {
+} -body {
     set z if
+    $z 1<2 then {set a 1} elsex {set a 2}
+} -returnCodes error -cleanup {
+    unset a z
+} -result {wrong # args: extra words after "else" clause in "if" command}
+test if-7.3 {if cmd with computed command names: missing body after "else"} -setup {
     set a {}
-    catch {$z 2<1 {set a 1} else} msg 
-    set msg
-} {wrong # args: no script following "else" argument}
-test if-7.4 {if cmd with computed command names: error compiling body after "else"} -body {
+} -body {
     set z if
+    $z 2<1 {set a 1} else
+} -returnCodes error -cleanup {
+    unset a z
+} -result {wrong # args: no script following "else" argument}
+test if-7.4 {if cmd with computed command names: error compiling body after "else"} -setup {
     set a {}
-    catch {$z 2<1 {set a 1} else {set}} msg 
-    set errorInfo
-} -match glob -result {wrong # args: should be "set varName ?newValue?"
+} -body {
+    set z if
+    catch {$z 2<1 {set a 1} else {set}}
+    return $::errorInfo
+} -match glob -cleanup {
+    unset a z
+} -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"
     invoked from within
 "$z 2<1 {set a 1} else {set}"}
-test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} {
-    set z if
+test if-7.5 {if cmd with computed command names: extra arguments after "else" argument} -setup {
     set a {}
-    catch {$z 2<1 {set a 1} else {set a 2} or something} msg 
-    set msg
-} {wrong # args: extra words after "else" clause in "if" command}
+} -body {
+    set z if
+    $z 2<1 {set a 1} else {set a 2} or something
+} -returnCodes error -cleanup {
+    unset a z
+} -result {wrong # args: extra words after "else" clause in "if" command}
 # The following test also checks whether contained loops and other
 # commands are properly relocated because a short jump must be replaced
 # by a "long distance" one.
-test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} {
-    set z if
+test if-7.6 {if cmd with computed command names: test jumpFalse instruction replacement after long "else" clause} -setup {
     catch {unset i}
     set a {}
+} -body {
+    set z if
     $z 1>2 {
 	set a 1
 	while {$a != "xxx"} {
@@ -967,45 +1099,69 @@ test if-7.6 {if cmd with computed command names: test jumpFalse instruction repl
 	}
 	set a 9
     }
-    set a
-} 9
+    return $a
+} -cleanup {
+    unset a z
+    unset -nocomplain i
+} -result 9
 
-test if-8.1 {if cmd with computed command names: "if" command result} {
-    set z if
+test if-8.1 {if cmd with computed command names: "if" command result} -setup {
     set a {}
-    set a [$z 3<4 {set i 27}]
-    set a
-} 27
-test if-8.2 {if cmd with computed command names: "if" command result} {
+} -body {
     set z if
+    set a [$z 3<4 {set i 27}]
+    return $a
+} -cleanup {
+    unset a z
+    unset -nocomplain i
+} -result 27
+test if-8.2 {if cmd with computed command names: "if" command result} -setup {
     set a {}
-    set a [$z 3>4 {set i 27}]
-    set a
-} {}
-test if-8.3 {if cmd with computed command names: "if" command result} {
+} -body {
     set z if
+    set a [$z 3>4 {set i 27}]
+    return $a
+} -cleanup {
+    unset a z
+    unset -nocomplain i
+} -result {}
+test if-8.3 {if cmd with computed command names: "if" command result} -setup {
     set a {}
-    set a [$z 0 {set i 1} elseif 1 {set i 2}]
-    set a
-} 2
-test if-8.4 {if cmd with computed command names: "if" command result} {
+} -body {
     set z if
+    set a [$z 0 {set i 1} elseif 1 {set i 2}]
+    return $a
+} -cleanup {
+    unset a z
+    unset -nocomplain i
+} -result 2
+test if-8.4 {if cmd with computed command names: "if" command result} -setup {
     set a {}
+} -body {
+    set z if
     set a [$z 0 {set i 1} elseif 0 {set i 2} elseif 2>5 {set i 3} else {set i 4}]
-    set a
-} 4
-test if-8.5 {if cmd with computed command names: return value} {
+    return $a
+} -cleanup {
+    unset a z
+    unset -nocomplain i
+} -result 4
+test if-8.5 {if cmd with computed command names: return value} -body {
     set z if
     $z 0 then {set a 22; concat abc} elseif 1 {concat def} {concat ghi}
-} def
+} -cleanup {
+    unset z
+    unset -nocomplain a
+} -result def
 
-test if-9.1 {if cmd with namespace qualifiers} {
+test if-9.1 {if cmd with namespace qualifiers} -body {
     ::if {1} {set x 4}
-} 4
+} -cleanup {
+    unset x
+} -result 4
 
 # Test for incorrect "double evaluation semantics"
 
-test if-10.1 {delayed substitution of then body} {
+test if-10.1 {delayed substitution of then body} -body {
     set j 0
     set if if
     # this is not compiled
@@ -1021,8 +1177,11 @@ test if-10.1 {delayed substitution of then body} {
 	set result
     }
     append result [p]
-} {00}
-test if-10.2 {delayed substitution of elseif expression} {
+} -cleanup {
+    unset j if result
+    rename p {}
+} -result {00}
+test if-10.2 {delayed substitution of elseif expression} -body {
     set j 0
     set if if
     # this is not compiled
@@ -1046,8 +1205,11 @@ test if-10.2 {delayed substitution of elseif expression} {
 	set result
     }
     append result [p]
-} {00}
-test if-10.3 {delayed substitution of elseif body} {
+} -cleanup {
+    unset j if result
+    rename p {}
+} -result {00}
+test if-10.3 {delayed substitution of elseif body} -body {
     set j 0
     set if if
     # this is not compiled
@@ -1066,23 +1228,30 @@ test if-10.3 {delayed substitution of elseif body} {
 	"
     }
     append result [p]
-} {00}
-test if-10.4 {delayed substitution of else body} {
+} -cleanup {
+    unset j if result
+    rename p {}
+} -result {00}
+test if-10.4 {delayed substitution of else body} -body {
     set j 0
     if {[incr j] == 0} {
        set result badthen
     } else "
        set result $j
     "
-    set result
-} {0}
-test if-10.5 {substituted control words} {
+    return $result
+} -cleanup {
+    unset j result
+} -result {0}
+test if-10.5 {substituted control words} -body {
     set then then; proc then {} {return badthen}
     set else else; proc else {} {return badelse}
     set elseif elseif; proc elseif {} {return badelseif}
     list [catch {if 1 $then {if 0 {} $elseif 1 {if 0 {} $else {list ok}}}} a] $a
-} {0 ok}
-test if-10.6 {double invocation of variable traces} {
+} -cleanup {
+    unset then else elseif a
+} -result {0 ok}
+test if-10.6 {double invocation of variable traces} -body {
     set iftracecounter 0
     proc iftraceproc {args} {
        upvar #0 iftracecounter counter
@@ -1098,10 +1267,16 @@ test if-10.6 {double invocation of variable traces} {
     }
     trace variable iftracevar r [list iftraceproc 10]
     list [catch {if "$iftracevar + 20" {}} a] $a \
-        [catch {if "$iftracevar + 20" {}} b] $b \
-        [unset iftracevar iftracecounter]
-} {1 {syntax error in expression "1 oops 10 + 20": extra tokens at end of expression} 0 {} {}}
+        [catch {if "$iftracevar + 20" {}} b] $b
+} -cleanup {
+    unset iftracevar iftracecounter a b
+} -match glob -result {1 {*} 0 {}}
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/incr-old.test b/tests/incr-old.test
index 95250f8..ed457cf 100644
--- a/tests/incr-old.test
+++ b/tests/incr-old.test
@@ -12,8 +12,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: incr-old.test,v 1.8 2004/11/03 17:16:05 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -47,20 +45,17 @@ test incr-old-2.2 {incr errors} {
 } {1 {wrong # args: should be "incr varName ?increment?"}}
 test incr-old-2.3 {incr errors} {
     catch {unset x}
-    list [catch {incr x} msg] $msg $errorInfo
-} {1 {can't read "x": no such variable} {can't read "x": no such variable
-    (reading value of variable to increment)
-    invoked from within
-"incr x"}}
+    incr x
+} 1
 test incr-old-2.4 {incr errors} {
     set x abc
-    list [catch {incr x} msg] $msg $errorInfo
+    list [catch {incr x} msg] $msg $::errorInfo
 } {1 {expected integer but got "abc"} {expected integer but got "abc"
     while executing
 "incr x"}}
 test incr-old-2.5 {incr errors} {
     set x 123
-    list [catch {incr x 1a} msg] $msg $errorInfo
+    list [catch {incr x 1a} msg] $msg $::errorInfo
 } {1 {expected integer but got "1a"} {expected integer but got "1a"
     (reading increment)
     invoked from within
@@ -69,7 +64,7 @@ test incr-old-2.6 {incr errors} -body {
     proc readonly args {error "variable is read-only"}
     set x 123
     trace var x w readonly
-    list [catch {incr x 1} msg] $msg $errorInfo
+    list [catch {incr x 1} msg] $msg $::errorInfo
 } -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
 *
diff --git a/tests/incr.test b/tests/incr.test
index 07526c4..9243be0 100644
--- a/tests/incr.test
+++ b/tests/incr.test
@@ -1,53 +1,56 @@
 # Commands covered:  incr
 #
-# 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) 1996 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.
-#
-# RCS: @(#) $Id: incr.test,v 1.11 2004/11/03 17:16:05 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+unset -nocomplain x i
+proc readonly varName {
+    upvar 1 $varName var
+    trace add variable var write \
+	{apply {{args} {error "variable is read-only"}}}
+}
+
 # Basic "incr" operation.
 
-catch {unset x}
-catch {unset i}
-
-test incr-1.1 {TclCompileIncrCmd: missing variable name} {
-    list [catch {incr} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
+test incr-1.1 {TclCompileIncrCmd: missing variable name} -returnCodes error -body {
+    incr
+} -result {wrong # args: should be "incr varName ?increment?"}
 test incr-1.2 {TclCompileIncrCmd: simple variable name} {
     set i 10
     list [incr i] $i
 } {11 11}
-test incr-1.3 {TclCompileIncrCmd: error compiling variable name} {
+test incr-1.3 {TclCompileIncrCmd: error compiling variable name} -body {
     set i 10
-    catch {incr "i"xxx} msg
-    set msg
-} {extra characters after close-quote}
+    incr "i"xxx
+} -returnCodes error -result {extra characters after close-quote}
 test incr-1.4 {TclCompileIncrCmd: simple variable name in quotes} {
     set i 17
     list [incr "i"] $i
 } {18 18}
-test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} {
-    catch {unset {a simple var}}
+test incr-1.5 {TclCompileIncrCmd: simple variable name in braces} -setup {
+    unset -nocomplain {a simple var}
+} -body {
     set {a simple var} 27
     list [incr {a simple var}] ${a simple var}
-} {28 28}
-test incr-1.6 {TclCompileIncrCmd: simple array variable name} {
-    catch {unset a}
+} -result {28 28}
+test incr-1.6 {TclCompileIncrCmd: simple array variable name} -setup {
+    unset -nocomplain a
+} -body {
     set a(foo) 37
     list [incr a(foo)] $a(foo)
-} {38 38}
+} -result {38 38}
 test incr-1.7 {TclCompileIncrCmd: non-simple (computed) variable name} {
     set x "i"
     set i 77
@@ -58,7 +61,6 @@ test incr-1.8 {TclCompileIncrCmd: non-simple (computed) variable name} {
     set i 77
     list [incr [set x] +2] $i
 } {79 79}
-
 test incr-1.9 {TclCompileIncrCmd: increment given} {
     set i 10
     list [incr i +07] $i
@@ -67,7 +69,6 @@ test incr-1.10 {TclCompileIncrCmd: no increment given} {
     set i 10
     list [incr i] $i
 } {11 11}
-
 test incr-1.11 {TclCompileIncrCmd: simple global name} {
     proc p {} {
         global i
@@ -87,9 +88,8 @@ test incr-1.13 {TclCompileIncrCmd: simple but new (unknown) local name} {
     proc p {} {
         incr bar
     }
-    catch {p} msg
-    set msg
-} {can't read "bar": no such variable}
+    p
+} 1
 test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
     proc 260locals {} {
         # create 260 locals
@@ -150,22 +150,23 @@ test incr-1.14 {TclCompileIncrCmd: simple local name, >255 locals} {
     }
     260locals
 } {1}
-test incr-1.15 {TclCompileIncrCmd: variable is array} {
-    catch {unset a}
+test incr-1.15 {TclCompileIncrCmd: variable is array} -setup {
+    unset -nocomplain a
+} -body {
     set a(foo) 27
-    set x [incr a(foo) 11]
-    catch {unset a}
-    set x
-} 38
-test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} {
-    catch {unset a}
+    incr a(foo) 11
+} -cleanup {
+    unset -nocomplain a
+} -result 38
+test incr-1.16 {TclCompileIncrCmd: variable is array, elem substitutions} -setup {
+    unset -nocomplain a
+} -body {
     set i 5
     set a(foo5) 27
-    set x [incr a(foo$i) 11]
-    catch {unset a}
-    set x
-} 38
-
+    incr a(foo$i) 11
+} -cleanup {
+    unset -nocomplain a
+} -result 38
 test incr-1.17 {TclCompileIncrCmd: increment given, simple int} {
     set i 5
     incr i 123
@@ -176,8 +177,8 @@ test incr-1.18 {TclCompileIncrCmd: increment given, simple int} {
 } -95
 test incr-1.19 {TclCompileIncrCmd: increment given, but erroneous} -body {
     set i 5
-    catch {incr i [set]} msg
-    set errorInfo
+    catch {incr i [set]} -> opts
+    dict get $opts -errorinfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
@@ -195,96 +196,88 @@ test incr-1.22 {TclCompileIncrCmd: increment given, large int} {
 } 200005
 test incr-1.23 {TclCompileIncrCmd: increment given, formatted int != int} {
     set i 25
-    incr i 000012345     ;# an octal literal
+    incr i 0o00012345     ;# an octal literal
 } 5374
-test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} {
+test incr-1.24 {TclCompileIncrCmd: increment given, formatted int != int} -body {
     set i 25
-    catch {incr i 1a} msg
-    set msg
-} {expected integer but got "1a"}
-
-test incr-1.25 {TclCompileIncrCmd: too many arguments} {
+    incr i 1a
+} -returnCodes error -result {expected integer but got "1a"}
+test incr-1.25 {TclCompileIncrCmd: too many arguments} -body {
     set i 10
-    catch {incr i 10 20} msg
-    set msg
-} {wrong # args: should be "incr varName ?increment?"}
-
-
+    incr i 10 20
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
 test incr-1.26 {TclCompileIncrCmd: runtime error, bad variable name} {
-    list [catch {incr {"foo}} msg] $msg $errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
-    (reading value of variable to increment)
-    invoked from within
-"incr {"foo}"}}
+    unset -nocomplain {"foo}
+    incr {"foo}
+} 1
 test incr-1.27 {TclCompileIncrCmd: runtime error, bad variable name} -body {
-    list [catch {incr [set]} msg] $msg $errorInfo
+    list [catch {incr [set]} msg] $msg $::errorInfo
 } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}}
 test incr-1.28 {TclCompileIncrCmd: runtime error, readonly variable} -body {
-    proc readonly args {error "variable is read-only"}
     set x 123
-    trace var x w readonly
-    list [catch {incr x 1} msg] $msg $errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+    readonly x
+    list [catch {incr x 1} msg] $msg $::errorInfo
+} -match glob -cleanup {
+    unset -nocomplain x
+} -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
 *
 "incr x 1"}}
-catch {unset x}
-test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} {
+test incr-1.29 {TclCompileIncrCmd: runtime error, bad variable value} -body {
     set x "  -  "
-    list [catch {incr x 1} msg] $msg
-} {1 {expected integer but got "  -  "}}
-
-test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} {
+    incr x 1
+} -returnCodes error -result {expected integer but got "  -  "}
+test incr-1.30 {TclCompileIncrCmd: array var, braced (no subs)} -setup {
     catch {unset array}
+} -body {
     set array(\$foo) 4
     incr {array($foo)}
-} 5
-    
+} -result 5
+
 # Check "incr" and computed command names.
 
+unset -nocomplain x i
 test incr-2.0 {incr and computed command names} {
     set i 5
     set z incr
     $z i -1
-    set i
+    return $i
 } 4
-catch {unset x}
-catch {unset i}
-
-test incr-2.1 {incr command (not compiled): missing variable name} {
+test incr-2.1 {incr command (not compiled): missing variable name} -body {
     set z incr
-    list [catch {$z} msg] $msg
-} {1 {wrong # args: should be "incr varName ?increment?"}}
+    $z
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
 test incr-2.2 {incr command (not compiled): simple variable name} {
     set z incr
     set i 10
     list [$z i] $i
 } {11 11}
-test incr-2.3 {incr command (not compiled): error compiling variable name} {
+test incr-2.3 {incr command (not compiled): error compiling variable name} -body {
     set z incr
     set i 10
-    catch {$z "i"xxx} msg
-    set msg
-} {extra characters after close-quote}
+    $z "i"xxx
+} -returnCodes error -result {extra characters after close-quote}
 test incr-2.4 {incr command (not compiled): simple variable name in quotes} {
     set z incr
     set i 17
     list [$z "i"] $i
 } {18 18}
-test incr-2.5 {incr command (not compiled): simple variable name in braces} {
+test incr-2.5 {incr command (not compiled): simple variable name in braces} -setup {
+    unset -nocomplain {a simple var}
+} -body {
     set z incr
-    catch {unset {a simple var}}
     set {a simple var} 27
     list [$z {a simple var}] ${a simple var}
-} {28 28}
-test incr-2.6 {incr command (not compiled): simple array variable name} {
+} -result {28 28}
+test incr-2.6 {incr command (not compiled): simple array variable name} -setup {
+    unset -nocomplain a
+} -body {
     set z incr
-    catch {unset a}
     set a(foo) 37
     list [$z a(foo)] $a(foo)
-} {38 38}
+} -result {38 38}
 test incr-2.7 {incr command (not compiled): non-simple (computed) variable name} {
     set z incr
     set x "i"
@@ -297,7 +290,6 @@ test incr-2.8 {incr command (not compiled): non-simple (computed) variable name}
     set i 77
     list [$z [set x] +2] $i
 } {79 79}
-
 test incr-2.9 {incr command (not compiled): increment given} {
     set z incr
     set i 10
@@ -308,7 +300,6 @@ test incr-2.10 {incr command (not compiled): no increment given} {
     set i 10
     list [$z i] $i
 } {11 11}
-
 test incr-2.11 {incr command (not compiled): simple global name} {
     proc p {} {
 	set z incr
@@ -331,9 +322,8 @@ test incr-2.13 {incr command (not compiled): simple but new (unknown) local name
 	set z incr
         $z bar
     }
-    catch {p} msg
-    set msg
-} {can't read "bar": no such variable}
+    p
+} 1
 test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
    proc 260locals {} {
         set z incr
@@ -395,24 +385,25 @@ test incr-2.14 {incr command (not compiled): simple local name, >255 locals} {
     }
     260locals
 } {1}
-test incr-2.15 {incr command (not compiled): variable is array} {
+test incr-2.15 {incr command (not compiled): variable is array} -setup {
+    unset -nocomplain a
+} -body {
     set z incr
-    catch {unset a}
     set a(foo) 27
-    set x [$z a(foo) 11]
-    catch {unset a}
-    set x
-} 38
-test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} {
+    $z a(foo) 11
+} -cleanup {
+    unset -nocomplain a
+} -result 38
+test incr-2.16 {incr command (not compiled): variable is array, elem substitutions} -setup {
+    unset -nocomplain a
+} -body {
     set z incr
-    catch {unset a}
     set i 5
     set a(foo5) 27
-    set x [$z a(foo$i) 11]
-    catch {unset a}
-    set x
-} 38
-
+    $z a(foo$i) 11
+} -cleanup {
+    unset -nocomplain a
+} -result 38
 test incr-2.17 {incr command (not compiled): increment given, simple int} {
     set z incr
     set i 5
@@ -426,8 +417,8 @@ test incr-2.18 {incr command (not compiled): increment given, simple int} {
 test incr-2.19 {incr command (not compiled): increment given, but erroneous} -body {
     set z incr
     set i 5
-    catch {$z i [set]} msg
-    set errorInfo
+    catch {$z i [set]} -> opts
+    dict get $opts -errorinfo
 } -match glob -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
@@ -449,62 +440,56 @@ test incr-2.22 {incr command (not compiled): increment given, large int} {
 test incr-2.23 {incr command (not compiled): increment given, formatted int != int} {
     set z incr
     set i 25
-    $z i 000012345     ;# an octal literal
+    $z i 0o00012345     ;# an octal literal
 } 5374
-test incr-2.24 {incr command (not compiled): increment given, formatted int != int} {
+test incr-2.24 {incr command (not compiled): increment given, formatted int != int} -body {
     set z incr
     set i 25
-    catch {$z i 1a} msg
-    set msg
-} {expected integer but got "1a"}
-
-test incr-2.25 {incr command (not compiled): too many arguments} {
+    $z i 1a
+} -returnCodes error -result {expected integer but got "1a"}
+test incr-2.25 {incr command (not compiled): too many arguments} -body {
     set z incr
     set i 10
-    catch {$z i 10 20} msg
-    set msg
-} {wrong # args: should be "incr varName ?increment?"}
-
-
-test incr-2.26 {incr command (not compiled): runtime error, bad variable name} {
+    $z i 10 20
+} -returnCodes error -result {wrong # args: should be "incr varName ?increment?"}
+test incr-2.26 {incr command (not compiled): runtime error, bad variable name} -setup {
+    unset -nocomplain {"foo}
+} -body {
     set z incr
-    list [catch {$z {"foo}} msg] $msg $errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
-    (reading value of variable to increment)
-    invoked from within
-"$z {"foo}"}}
+    $z {"foo}
+} -result 1
 test incr-2.27 {incr command (not compiled): runtime error, bad variable name} -body {
     set z incr
-    list [catch {$z [set]} msg] $msg $errorInfo
+    list [catch {$z [set]} msg] $msg $::errorInfo
 } -match glob -result {1 {wrong # args: should be "set varName ?newValue?"} {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}}
 test incr-2.28 {incr command (not compiled): runtime error, readonly variable} -body {
     set z incr
-    proc readonly args {error "variable is read-only"}
     set x 123
-    trace var x w readonly
-    list [catch {$z x 1} msg] $msg $errorInfo
-} -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
+    readonly x
+    list [catch {$z x 1} msg] $msg $::errorInfo
+} -match glob -cleanup {
+    unset -nocomplain x
+} -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
 *
 "$z x 1"}}
-catch {unset x}
-test incr-2.29 {incr command (not compiled): runtime error, bad variable value} {
+test incr-2.29 {incr command (not compiled): runtime error, bad variable value} -body {
     set z incr
     set x "  -  "
-    list [catch {$z x 1} msg] $msg
-} {1 {expected integer but got "  -  "}}
+    $z x 1
+} -returnCodes error -result {expected integer but got "  -  "}
 test incr-2.30 {incr command (not compiled): bad increment} {
     set z incr
     set x 0
-    list [catch {$z x 1a} msg] $msg $errorInfo
+    list [catch {$z x 1a} msg] $msg $::errorInfo
 } {1 {expected integer but got "1a"} {expected integer but got "1a"
     (reading increment)
     invoked from within
 "$z x 1a"}}
 test incr-2.31 {incr command (compiled): bad increment} {
-    list [catch {incr x 1a} msg] $msg $errorInfo
+    list [catch {incr x 1a} msg] $msg $::errorInfo
 } {1 {expected integer but got "1a"} {expected integer but got "1a"
     (reading increment)
     invoked from within
@@ -520,6 +505,18 @@ test incr-3.2 {increment by wide amount: command route} {
     $z x 123123123123
 } 123123123123
 
+test incr-4.1 {increment non-existing array element [Bug 1445454]} -body {
+    proc x {} {incr a(1)}
+    x
+} -cleanup {
+    rename x {}
+} -result 1
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/indexObj.test b/tests/indexObj.test
index 7fea854..646cb02 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -1,22 +1,24 @@
 # This file is a Tcl script to test out the the procedures in file
-# tkIndexObj.c, which implement indexed table lookups.  The tests here
-# are organized in the standard fashion for Tcl tests.
+# tkIndexObj.c, which implement indexed table lookups.  The tests here are
+# organized in the standard fashion for Tcl tests.
 #
 # 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.
-#
-# RCS: @(#) $Id: indexObj.test,v 1.9 2004/11/25 16:37:15 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-testConstraint testindexobj [llength [info commands testindexobj]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
+testConstraint testindexobj [llength [info commands testindexobj]]
+testConstraint testparseargs [llength [info commands testparseargs]]
+
 test indexObj-1.1 {exact match} testindexobj {
     testindexobj 1 1 xyz abc def xyz alm
 } {2}
@@ -38,6 +40,12 @@ test indexObj-1.6 {forced exact match} testindexobj {
 test indexObj-1.7 {forced exact match} testindexobj {
     testindexobj 1 0 x abc def xalb xyz alm x
 } {5}
+test indexObj-1.8 {exact match of empty values} testindexobj {
+    testindexobj 1 1 {} a aa aaa {} b bb bbb
+} 3
+test indexObj-1.9 {exact match of empty values} testindexobj {
+    testindexobj 1 0 {} a aa aaa {} b bb bbb
+} 3
 
 test indexObj-2.1 {no match} testindexobj {
     list [catch {testindexobj 1 1 dddd abc def xalb xyz alm x} msg] $msg
@@ -54,6 +62,22 @@ test indexObj-2.4 {ambiguous value} testindexobj {
 test indexObj-2.5 {omit error message} testindexobj {
     list [catch {testindexobj 0 1 d x} msg] $msg
 } {1 {}}
+test indexObj-2.6 {TCL_EXACT => no "ambiguous" error message} testindexobj {
+    list [catch {testindexobj 1 0 d dumb daughter a c} msg] $msg
+} {1 {bad token "d": must be dumb, daughter, a, or c}}
+test indexObj-2.7 {exact match of empty values} testindexobj {
+    list [catch {testindexobj 1 1 {} a b c} msg] $msg
+} {1 {ambiguous token "": must be a, b, or c}}
+test indexObj-2.8 {exact match of empty values: singleton case} testindexobj {
+    list [catch {testindexobj 1 0 {} a} msg] $msg
+} {1 {bad token "": must be a}}
+test indexObj-2.9 {non-exact match of empty values: singleton case} testindexobj {
+    # NOTE this is a special case.  Although the empty string is a
+    # unique prefix, we have an established history of rejecting
+    # empty lookup keys, requiring any unique prefix match to have
+    # at least one character.
+    list [catch {testindexobj 1 1 {} a} msg] $msg
+} {1 {bad token "": must be a}}
 
 test indexObj-3.1 {cache result to skip next lookup} testindexobj {
     testindexobj check 42
@@ -66,8 +90,8 @@ test indexObj-4.1 {free old internal representation} testindexobj {
 } {2}
 
 test indexObj-5.1 {Tcl_WrongNumArgs} testindexobj {
-    testwrongnumargs 1 "?option?" mycmd
-} "wrong # args: should be \"mycmd ?option?\""
+    testwrongnumargs 1 "?-switch?" mycmd
+} "wrong # args: should be \"mycmd ?-switch?\""
 test indexObj-5.2 {Tcl_WrongNumArgs} testindexobj {
     testwrongnumargs 2 "bar" mycmd foo
 } "wrong # args: should be \"mycmd foo bar\""
@@ -108,6 +132,35 @@ test indexObj-6.4 {Tcl_GetIndexFromObjStruct} testindexobj {
     testgetindexfromobjstruct $x 1
 } "wrong # args: should be \"testgetindexfromobjstruct c 1\""
 
+test indexObj-7.1 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs
+} {0 1 testparseargs}
+test indexObj-7.2 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs -bool
+} {1 1 testparseargs}
+test indexObj-7.3 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs -bool bar
+} {1 2 {testparseargs bar}}
+test indexObj-7.4 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs bar
+} {0 2 {testparseargs bar}}
+test indexObj-7.5 {Tcl_ParseArgsObjv} -constraints testparseargs -body {
+    testparseargs -help
+} -returnCodes error -result {Command-specific options:
+ -bool: booltest
+ --:    Marks the end of the options
+ -help: Print summary of command-line options and abort}
+test indexObj-7.6 {Tcl_ParseArgsObjv} testparseargs {
+    testparseargs -- -bool -help
+} {0 3 {testparseargs -bool -help}}
+test indexObj-7.7 {Tcl_ParseArgsObjv memory management} testparseargs {
+    testparseargs 1 2 3 4 5 6 7 8 9 0 -bool 1 2 3 4 5 6 7 8 9 0
+} {1 21 {testparseargs 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0}}
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/info.test b/tests/info.test
index 9014eee..3057dd2 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -1,3 +1,4 @@
+# -*- tcl -*-
 # Commands covered:  info
 #
 # This file contains a collection of tests for one or more of the Tcl
@@ -7,17 +8,21 @@
 # Copyright (c) 1991-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2006      ActiveState
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: info.test,v 1.32 2005/07/29 14:47:47 dkf Exp $
+# DO NOT DELETE THIS LINE
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {{::tcltest} ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 # Set up namespaces needed to test operation of "info args", "info body",
 # "info default", and "info procs" with imported procedures.
 
@@ -29,7 +34,6 @@ namespace eval test_ns_info1 {
     proc q {{y 27} {z {}}} {return "y=$y"}
 }
 
-
 test info-1.1 {info args option} {
     proc t1 {a bbb c} {return foo}
     info args t1
@@ -42,13 +46,13 @@ test info-1.3 {info args option} {
     proc t1 "" {return foo}
     info args t1
 } {}
-test info-1.4 {info args option} {
+test info-1.4 {info args option} -body {
     catch {rename t1 {}}
-    list [catch {info args t1} msg] $msg
-} {1 {"t1" isn't a procedure}}
-test info-1.5 {info args option} {
-    list [catch {info args set} msg] $msg
-} {1 {"set" isn't a procedure}}
+    info args t1
+} -returnCodes error -result {"t1" isn't a procedure}
+test info-1.5 {info args option} -body {
+    info args set
+} -returnCodes error -result {"set" isn't a procedure}
 test info-1.6 {info args option} {
     proc t1 {a b} {set c 123; set d $c}
     t1 1 2
@@ -66,12 +70,12 @@ test info-2.1 {info body option} {
     proc t1 {} {body of t1}
     info body t1
 } {body of t1}
-test info-2.2 {info body option} {
-    list [catch {info body set} msg] $msg
-} {1 {"set" isn't a procedure}}
-test info-2.3 {info body option} {
-    list [catch {info args set 1} msg] $msg
-} {1 {wrong # args: should be "info args procname"}}
+test info-2.2 {info body option} -body {
+    info body set
+} -returnCodes error -result {"set" isn't a procedure}
+test info-2.3 {info body option} -body {
+    info args set 1
+} -returnCodes error -result {wrong # args: should be "info args procname"}
 test info-2.4 {info body option} {
     catch {namespace delete test_ns_info2}
     namespace eval test_ns_info2 {
@@ -83,7 +87,7 @@ test info-2.4 {info body option} {
 # would return the bytecompiled version of foo, which the catch
 # would then try and eval out of the foo context, accessing
 # compiled local indices
-test info-2.5 {info body option, returning bytecompiled bodies} {
+test info-2.5 {info body option, returning bytecompiled bodies} -body {
     catch {unset args}
     proc foo {args} {
 	foreach v $args {
@@ -92,8 +96,8 @@ test info-2.5 {info body option, returning bytecompiled bodies} {
 	}
     }
     foo a
-    list [catch [info body foo] msg] $msg
-} {1 {can't read "args": no such variable}}
+    eval [info body foo]
+} -returnCodes error -result {can't read "args": no such variable}
 # Fix for problem tested for in info-2.5 caused problems when
 # procedure body had no string rep (i.e. was not yet bytecode)
 # causing an empty string to be returned [Bug #545644]
@@ -107,35 +111,35 @@ proc testinfocmdcount {} {
     set x [info cmdcount]
     set y 12345
     set z [info cm]
-    expr $z-$x
+    expr {$z-$x}
 }
 test info-3.1 {info cmdcount compiled} {
     testinfocmdcount
-} 3
-test info-3.2 {info cmdcount evaled} {
+} 4
+test info-3.2 {info cmdcount evaled} -body {
     set x [info cmdcount]
     set y 12345
     set z [info cm]
-    expr $z-$x
-} 3
-test info-3.3 {info cmdcount evaled} [info body testinfocmdcount] 3
-test info-3.4 {info cmdcount option} {
-    list [catch {info cmdcount 1} msg] $msg
-} {1 {wrong # args: should be "info cmdcount"}}
-
-test info-4.1 {info commands option} {
+    expr {$z-$x}
+} -cleanup {unset x y z} -result 4
+test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4
+test info-3.4 {info cmdcount option} -body {
+    info cmdcount 1
+} -returnCodes error -result {wrong # args: should be "info cmdcount"}
+
+test info-4.1 {info commands option} -body {
     proc t1 {} {}
     proc t2 {} {}
     set x " [info commands] "
     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
             [string match {* set *} $x] [string match {* list *} $x]
-} {1 1 1 1}
-test info-4.2 {info commands option} {
+} -cleanup {unset x} -result {1 1 1 1}
+test info-4.2 {info commands option} -body {
     proc t1 {} {}
     rename t1 {}
-    set x [info comm]
-    string match {* t1 *} $x
-} 0
+    string match {* t1 *} \
+	[info comm]
+} -result 0
 test info-4.3 {info commands option} {
     proc _t1_ {} {}
     proc _t2_ {} {}
@@ -148,14 +152,14 @@ test info-4.4 {info commands option} {
 } {_t1_ _t2_}
 catch {rename _t1_ {}}
 catch {rename _t2_ {}}
-test info-4.5 {info commands option} {
-    list [catch {info commands a b} msg] $msg
-} {1 {wrong # args: should be "info commands ?pattern?"}}
+test info-4.5 {info commands option} -returnCodes error -body {
+    info commands a b
+} -result {wrong # args: should be "info commands ?pattern?"}
 # Also some tests in namespace.test
 
-test info-5.1 {info complete option} {
-    list [catch {info complete} msg] $msg
-} {1 {wrong # args: should be "info complete command"}}
+test info-5.1 {info complete option} -body {
+    info complete
+} -returnCodes error -result {wrong # args: should be "info complete command"}
 test info-5.2 {info complete option} {
     info complete abc
 } 1
@@ -176,50 +180,52 @@ test info-6.1 {info default option} {
     proc t1 {a b {c d} {e "long default value"}} {}
     info default t1 a value
 } 0
-test info-6.2 {info default option} {
+test info-6.2 {info default option} -body {
     proc t1 {a b {c d} {e "long default value"}} {}
     set value 12345
     info d t1 a value
-    set value
-} {}
-test info-6.3 {info default option} {
+    return $value
+} -cleanup {unset value} -result {}
+test info-6.3 {info default option} -body {
     proc t1 {a b {c d} {e "long default value"}} {}
     info default t1 c value
-} 1
-test info-6.4 {info default option} {
+} -cleanup {unset value} -result 1
+test info-6.4 {info default option} -body {
     proc t1 {a b {c d} {e "long default value"}} {}
     set value 12345
     info default t1 c value
-    set value
-} d
-test info-6.5 {info default option} {
+    return $value
+} -cleanup {unset value} -result d
+test info-6.5 {info default option} -body {
     proc t1 {a b {c d} {e "long default value"}} {}
     set value 12345
     set x [info default t1 e value]
     list $x $value
-} {1 {long default value}}
-test info-6.6 {info default option} {
-    list [catch {info default a b} msg] $msg
-} {1 {wrong # args: should be "info default procname arg varname"}}
-test info-6.7 {info default option} {
-    list [catch {info default _nonexistent_ a b} msg] $msg
-} {1 {"_nonexistent_" isn't a procedure}}
-test info-6.8 {info default option} {
+} -cleanup {unset x value} -result {1 {long default value}}
+test info-6.6 {info default option} -returnCodes error -body {
+    info default a b
+} -result {wrong # args: should be "info default procname arg varname"}
+test info-6.7 {info default option} -returnCodes error -body {
+    info default _nonexistent_ a b
+} -result {"_nonexistent_" isn't a procedure}
+test info-6.8 {info default option} -returnCodes error -body {
     proc t1 {a b} {}
-    list [catch {info default t1 x value} msg] $msg
-} {1 {procedure "t1" doesn't have an argument "x"}}
-test info-6.9 {info default option} {
+    info default t1 x value
+} -result {procedure "t1" doesn't have an argument "x"}
+test info-6.9 {info default option} -returnCodes error -setup {
     catch {unset a}
+} -cleanup {unset a} -body {
     set a(0) 88
     proc t1 {a b} {}
-    list [catch {info default t1 a a} msg] $msg
-} {1 {couldn't store default value in variable "a"}}
-test info-6.10 {info default option} {
+    info default t1 a a
+} -returnCodes error -result {can't set "a": variable is array}
+test info-6.10 {info default option} -setup {
     catch {unset a}
+} -cleanup {unset a} -body {
     set a(0) 88
     proc t1 {{a 18} b} {}
-    list [catch {info default t1 a a} msg] $msg
-} {1 {couldn't store default value in variable "a"}}
+    info default t1 a a
+} -returnCodes error -result {can't set "a": variable is array}
 test info-6.11 {info default option} {
     catch {namespace delete test_ns_info2}
     namespace eval test_ns_info2 {
@@ -227,27 +233,26 @@ test info-6.11 {info default option} {
         list [info default p x foo] $foo [info default q y bar] $bar
     }
 } {0 {} 1 27}
-catch {unset a}
 
-test info-7.1 {info exists option} {
+test info-7.1 {info exists option} -body {
     set value foo
     info exists value
-} 1
-catch {unset _nonexistent_}
-test info-7.2 {info exists option} {
+} -cleanup {unset value} -result 1
+
+test info-7.2 {info exists option} -setup {catch {unset _nonexistent_}} -body {
     info exists _nonexistent_
-} 0
+} -result 0
 test info-7.3 {info exists option} {
     proc t1 {x} {return [info exists x]}
     t1 2
 } 1
-test info-7.4 {info exists option} {
+test info-7.4 {info exists option} -body {
     proc t1 {x} {
         global _nonexistent_
         return [info exists _nonexistent_]
     }
     t1 2
-} 0
+} -setup {unset -nocomplain _nonexistent_} -result 0
 test info-7.5 {info exists option} {
     proc t1 {x} {
         set y 47
@@ -259,42 +264,43 @@ test info-7.6 {info exists option} {
     proc t1 {x} {return [info exists value]}
     t1 2
 } 0
-test info-7.7 {info exists option} {
+test info-7.7 {info exists option} -setup {
     catch {unset x}
+} -body {
     set x(2) 44
     list [info exists x] [info exists x(1)] [info exists x(2)]
-} {1 0 1}
+} -result {1 0 1}
 catch {unset x}
-test info-7.8 {info exists option} {
-    list [catch {info exists} msg] $msg
-} {1 {wrong # args: should be "info exists varName"}}
-test info-7.9 {info exists option} {
-    list [catch {info exists 1 2} msg] $msg
-} {1 {wrong # args: should be "info exists varName"}}
-
-test info-8.1 {info globals option} {
+test info-7.8 {info exists option} -body {
+    info exists
+} -returnCodes error -result {wrong # args: should be "info exists varName"}
+test info-7.9 {info exists option} -body {
+    info exists 1 2
+} -returnCodes error -result {wrong # args: should be "info exists varName"}
+
+test info-8.1 {info globals option} -body {
     set x 1
     set y 2
     set value 23
     set a " [info globals] "
     list [string match {* x *} $a] [string match {* y *} $a] \
             [string match {* value *} $a] [string match {* _foobar_ *} $a]
-} {1 1 1 0}
-test info-8.2 {info globals option} {
+} -cleanup {unset x y value a} -result {1 1 1 0}
+test info-8.2 {info globals option} -body {
     set _xxx1 1
     set _xxx2 2
     lsort [info g _xxx*]
-} {_xxx1 _xxx2}
-test info-8.3 {info globals option} {
-    list [catch {info globals 1 2} msg] $msg
-} {1 {wrong # args: should be "info globals ?pattern?"}}
-test info-8.4 {info globals option: may have leading namespace qualifiers} {
+} -cleanup {unset _xxx1 _xxx2} -result {_xxx1 _xxx2}
+test info-8.3 {info globals option} -returnCodes error -body {
+    info globals 1 2
+} -result {wrong # args: should be "info globals ?pattern?"}
+test info-8.4 {info globals option: may have leading namespace qualifiers} -body {
     set x 0
     list [info globals x] [info globals :x] [info globals ::x] [info globals :::x] [info globals ::::x]
-} {x {} x x x}
+} -cleanup {unset x} -result {x {} x x x}
 test info-8.5 {info globals option: only return existing global variables} {
     -setup {
-	catch {unset ::NO_SUCH_VAR}
+	unset -nocomplain ::NO_SUCH_VAR
 	proc evalInProc script {eval $script}
     }
     -body {
@@ -335,51 +341,69 @@ test info-9.4 {info level option} {
     }
     t1
 } {1 t1}
-test info-9.5 {info level option} {
-    list [catch {info level 1 2} msg] $msg
-} {1 {wrong # args: should be "info level ?number?"}}
-test info-9.6 {info level option} {
-    list [catch {info level 123a} msg] $msg
-} {1 {expected integer but got "123a"}}
-test info-9.7 {info level option} {
-    list [catch {info level 0} msg] $msg
-} {1 {bad level "0"}}
-test info-9.8 {info level option} {
+test info-9.5 {info level option} -body {
+    info level 1 2
+} -returnCodes error -result {wrong # args: should be "info level ?number?"}
+test info-9.6 {info level option} -body {
+    info level 123a
+} -returnCodes error -result {expected integer but got "123a"}
+test info-9.7 {info level option} -body {
+    info level 0
+} -returnCodes error -result {bad level "0"}
+test info-9.8 {info level option} -body {
     proc t1 {} {info level -1}
-    list [catch {t1} msg] $msg
-} {1 {bad level "-1"}}
-test info-9.9 {info level option} {
+    t1
+} -returnCodes error -result {bad level "-1"}
+test info-9.9 {info level option} -body {
     proc t1 {x} {info level $x}
-    list [catch {t1 -3} msg] $msg
-} {1 {bad level "-3"}}
-test info-9.10 {info level option, namespaces} {
-    set msg [namespace eval t {info level 0}]
+    t1 -3
+} -returnCodes error -result {bad level "-3"}
+test info-9.10 {info level option, namespaces} -body {
+    namespace eval t {info level 0}
+} -cleanup {
     namespace delete t
-    set msg
-} {namespace eval t {info level 0}}
+} -result {namespace eval t {info level 0}}
+test info-9.11 {info level option, aliases} -constraints knownBug -setup {
+    proc w {x y z} {info level 0}
+    interp alias {} a {} w a b
+} -body {
+    a c
+} -cleanup {
+    rename a {}
+    rename w {}
+} -result {a c}
+test info-9.12 {info level option, ensembles} -constraints knownBug -setup {
+    proc w {x y z} {info level 0}
+    namespace ensemble create -command a -map {foo ::w}
+} -body {
+    a foo 1 2 3
+} -cleanup {
+    rename a {}
+    rename w {}
+} -result {a foo 1 2 3}
 
 set savedLibrary $tcl_library
-test info-10.1 {info library option} {
-    list [catch {info library x} msg] $msg
-} {1 {wrong # args: should be "info library"}}
+test info-10.1 {info library option} -body {
+    info library x
+} -returnCodes error -result {wrong # args: should be "info library"}
 test info-10.2 {info library option} {
     set tcl_library 12345
     info library
 } {12345}
-test info-10.3 {info library option} {
+test info-10.3 {info library option} -body {
     unset tcl_library
-    list [catch {info library} msg] $msg
-} {1 {no library has been specified for Tcl}}
-set tcl_library $savedLibrary
-
-test info-11.1 {info loaded option} {
-    list [catch {info loaded a b} msg] $msg
-} {1 {wrong # args: should be "info loaded ?interp?"}}
-test info-11.2 {info loaded option} {
-    list [catch {info loaded {}}] [catch {info loaded gorp} msg] $msg
-} {0 1 {could not find interpreter "gorp"}}
-
-test info-12.1 {info locals option} {
+    info library
+} -returnCodes error -result {no library has been specified for Tcl}
+set tcl_library $savedLibrary; unset savedLibrary
+
+test info-11.1 {info loaded option} -body {
+    info loaded a b
+} -returnCodes error -result {wrong # args: should be "info loaded ?interp?"}
+test info-11.2 {info loaded option} -body {
+    info loaded {}; info loaded gorp
+} -returnCodes error -result {could not find interpreter "gorp"}
+
+test info-12.1 {info locals option} -body {
     set a 22
     proc t1 {x y} {
         set b 13
@@ -390,7 +414,7 @@ test info-12.1 {info locals option} {
         return [info locals]
     }
     lsort [t1 23 24]
-} {b c x y}
+} -cleanup {unset a aa} -result {b c x y}
 test info-12.2 {info locals option} {
     proc t1 {x y} {
         set xx1 2
@@ -400,9 +424,9 @@ test info-12.2 {info locals option} {
     }
     lsort [t1 2 3]
 } {x xx1 xx2}
-test info-12.3 {info locals option} {
-    list [catch {info locals 1 2} msg] $msg
-} {1 {wrong # args: should be "info locals ?pattern?"}}
+test info-12.3 {info locals option} -body {
+    info locals 1 2
+} -returnCodes error -result {wrong # args: should be "info locals ?pattern?"}
 test info-12.4 {info locals option} {
     info locals
 } {}
@@ -426,32 +450,33 @@ test info-12.7 {info locals with temporary variables} {
     t1
 } {a}
 
-test info-13.1 {info nameofexecutable option} {
-    list [catch {info nameofexecutable foo} msg] $msg
-} {1 {wrong # args: should be "info nameofexecutable"}}
+test info-13.1 {info nameofexecutable option} -returnCodes error -body {
+    info nameofexecutable foo
+} -result {wrong # args: should be "info nameofexecutable"}
 
-test info-14.1 {info patchlevel option} {
+test info-14.1 {info patchlevel option} -body {
     set a [info patchlevel]
     regexp {[0-9]+\.[0-9]+([p[0-9]+)?} $a
-} 1
-test info-14.2 {info patchlevel option} {
-    list [catch {info patchlevel a} msg] $msg
-} {1 {wrong # args: should be "info patchlevel"}}
-test info-14.3 {info patchlevel option} {
+} -cleanup {unset a} -result 1
+test info-14.2 {info patchlevel option} -returnCodes error -body {
+    info patchlevel a
+} -result {wrong # args: should be "info patchlevel"}
+test info-14.3 {info patchlevel option} -setup {
     set t $tcl_patchLevel
+} -body {
     unset tcl_patchLevel
-    set result [list [catch {info patchlevel} msg] $msg]
-    set tcl_patchLevel $t
-    set result
-} {1 {can't read "tcl_patchLevel": no such variable}}
+    info patchlevel
+} -cleanup {
+    set tcl_patchLevel $t; unset t
+} -returnCodes error -result {can't read "tcl_patchLevel": no such variable}
 
-test info-15.1 {info procs option} {
+test info-15.1 {info procs option} -body {
     proc t1 {} {}
     proc t2 {} {}
     set x " [info procs] "
     list [string match {* t1 *} $x] [string match {* t2 *} $x] \
             [string match {* _undefined_ *} $x]
-} {1 1 0}
+} -cleanup {unset x} -result {1 1 0}
 test info-15.2 {info procs option} {
     proc _tt1 {} {}
     proc _tt2 {} {}
@@ -459,19 +484,21 @@ test info-15.2 {info procs option} {
 } {_tt1 _tt2}
 catch {rename _tt1 {}}
 catch {rename _tt2 {}}
-test info-15.3 {info procs option} {
-    list [catch {info procs 2 3} msg] $msg
-} {1 {wrong # args: should be "info procs ?pattern?"}}
-test info-15.4 {info procs option} {
+test info-15.3 {info procs option} -body {
+    info procs 2 3
+} -returnCodes error -result {wrong # args: should be "info procs ?pattern?"}
+test info-15.4 {info procs option} -setup {
     catch {namespace delete test_ns_info2}
+} -body {
     namespace eval test_ns_info2 {
         namespace import ::test_ns_info1::*
         proc r {} {}
-        list [info procs] [info procs p*]
+        list [lsort [info procs]] [info procs p*]
     }
-} {{p q r} p}
-test info-15.5 {info procs option with a proc in a namespace} {
+} -result {{p q r} p}
+test info-15.5 {info procs option with a proc in a namespace} -setup {
     catch {namespace delete test_ns_info2}
+} -body {
     namespace eval test_ns_info2 {
 	proc p1 { arg } {
 	    puts cmd
@@ -481,9 +508,10 @@ test info-15.5 {info procs option with a proc in a namespace} {
 	}
     }
     info procs ::test_ns_info2::p1
-} {::test_ns_info2::p1}
-test info-15.6 {info procs option with a pattern in a namespace} {
+} -result {::test_ns_info2::p1}
+test info-15.6 {info procs option with a pattern in a namespace} -setup {
     catch {namespace delete test_ns_info2}
+} -body {
     namespace eval test_ns_info2 {
 	proc p1 { arg } {
 	    puts cmd
@@ -493,9 +521,10 @@ test info-15.6 {info procs option with a pattern in a namespace} {
 	}
     }
     lsort [info procs ::test_ns_info2::p*]
-} [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
-test info-15.7 {info procs option with a global shadowing proc} {
+} -result [lsort [list ::test_ns_info2::p1 ::test_ns_info2::p2]]
+test info-15.7 {info procs option with a global shadowing proc} -setup {
     catch {namespace delete test_ns_info2}
+} -body {
     proc string_cmd { arg } {
         puts cmd
     }
@@ -505,12 +534,13 @@ test info-15.7 {info procs option with a global shadowing proc} {
 	}
     }
     info procs test_ns_info2::string*
-} {::test_ns_info2::string_cmd}
+} -result {::test_ns_info2::string_cmd}
 # This regression test is currently commented out because it requires
 # that the implementation of "info procs" looks into the global namespace,
 # which it does not (in contrast to "info commands")
-test info-15.8 {info procs option with a global shadowing proc} knownBug {
+test info-15.8 {info procs option with a global shadowing proc} -setup {
     catch {namespace delete test_ns_info2}
+} -constraints knownBug -body {
     proc string_cmd { arg } {
         puts cmd
     }
@@ -525,11 +555,11 @@ test info-15.8 {info procs option with a global shadowing proc} knownBug {
     namespace eval test_ns_info2 {
         lsort [info procs string*]
     }
-} [lsort [list string_cmd string_cmd2]]
+} -result [lsort [list string_cmd string_cmd2]]
 
-test info-16.1 {info script option} {
-    list [catch {info script x x} msg] $msg
-} {1 {wrong # args: should be "info script ?filename?"}}
+test info-16.1 {info script option} -returnCodes error -body {
+    info script x x
+} -result {wrong # args: should be "info script ?filename?"}
 test info-16.2 {info script option} {
     file tail [info sc]
 } "info.test"
@@ -545,45 +575,45 @@ test info-16.5 {resetting "info script" after errors} {
     catch {source _nonexistent_}
     file tail [info script]
 } "info.test"
-test info-16.6 {info script option} {
+test info-16.6 {info script option} -body {
     set script [info script]
     list [file tail [info script]] \
 	    [info script newname.txt] \
 	    [file tail [info script $script]]
-} [list info.test newname.txt info.test]
-test info-16.7 {info script option} {
+} -result [list info.test newname.txt info.test] -cleanup {unset script}
+test info-16.7 {info script option} -body {
     set script [info script]
     info script newname.txt
     list [source $gorpfile] [file tail [info script]] \
 	    [file tail [info script $script]]
-} [list $gorpfile newname.txt info.test]
+} -result [list $gorpfile newname.txt info.test] -cleanup {unset script}
 removeFile gorp.info
 set gorpfile [makeFile {list [info script] [info script foo.bar]} gorp.info]
 test info-16.8 {info script option} {
     list [source $gorpfile] [file tail [info script]]
 } [list [list $gorpfile foo.bar] info.test]
-removeFile gorp.info
+removeFile gorp.info; unset gorpfile
 
-test info-17.1 {info sharedlibextension option} {
-    list [catch {info sharedlibextension foo} msg] $msg
-} {1 {wrong # args: should be "info sharedlibextension"}}
-
-test info-18.1 {info tclversion option} {
-    set x [info tclversion]
-    scan $x "%d.%d%c" a b c
-} 2
-test info-18.2 {info tclversion option} {
-    list [catch {info t 2} msg] $msg
-} {1 {wrong # args: should be "info tclversion"}}
-test info-18.3 {info tclversion option} {
-    set t $tcl_version
+test info-17.1 {info sharedlibextension option} -returnCodes error -body {
+    info sharedlibextension foo
+} -result {wrong # args: should be "info sharedlibextension"}
+
+test info-18.1 {info tclversion option} -body {
+    scan [info tclversion] "%d.%d%c" a b c
+} -cleanup {unset -nocomplain a b c} -result 2
+test info-18.2 {info tclversion option} -body {
+    info t 2
+} -returnCodes error -result {wrong # args: should be "info tclversion"}
+test info-18.3 {info tclversion option} -body {
     unset tcl_version
-    set result [list [catch {info tclversion} msg] $msg]
-    set tcl_version $t
-    set result
-} {1 {can't read "tcl_version": no such variable}}
+    info tclversion
+} -returnCodes error -setup {
+    set t $tcl_version
+} -cleanup {
+    set tcl_version $t; unset t
+} -result {can't read "tcl_version": no such variable}
 
-test info-19.1 {info vars option} {
+test info-19.1 {info vars option} -body {
     set a 1
     set b 2
     proc t1 {x y} {
@@ -592,8 +622,8 @@ test info-19.1 {info vars option} {
         return [info vars]
     }
     lsort [t1 18 19]
-} {a b c x y}
-test info-19.2 {info vars option} {
+} -cleanup {unset a b} -result {a b c x y}
+test info-19.2 {info vars option} -body {
     set xxx1 1
     set xxx2 2
     proc t1 {xxa y} {
@@ -602,13 +632,13 @@ test info-19.2 {info vars option} {
         return [info vars x*]
     }
     lsort [t1 18 19]
-} {xxa xxx1 xxx2}
+} -cleanup {unset xxx1 xxx2} -result {xxa xxx1 xxx2}
 test info-19.3 {info vars option} {
     lsort [info vars]
 } [lsort [info globals]]
-test info-19.4 {info vars option} {
-    list [catch {info vars a b} msg] $msg
-} {1 {wrong # args: should be "info vars ?pattern?"}}
+test info-19.4 {info vars option} -returnCodes error -body {
+    info vars a b
+} -result {wrong # args: should be "info vars ?pattern?"}
 test info-19.5 {info vars with temporary variables} {
     proc t1 {} {
         foreach a {b c} {}
@@ -625,11 +655,10 @@ test info-19.6 {info vars: Bug 1072654} -setup {
     namespace delete x
 } -result {}
 
+set functions {abs acos asin atan atan2 bool ceil cos cosh double entier exp floor fmod hypot int isqrt log log10 max min pow rand round sin sinh sqrt srand tan tanh wide}
 # Check whether the extra testing functions are defined...
-if {([catch {expr T1()} msg] == 1) && ($msg == {unknown math function "T1"})} {
-    set functions {abs acos asin atan atan2 bool ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide}
-} else {
-    set functions {T1 T2 T3 abs acos asin atan atan2 bool ceil cos cosh double exp floor fmod hypot int log log10 pow rand round sin sinh sqrt srand tan tanh wide}
+if {!([catch {expr T1()} msg] && ($msg eq {invalid command name "tcl::mathfunc::T1"}))} {
+    set functions "T1 T2 T3 $functions"  ;# A lazy way of prepending!
 }
 test info-20.1 {info functions option} {info functions sin} sin
 test info-20.2 {info functions option} {lsort [info functions]} $functions
@@ -639,25 +668,1735 @@ test info-20.3 {info functions option} {
 test info-20.4 {info functions option} {
     lsort [info functions *tan*]
 } {atan atan2 tan tanh}
-test info-20.5 {info functions option} {
-    list [catch {info functions raise an error} msg] $msg
-} {1 {wrong # args: should be "info functions ?pattern?"}}
-
-test info-21.1 {miscellaneous error conditions} {
-    list [catch {info} msg] $msg
-} {1 {wrong # args: should be "info option ?arg arg ...?"}}
-test info-21.2 {miscellaneous error conditions} {
-    list [catch {info gorp} msg] $msg
-} {1 {bad option "gorp": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.3 {miscellaneous error conditions} {
-    list [catch {info c} msg] $msg
-} {1 {ambiguous option "c": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.4 {miscellaneous error conditions} {
-    list [catch {info l} msg] $msg
-} {1 {ambiguous option "l": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
-test info-21.5 {miscellaneous error conditions} {
-    list [catch {info s} msg] $msg
-} {1 {ambiguous option "s": must be args, body, cmdcount, commands, complete, default, exists, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, patchlevel, procs, script, sharedlibextension, tclversion, or vars}}
+test info-20.5 {info functions option} -returnCodes error -body {
+    info functions raise an error
+} -result {wrong # args: should be "info functions ?pattern?"}
+unset functions msg
+
+test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
+    info
+} -result {wrong # args: should be "info subcommand ?arg ...?"}
+test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
+    info gorp
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
+    info c
+} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
+    info l
+} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
+    info s
+} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+
+##
+# ### ### ### ######### ######### #########
+## info frame
+
+## Helper
+# For the more complex results we cut the file name down to remove path
+# dependencies, and we use only part of the first line of the reported
+# command. The latter is required because otherwise the whole test case may
+# appear in some results, but the result is part of the testcase. An infinite
+# string would be required to describe that. The cutting-down breaks this.
+
+proc reduce {frame} {
+    set cmd [dict get $frame cmd]
+    if {[regexp \n $cmd]} {
+	dict set frame cmd \
+	    [string range [lindex [split $cmd \n] 0] 0 end-4]
+    }
+    if {[dict exists $frame file]} {
+	dict set frame file \
+	    [file tail [dict get $frame file]]
+    }
+    return $frame
+}
+
+proc subinterp {} { interp create sub ; interp debug sub -frame 1;
+    interp eval sub [list proc reduce [info args reduce] [info body reduce]]
+}
+
+## Helper
+# Generate a stacktrace from the current location to top.  This code
+# not only depends on the exact location of things, but also on the
+# implementation of tcltest. Any changes and these tests will have to
+# be updated.
+
+proc etrace {} {
+    set res {}
+    set level [info frame]
+    while {$level} {
+	lappend res [list $level [reduce [info frame $level]]]
+	incr level -1
+    }
+    return $res
+}
+
+test info-22.0 {info frame, levels} {!singleTestInterp} {
+    info frame
+} 7
+test info-22.1 {info frame, bad level relative} {!singleTestInterp} {
+    # catch is another level!, i.e. we have 8, not 7
+    catch {info frame -8} msg
+    set msg
+} {bad level "-8"}
+test info-22.2 {info frame, bad level absolute} {!singleTestInterp} {
+    # catch is another level!, i.e. we have 8, not 7
+    catch {info frame 9} msg
+    set msg
+} {bad level "9"}
+test info-22.3 {info frame, current, relative} -match glob -body {
+    info frame 0
+} -result {type source line 750 file */info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-22.4 {info frame, current, relative, nested} -match glob -body {
+    set res [info frame 0]
+} -result {type source line 753 file */info.test cmd {info frame 0} proc ::tcltest::RunTest} -cleanup {unset res}
+test info-22.5 {info frame, current, absolute} -constraints {!singleTestInterp} -match glob -body {
+    reduce [info frame 7]
+} -result {type source line 756 file info.test cmd {info frame 7} proc ::tcltest::RunTest}
+test info-22.6 {info frame, global, relative} {!singleTestInterp} {
+    reduce [info frame -6]
+} {type source line 758 file info.test cmd test\ info-22.6\ \{info\ frame,\ global,\ relative\}\ \{!singleTestInter level 0}
+test info-22.7 {info frame, global, absolute} {!singleTestInterp} {
+    reduce [info frame 1]
+} {type source line 761 file info.test cmd test\ info-22.7\ \{info\ frame,\ global,\ absolute\}\ \{!singleTestInter level 0}
+test info-22.8 {info frame, basic trace} -match glob -body {
+    join [lrange [etrace] 0 2] \n
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 765 file info.test cmd etrace proc ::tcltest::RunTest}
+* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
+unset -nocomplain msg
+
+test info-23.0.0 {eval'd info frame} {!singleTestInterp} {
+    eval {info frame}
+} 8
+test info-23.0.1 {eval'd info frame} -constraints {singleTestInterp} -match glob -body {
+    eval {info frame}
+} -result {1[12]} ;# SingleTestInterp results changes depending on running the whole suite, or info.test alone.
+test info-23.1.0 {eval'd info frame, semi-dynamic} {!singleTestInterp} {
+    eval info frame
+} 8
+test info-23.1.1 {eval'd info frame, semi-dynamic} -constraints {singleTestInterp} -match glob -body {
+    eval info frame
+} -result {1[12]}
+test info-23.2.0 {eval'd info frame, dynamic} -constraints {!singleTestInterp} -body {
+    set script {info frame}
+    eval $script
+} -cleanup {unset script} -result 8
+test info-23.2.1 {eval'd info frame, dynamic} -constraints {singleTestInterp} -match glob -body {
+    set script {info frame}
+    eval $script
+} -cleanup {unset script} -result {1[12]}
+test info-23.3 {eval'd info frame, literal} -match glob -body {
+    eval {
+	info frame 0
+    }
+} -result {type source line 793 file * cmd {info frame 0} proc ::tcltest::RunTest}
+test info-23.4 {eval'd info frame, semi-dynamic} {
+    eval info frame 0
+} {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
+test info-23.5 {eval'd info frame, dynamic} -cleanup {unset script} -body {
+    set script {info frame 0}
+    eval $script
+} -result {type eval line 1 cmd {info frame 0} proc ::tcltest::RunTest}
+test info-23.6 {eval'd info frame, trace} -match glob -cleanup {unset script} -body {
+    set script {etrace}
+    join [lrange [eval $script] 0 2] \n
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
+* {type source line 805 file info.test cmd {eval $script} proc ::tcltest::RunTest}}
+
+# -------------------------------------------------------------------------
+
+# Procedures defined in scripts which are arguments to control
+# structures (like 'namespace eval', 'interp eval', 'if', 'while',
+# 'switch', 'catch', 'for', 'foreach', etc.) have no absolute
+# location. The command implementations execute such scripts through
+# Tcl_EvalObjEx. Flag 0 causes it to use the bytecode compiler. This
+# causes the connection to the context to be lost. Currently only
+# procedure bodies are able to remember their context.
+
+# NOTE THAT THESE DO NOT USE THE -setup OPTION TO [test]
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {
+    proc bar {} {info frame 0}
+}
+
+test info-24.0 {info frame, interaction, namespace eval} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 825 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+set flag 1
+if {$flag} {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.1 {info frame, interaction, if} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 839 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+set flag 1
+while {$flag} {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+    set flag 0
+};unset flag
+
+test info-24.2 {info frame, interaction, while} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 853 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+catch {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.3 {info frame, interaction, catch} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 867 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+foreach var val {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+    break
+}; unset var
+
+test info-24.4 {info frame, interaction, foreach} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 880 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+for {} {1} {} {
+    namespace eval foo {}
+    proc ::foo::bar {} {info frame 0}
+    break
+}
+
+test info-24.5 {info frame, interaction, for} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 894 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x {
+    foo {
+	proc ::foo::bar {} {info frame 0}
+    }
+}
+
+test info-24.6.0 {info frame, interaction, switch, list body} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+    unset x
+} -result {type source line 910 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x foo {
+    proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.6.1 {info frame, interaction, switch, multi-body} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+    unset x
+} -result {type source line 926 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x [list foo {
+    proc ::foo::bar {} {info frame 0}
+}]
+
+test info-24.6.2 {info frame, interaction, switch, list body, dynamic} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+    unset x
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+dict for {k v} {foo bar} {
+    proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.7 {info frame, interaction, dict for} {
+    reduce [foo::bar]
+} {type source line 955 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo; unset k v
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set thedict {foo bar}
+dict with thedict {
+    proc ::foo::bar {} {info frame 0}
+}
+
+test info-24.8 {info frame, interaction, dict with} {
+    reduce [foo::bar]
+} {type source line 969 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+unset thedict foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+dict filter {foo bar} script {k v} {
+    proc ::foo::bar {} {info frame 0}
+    set x 1
+}; unset k v x
+
+test info-24.9 {info frame, interaction, dict filter} {
+    reduce [foo::bar]
+} {type source line 983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+#unset x
+
+# -------------------------------------------------------------------------
+
+eval {
+    proc bar {} {info frame 0}
+}
+
+test info-25.0 {info frame, proc in eval} {
+    reduce [bar]
+} {type source line 997 file info.test cmd {info frame 0} proc ::bar level 0}
+# Don't need to clean up yet...
+
+proc bar {} {info frame 0}
+
+test info-25.1 {info frame, regular proc} {
+    reduce [bar]
+} {type source line 1005 file info.test cmd {info frame 0} proc ::bar level 0}
+
+rename bar {}
+
+# -------------------------------------------------------------------------
+# More info-30.x test cases at the end of the file.
+test info-30.0 {bs+nl in literal words} -cleanup {unset res} -body {
+    if {1} {
+	set res \
+	    [reduce [info frame 0]];#1018
+    }
+    return $res
+    # This was reporting line 3 instead of the correct 4 because the
+    # bs+nl combination is subst by the parser before the 'if'
+    # command, and the bcc, see the word. Fixed by recording the
+    # offsets of all bs+nl sequences in literal words, then using the
+    # information in the bcc and other places to bump line numbers when
+    # parsing over the location. Also affected: testcases 22.8 and 23.6.
+} -result {type source line 1018 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+# -------------------------------------------------------------------------
+# See 24.0 - 24.5 for similar situations, using literal scripts.
+
+set body {set flag 0
+    set a c
+    set res [info frame 0]} ;# line 3!
+
+test info-31.0 {ns eval, script in variable} -body {namespace eval foo {variable res {}}
+    namespace eval foo $body
+    return $foo::res
+} -result {type eval line 3 cmd {info frame 0} level 0} -cleanup {
+    catch {namespace delete foo}
+}
+test info-31.1 {if, script in variable} -cleanup {unset res a flag} -body {
+    if 1 $body
+    return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.1a {if, script in variable} -cleanup {unset res a flag} -body {
+    if 1 then $body
+    return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.2 {while, script in variable} -cleanup {unset flag res a} -body {
+    set flag 1
+    while {$flag} $body
+    return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+# .3 - proc - scoping prevent return of result ...
+
+test info-31.4 {foreach, script in variable} -cleanup {unset var res a flag} -body {
+    foreach var val $body
+    set res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.5 {for, script in variable} -cleanup {unset flag res a} -body {
+    set flag 1
+    for {} {$flag} {} $body
+    return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-31.6 {eval, script in variable} -cleanup {unset res a flag} -body {
+    eval $body
+    return $res
+} -result {type eval line 3 cmd {info frame 0} proc ::tcltest::RunTest}
+
+# -------------------------------------------------------------------------
+
+set body {
+    foo {
+	proc ::foo::bar {} {info frame 0}
+    }
+}
+
+namespace eval foo {}
+set x foo
+switch -exact -- $x $body; unset body
+
+test info-31.7 {info frame, interaction, switch, dynamic} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+    unset x
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+set body {
+    proc ::foo::bar {} {info frame 0}
+}
+
+namespace eval foo {}
+eval $body
+
+test info-32.0 {info frame, dynamic procedure} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace {*}{
+    eval
+    foo
+    {proc bar {} {info frame 0}}
+}
+test info-33.0 {{*}, literal, direct} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+    set flag 1
+    if {*}{
+	{$flag}
+	{info frame 0}
+    }
+}
+test info-33.1 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+
+namespace {*}"
+    eval
+    foo
+    {proc bar {} {info frame 0}}
+"
+test info-33.2 {{*}, literal, direct} {
+    reduce [foo::bar]
+} {type source line 1144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace {*}"eval\nfoo\n{proc bar {} {info frame 0}}\n"
+
+test info-33.2a {{*}, literal, not simple, direct} {
+    reduce [foo::bar]
+} {type proc line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+    set flag 1
+    if {*}"
+	{1}
+	{info frame 0}
+    "
+}
+test info-33.3 {{*}, literal, simple, bytecompiled} {
+    reduce [foo::bar]
+} {type source line 1169 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+    set flag 1
+    if {*}"\n{1}\n{info frame 0}"
+}
+test info-33.3a {{*}, literal, not simple, bytecompiled} {
+    reduce [foo::bar]
+} {type eval line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+set body {
+    eval
+    foo
+    {proc bar {} {
+	info frame 0
+    }}
+}
+namespace {*}$body
+test info-34.0 {{*}, dynamic, direct} {
+    reduce [foo::bar]
+} {type proc line 2 cmd {info frame 0} proc ::foo::bar level 0}
+
+unset body
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+set body {
+    {$flag}
+    {info frame 0}
+}
+proc foo::bar {} {
+    global body ; set flag 1
+    if {*}$body
+}
+test info-34.1 {{*}, literal, bytecompiled} {
+    reduce [foo::bar]
+} {type eval line 1 cmd {info frame 0} proc ::foo::bar level 0}
+
+unset body
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+proc foo {} {
+    apply {
+	{x y}
+	{info frame 0}
+    } 0 0
+}
+test info-35.0 {apply, literal} {
+    reduce [foo]
+} {type source line 1231 file info.test cmd {info frame 0} lambda {
+	{x y}
+	{info frame 0}
+    } level 0}
+rename foo {}
+
+set lambda {
+    {x y}
+    {info frame 0}
+}
+test info-35.1 {apply, dynamic} {
+    reduce [apply $lambda 0 0]
+} {type proc line 1 cmd {info frame 0} lambda {
+    {x y}
+    {info frame 0}
+} level 0}
+unset lambda
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+    dict for {k v} {foo bar} {
+	set x [info frame 0]
+    }
+    set x
+}
+test info-36.0 {info frame, dict for, bcc} -body {
+    reduce [foo::bar]
+} -result {type source line 1259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+    set x foo
+    switch -exact -- $x {
+	foo {set y [info frame 0]}
+    }
+    set y
+}
+
+test info-36.1.0 {switch, list literal, bcc} -body {
+    reduce [foo::bar]
+} -result {type source line 1275 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+namespace eval foo {}
+proc foo::bar {} {
+    set x foo
+    switch -exact -- $x foo {set y [info frame 0]}
+    set y
+}
+
+test info-36.1.1 {switch, multi-body literals, bcc} -body {
+    reduce [foo::bar]
+} -result {type source line 1291 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+namespace delete foo
+
+# -------------------------------------------------------------------------
+
+test info-37.0 {eval pure list, single line} -match glob -body {
+    # Basically, counting the newline in the word seen through $foo
+    # doesn't really make sense. It makes a bit of sense if the word
+    # would have been a string literal in the command list.
+    #
+    # Problem: At the point where we see the list elements we cannot
+    # distinguish the two cases, thus we cannot switch between
+    # count/not-count, it is has to be one or the other for all
+    # cases. Of the two possibilities miguel convinced me that 'not
+    # counting' is the more proper.
+    set foo {b
+	c}
+    set cmd [list foreach $foo {x y} {
+	set res [join [lrange [etrace] 0 2] \n]
+	break
+    }]
+    eval $cmd
+    return $res
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type eval line 2 cmd etrace proc ::tcltest::RunTest}
+* {type eval line 1 cmd foreac proc ::tcltest::RunTest}} -cleanup {unset foo cmd res b c}
+
+# -------------------------------------------------------------------------
+
+# 6 cases.
+## DV. direct-var          - unchanged
+## DPV direct-proc-var     - ditto
+## PPV proc-proc-var       - ditto
+## DL. direct-literal      - now tracking absolute location
+## DPL direct-proc-literal - ditto
+## PPL proc-proc-literal   - ditto
+## ### ### ### ######### ######### #########"
+
+proc control {vv script} {
+    upvar 1 $vv var
+    return [uplevel 1 $script]
+}
+
+proc datal {} {
+    control y {
+	set y PPL
+	etrace
+    }
+}
+
+proc datav {} {
+    set script {
+	set y PPV
+	etrace
+    }
+    control y $script
+}
+
+test info-38.1 {location information for uplevel, dv, direct-var} -match glob -body {
+    set script {
+	set y DV.
+	etrace
+    }
+    join [lrange [uplevel \#0 $script] 0 2] \n
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type eval line 3 cmd etrace proc ::tcltest::RunTest}
+* {type source line 1361 file info.test cmd {uplevel \\#0 $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
+
+# 38.2 moved to bottom to not disturb other tests with the necessary changes to this one.
+
+
+
+
+
+
+
+
+test info-38.3 {location information for uplevel, dpv, direct-proc-var} -match glob -body {
+    set script {
+	set y DPV
+	etrace
+    }
+    join [lrange [control y $script] 0 3] \n
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type eval line 3 cmd etrace proc ::control}
+* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1380 file info.test cmd {control y $script} proc ::tcltest::RunTest}} -cleanup {unset script y}
+
+# 38.4 moved to bottom to not disturb other tests with the necessary changes to this one.
+
+
+
+
+
+
+
+
+
+test info-38.5 {location information for uplevel, ppv, proc-proc-var} -match glob -body {
+    join [lrange [datav] 0 4] \n
+} -result {* {type source line 730 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type eval line 3 cmd etrace proc ::control}
+* {type source line 1338 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1353 file info.test cmd {control y $script} proc ::datav level 1}
+* {type source line 1397 file info.test cmd datav proc ::tcltest::RunTest}}
+
+# 38.6 moved to bottom to not disturb other tests with the necessary changes to this one.
+
+
+
+
+
+
+
+testConstraint testevalex [llength [info commands testevalex]]
+test info-38.7 {location information for arg substitution} -constraints testevalex -match glob -body {
+    join [lrange [testevalex {return -level 0 [etrace]}] 0 3] \n
+} -result {* {type source line 730 file info.test cmd {info frame \$level} proc ::etrace level 0}
+* {type eval line 1 cmd etrace proc ::tcltest::RunTest}
+* {type source line 1414 file info.test cmd {testevalex {return -level 0 \[etrace]}} proc ::tcltest::RunTest}
+* {type source line * file tcltest* cmd {uplevel 1 $script} proc ::tcltest::RunTest}}
+
+# -------------------------------------------------------------------------
+# literal sharing
+
+test info-39.0 {location information not confused by literal sharing} -body {
+    namespace eval ::foo {}
+    proc ::foo::bar {} {
+	lappend res {}
+	lappend res [reduce [eval {info frame 0}]]
+	lappend res [reduce [eval {info frame 0}]]
+	return $res
+    }
+    set res [::foo::bar]
+    namespace delete ::foo
+    join $res \n
+} -cleanup {unset res} -result {
+type source line 1427 file info.test cmd {info frame 0} proc ::foo::bar level 0
+type source line 1428 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+# Additional tests for info-30.*, handling of continuation lines (bs+nl sequences).
+
+test info-30.1 {bs+nl in literal words, procedure body, compiled} -body {
+    proc abra {} {
+	if {1} \
+	    {
+		return \
+		    [reduce [info frame 0]];# line 1446
+	    }
+    }
+    abra
+} -cleanup {
+    rename abra {}
+} -result {type source line 1446 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.2 {bs+nl in literal words, namespace script} {
+    namespace eval xxx {
+	variable res \
+	    [info frame 0];# line 1457
+    }
+    return [reduce $xxx::res]
+} {type source line 1457 file info.test cmd {info frame 0} level 0}
+
+test info-30.3 {bs+nl in literal words, namespace multi-word script} {
+    namespace eval xxx variable res \
+	[list [reduce [info frame 0]]];# line 1464
+    return $xxx::res
+} {type source line 1464 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.4 {bs+nl in literal words, eval script} -cleanup {unset res} -body {
+    eval {
+	set ::res \
+	    [reduce [info frame 0]];# line 1471
+    }
+    return $res
+} -result {type source line 1471 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.5 {bs+nl in literal words, eval script, with nested words} -body {
+    eval {
+	if {1} \
+	    {
+		set ::res \
+		    [reduce [info frame 0]];# line 1481
+	    }
+    }
+    return $res
+} -cleanup {unset res} -result {type source line 1481 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.6 {bs+nl in computed word} -cleanup {unset res} -body {
+    set res "\
+[reduce [info frame 0]]";# line 1489
+} -result { type source line 1489 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.7 {bs+nl in computed word, in proc} -body {
+    proc abra {} {
+	return "\
+[reduce [info frame 0]]";# line 1495
+    }
+    abra
+} -cleanup {
+    rename abra {}
+} -result { type source line 1495 file info.test cmd {info frame 0} proc ::abra level 0}
+
+test info-30.8 {bs+nl in computed word, nested eval} -body {
+    eval {
+	set \
+	    res "\
+[reduce [info frame 0]]";# line 1506
+}
+} -cleanup {unset res} -result { type source line 1506 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.9 {bs+nl in computed word, nested eval} -body {
+    eval {
+	set \
+	    res "\
+[reduce \
+     [info frame 0]]";# line 1515
+}
+} -cleanup {unset res} -result { type source line 1515 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.10 {bs+nl in computed word, key to array} -body {
+    set tmp([set \
+	    res "\
+[reduce \
+     [info frame 0]]"]) x ; #1523
+    unset tmp
+    set res
+} -cleanup {unset res} -result { type source line 1523 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.11 {bs+nl in subst arguments} -body {
+    subst {[set \
+	    res "\
+[reduce \
+     [info frame 0]]"]} ; #1532
+} -cleanup {unset res} -result { type source line 1532 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.12 {bs+nl in computed word, nested eval} -body {
+    eval {
+	set \
+	    res "\
+[set x {}] \
+[reduce \
+     [info frame 0]]";# line 1541
+}
+} -cleanup {unset res x} -result {   type source line 1541 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.13 {bs+nl in literal words, uplevel script, with nested words} -body {
+    subinterp ; set res [interp eval sub { uplevel #0 {
+	if {1} \
+	    {
+		set ::res \
+		    [reduce [info frame 0]];# line 1550
+	    }
+    }
+    set res }] ; interp delete sub ; set res
+} -cleanup {unset res} -result {type source line 1550 file info.test cmd {info frame 0} level 0}
+
+test info-30.14 {bs+nl, literal word, uplevel through proc} {
+    subinterp ; set res [interp eval sub { proc abra {script} {
+	uplevel 1 $script
+    }
+    set res [abra {
+	return "\
+[reduce [info frame 0]]";# line 1562
+    }]
+    rename abra {}
+    set res }] ; interp delete sub ; set res
+} { type source line 1562 file info.test cmd {info frame 0} proc ::abra}
+
+test info-30.15 {bs+nl in literal words, nested proc body, compiled} {
+    proc a {} {
+	proc b {} {
+	    if {1} \
+		{
+		    return \
+			[reduce [info frame 0]];# line 1574
+		}
+	}
+    }
+    a ; set res [b]
+    rename a {}
+    rename b {}
+    set res
+} {type source line 1574 file info.test cmd {info frame 0} proc ::b level 0}
+
+test info-30.16 {bs+nl in multi-body switch, compiled} {
+    proc a {value} {
+	switch -regexp -- $value \
+	    ^key     { info frame 0; # 1587 } \
+	    \t###    { info frame 0; # 1588 } \
+	    {[0-9]*} { info frame 0; # 1589 }
+    }
+    set res {}
+    lappend res [reduce [a {key   }]]
+    lappend res [reduce [a {1alpha}]]
+    set res "\n[join $res \n]"
+} {
+type source line 1587 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1589 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.17 {bs+nl in multi-body switch, direct} {
+    switch -regexp -- {key    } \
+	^key     { reduce [info frame 0] ;# 1601 } \
+        \t###    { } \
+        {[0-9]*} { }
+} {type source line 1601 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.18 {bs+nl, literal word, uplevel through proc, appended, loss of primary tracking data} {
+    proc abra {script} {
+	append script "\n# end of script"
+	uplevel 1 $script
+    }
+    set res [abra {
+	return "\
+[reduce [info frame 0]]";# line 1613, still line of 3 appended script
+    }]
+    rename abra {}
+    set res
+} { type eval line 3 cmd {info frame 0} proc ::abra}
+# { type source line 1606 file info.test cmd {info frame 0} proc ::abra}
+
+test info-30.19 {bs+nl in single-body switch, compiled} {
+    proc a {value} {
+	switch -regexp -- $value {
+	    ^key     { reduce \
+			   [info frame 0] }
+	    \t       { reduce \
+			   [info frame 0] }
+	    {[0-9]*} { reduce \
+			   [info frame 0] }
+	}
+    }
+    set res {}
+    lappend res [a {key   }]
+    lappend res [a {1alpha}]
+    set res "\n[join $res \n]"
+} {
+type source line 1624 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1628 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.20 {bs+nl in single-body switch, direct} {
+    switch -regexp -- {key    } { \
+
+	^key     { reduce \
+		       [info frame 0] }
+	\t###    { }
+        {[0-9]*} { }
+    }
+} {type source line 1643 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+
+test info-30.21 {bs+nl in if, full compiled} {
+    proc a {value} {
+	if {$value} \
+	    {info frame 0} \
+	    {info frame 0} ; # 1653
+    }
+    set res {}
+    lappend res [reduce [a 1]]
+    lappend res [reduce [a 0]]
+    set res "\n[join $res \n]"
+} {
+type source line 1652 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1653 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.22 {bs+nl in computed word, key to array, compiled} {
+    proc a {} {
+	set tmp([set \
+		     res "\
+[reduce \
+     [info frame 0]]"]) x ; #1668
+    unset tmp
+    set res
+    }
+    set res [a]
+    rename a {}
+    set res
+} { type source line 1668 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.23 {bs+nl in multi-body switch, full compiled} {
+    proc a {value} {
+	switch -exact -- $value \
+	    key     { info frame 0; # 1680 } \
+	    xxx     { info frame 0; # 1681 } \
+	    000     { info frame 0; # 1682 }
+    }
+    set res {}
+    lappend res [reduce [a key]]
+    lappend res [reduce [a 000]]
+    set res "\n[join $res \n]"
+} {
+type source line 1680 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1682 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.24 {bs+nl in single-body switch, full compiled} {
+    proc a {value} {
+	switch -exact -- $value {
+	    key { reduce \
+		      [info frame 0] }
+	    xxx { reduce \
+		      [info frame 0] }
+	    000 { reduce \
+		      [info frame 0] }
+	}
+    }
+    set res {}
+    lappend res [a key]
+    lappend res [a 000]
+    set res "\n[join $res \n]"
+} {
+type source line 1696 file info.test cmd {info frame 0} proc ::a level 0
+type source line 1700 file info.test cmd {info frame 0} proc ::a level 0}
+
+test info-30.25 {TIP 280 for compiled [subst]} {
+    subst {[reduce [info frame 0]]} ; # 1712
+} {type source line 1712 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.26 {TIP 280 for compiled [subst]} {
+    subst \
+	    {[reduce [info frame 0]]} ; # 1716
+} {type source line 1716 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.27 {TIP 280 for compiled [subst]} {
+    subst {
+[reduce [info frame 0]]} ; # 1720
+} {
+type source line 1720 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.28 {TIP 280 for compiled [subst]} {
+    subst {\
+[reduce [info frame 0]]} ; # 1725
+} { type source line 1725 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.29 {TIP 280 for compiled [subst]} {
+    subst {foo\
+[reduce [info frame 0]]} ; # 1729
+} {foo type source line 1729 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.30 {TIP 280 for compiled [subst]} {
+    subst {foo
+[reduce [info frame 0]]} ; # 1733
+} {foo
+type source line 1733 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.31 {TIP 280 for compiled [subst]} {
+    subst {[][reduce [info frame 0]]} ; # 1737
+} {type source line 1737 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.32 {TIP 280 for compiled [subst]} {
+    subst {[\
+][reduce [info frame 0]]} ; # 1741
+} {type source line 1741 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.33 {TIP 280 for compiled [subst]} {
+    subst {[
+][reduce [info frame 0]]} ; # 1745
+} {type source line 1745 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.34 {TIP 280 for compiled [subst]} {
+    subst {[format %s {}
+][reduce [info frame 0]]} ; # 1749
+} {type source line 1749 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.35 {TIP 280 for compiled [subst]} {
+    subst {[format %s {}
+]
+[reduce [info frame 0]]} ; # 1754
+} {
+type source line 1754 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.36 {TIP 280 for compiled [subst]} {
+    subst {
+[format %s {}][reduce [info frame 0]]} ; # 1759
+} {
+type source line 1759 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.37 {TIP 280 for compiled [subst]} {
+    subst {
+[format %s {}]
+[reduce [info frame 0]]} ; # 1765
+} {
+
+type source line 1765 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.38 {TIP 280 for compiled [subst]} {
+    subst {\
+[format %s {}][reduce [info frame 0]]} ; # 1771
+} { type source line 1771 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.39 {TIP 280 for compiled [subst]} {
+    subst {\
+[format %s {}]\
+[reduce [info frame 0]]} ; # 1776
+} {  type source line 1776 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.40 {TIP 280 for compiled [subst]} -setup {
+    unset -nocomplain empty
+} -body {
+    set empty {}
+    subst {$empty[reduce [info frame 0]]} ; # 1782
+} -cleanup {
+    unset empty
+} -result {type source line 1782 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.41 {TIP 280 for compiled [subst]} -setup {
+    unset -nocomplain empty
+} -body {
+    set empty {}
+    subst {$empty
+[reduce [info frame 0]]} ; # 1791
+} -cleanup {
+    unset empty
+} -result {
+type source line 1791 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.42 {TIP 280 for compiled [subst]} -setup {
+    unset -nocomplain empty
+} -body {
+    set empty {}; subst {$empty\
+[reduce [info frame 0]]} ; # 1800
+} -cleanup {
+    unset empty
+} -result { type source line 1800 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.43 {TIP 280 for compiled [subst]} -body {
+    unset -nocomplain a\nb
+    set a\nb {}
+    subst {${a
+b}[reduce [info frame 0]]} ; # 1808
+} -cleanup {unset a\nb} -result {type source line 1808 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.44 {TIP 280 for compiled [subst]} {
+    unset -nocomplain a
+    set a(\n) {}
+    subst {$a(
+)[reduce [info frame 0]]} ; # 1814
+} {type source line 1814 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.45 {TIP 280 for compiled [subst]} {
+    unset -nocomplain a
+    set a() {}
+    subst {$a([
+return -level 0])[reduce [info frame 0]]} ; # 1820
+} {type source line 1820 file info.test cmd {info frame 0} proc ::tcltest::RunTest}
+test info-30.46 {TIP 280 for compiled [subst]} {
+    unset -nocomplain a
+    set a(1825) YES;  set a(1824) 1824; set a(1826) 1826
+    subst {$a([dict get [info frame 0] line])} ; # 1825
+} YES
+test info-30.47 {TIP 280 for compiled [subst]} {
+    unset -nocomplain a
+    set a(\n1831) YES;  set a(\n1830) 1830; set a(\n1832) 1832
+    subst {$a(
+[dict get [info frame 0] line])} ; # 1831
+} YES
+unset -nocomplain a
+
+test info-30.48 {Bug 2850901} testevalex {
+    testevalex {return -level 0 [format %s {}
+][reduce [info frame 0]]} ; # line 2 of the eval
+} {type eval line 2 cmd {info frame 0} proc ::tcltest::RunTest}
+
+
+# -------------------------------------------------------------------------
+# literal sharing 2, bug 2933089
+
+test info-39.1 {location information not confused by literal sharing, bug 2933089} -setup {
+    set result {}
+
+    proc print_one {} {}
+    proc test_info_frame {} {
+	set x 1
+	set y x
+
+	if "$x != 1" {
+	} else {
+	    print_one
+	} ;#line 1854^
+
+	if "$$y != 1" {
+	} else {
+	    print_one
+	} ;#line 1859^
+	# Do not put the comments listing the line numbers into the
+	# branches. We need shared literals, and the comments would
+	# make them different, thus unshared.
+    }
+
+    proc get_frame_info { cmd_str op } {
+	lappend ::result [reduce [eval {info frame -3}]]
+    }
+    trace add execution print_one enter get_frame_info
+} -body {
+    test_info_frame;
+    join $result \n
+} -cleanup {
+    trace remove execution print_one enter get_frame_info
+    rename get_frame_info {}
+    rename test_info_frame {}
+    rename print_one {}
+} -result {type source line 1854 file info.test cmd print_one proc ::test_info_frame level 1
+type source line 1859 file info.test cmd print_one proc ::test_info_frame level 1}
+
+# -------------------------------------------------------------------------
+# Tests moved to the end to not disturb other tests and their locations.
+
+test info-38.6 {location information for uplevel, ppl, proc-proc-literal} -match glob -setup {subinterp} -body {
+    interp eval sub {
+	proc etrace {} {
+	    set res {}
+	    set level [info frame]
+	    while {$level} {
+		lappend res [list $level [reduce [info frame $level]]]
+		incr level -1
+	    }
+	    return $res
+	}
+	proc control {vv script} {
+	    upvar 1 $vv var
+	    return [uplevel 1 $script]
+	}
+	proc datal {} {
+	    control y {
+		set y PPL
+		etrace
+	    }
+	}
+	join [lrange [datal] 0 4] \n
+    }
+} -result {* {type source line 1890 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1902 file info.test cmd etrace proc ::control}
+* {type source line 1897 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1900 file info.test cmd control proc ::datal level 1}
+* {type source line 1905 file info.test cmd datal level 2}} -cleanup {interp delete sub}
+
+test info-38.4 {location information for uplevel, dpv, direct-proc-literal} -match glob -setup {subinterp} -body {
+    interp eval sub {
+	proc etrace {} {
+	    set res {}
+	    set level [info frame]
+	    while {$level} {
+		lappend res [list $level [reduce [info frame $level]]]
+		incr level -1
+	    }
+	    return $res
+	}
+	proc control {vv script} {
+	    upvar 1 $vv var
+	    return [uplevel 1 $script]
+	}
+	join [lrange [control y {
+	    set y DPL
+	    etrace
+	}] 0 3] \n
+    }
+} -result {* {type source line 1919 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1930 file info.test cmd etrace proc ::control}
+* {type source line 1926 file info.test cmd {uplevel 1 $script} proc ::control}
+* {type source line 1928 file info.test cmd control level 1}} -cleanup {interp delete sub}
+
+test info-38.2 {location information for uplevel, dl, direct-literal} -match glob -setup {subinterp} -body {
+    interp eval sub {
+	proc etrace {} {
+	    set res {}
+	    set level [info frame]
+	    while {$level} {
+		lappend res [list $level [reduce [info frame $level]]]
+		incr level -1
+	    }
+	    return $res
+	}
+	join [lrange [uplevel \#0 {
+	    set y DL.
+	    etrace
+	}] 0 2] \n
+    }
+} -result {* {type source line 1944 file info.test cmd {info frame $level} proc ::etrace level 0}
+* {type source line 1951 file info.test cmd etrace level 1}
+* {type source line 1949 file info.test cmd uplevel\\ \\\\ level 1}} -cleanup {interp delete sub}
+
+# This test at the end of this file _only_ to avoid disturbing above line
+# numbers. It _belongs_ after info-9.12
+test info-9.13 {info level option, value in global context} -body {
+    uplevel #0 {info level 2}
+} -returnCodes error -result {bad level "2"}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    catch {*}{
+	{info frame 0}
+	res
+    }
+    return $res
+}
+test info-33.4 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1968 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    dict for {a b} {c d} {*}{
+	{set res [info frame 0]}
+    }
+    return $res
+}
+test info-33.5 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1983 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    set d {a b}
+    dict update d x y {*}{
+	{set res [info frame 0]}
+    }
+    return $res
+}
+test info-33.6 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 1998 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    set d {}
+    dict with d {*}{
+	{set res [info frame 0]}
+    }
+    return $res
+}
+test info-33.7 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2013 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{set res [info frame 0]}
+	{1} {} {break}
+    }
+    return $res
+}
+test info-33.8 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2027 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{} {1} {}
+	{set res [info frame 0]; break}
+    }
+    return $res
+}
+test info-33.9 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2043 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{} {1}
+	{return [info frame 0]}
+	{}
+    }
+}
+test info-33.10 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2058 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    for {*}{
+	{}
+	{[return [info frame 0]]}
+	{} {}
+    }
+}
+test info-33.11 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2073 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    foreach {*}{
+	x
+    } [return [info frame 0]] {}
+}
+test info-33.12 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2088 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    foreach {*}{
+	x y
+	{set res [info frame 0]}
+    } 
+    return $res
+}
+test info-33.13 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2101 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    if {*}{
+	{[return [info frame 0]]}
+	{}
+    } 
+}
+test info-33.14 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2115 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    if 0 {*}{
+	{} else
+	{return [info frame 0]}
+    } 
+}
+test info-33.15 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2130 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    incr {*}{
+	x
+    } [return [info frame 0]]
+}
+test info-33.16 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2144 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    info level {*}{
+    } [return [info frame 0]]
+}
+test info-33.17 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2156 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    string match {*}{
+    } [return [info frame 0]] {}
+}
+test info-33.18 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2168 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    string match {*}{
+	{}
+    } [return [info frame 0]]
+}
+test info-33.19 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2181 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    string length {*}{
+    } [return [info frame 0]]
+}
+test info-33.20 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2193 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    while {*}{
+	{[return [info frame 0]]}
+    } {}
+}
+test info-33.21 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2205 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    switch -- {*}{
+    } [return [info frame 0]] {*}{
+    } x y
+}
+test info-33.22 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2218 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } 
+    return $res
+}
+test info-33.23 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2231 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } finally {}
+    return $res
+}
+test info-33.24 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2245 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } on ok {} {}
+    return $res
+}
+test info-33.25 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2259 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {*}{
+	{set res [info frame 0]}
+    } on ok {} {} finally {}
+    return $res
+}
+test info-33.26 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2273 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    while 1 {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.27 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2287 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} finally {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.28 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2300 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} on ok {} {} finally {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.29 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2313 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} on ok {} {*}{
+	{return [info frame 0]}
+    }
+}
+test info-33.30 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2326 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    try {} on ok {} {*}{
+	{return [info frame 0]}
+    } finally {}
+}
+test info-33.31 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2339 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    binary format {*}{
+    } [return [info frame 0]]
+}
+test info-33.32 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2352 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    set format format
+    binary $format {*}{
+    } [return [info frame 0]]
+}
+test info-33.33 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2365 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    append x {*}{
+    } [return [info frame 0]]
+}
+test info-33.34 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2377 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+namespace eval foo {}
+proc foo::bar {} {
+    append {*}{
+    } x([return [info frame 0]]) {*}{
+    } a
+}
+test info-33.35 {{*}, literal, simple, bytecompiled} -body {
+    reduce [foo::bar]
+} -cleanup {
+    namespace delete foo
+} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}
+
+# -------------------------------------------------------------------------
+unset -nocomplain res
 
 # cleanup
 catch {namespace delete test_ns_info1 test_ns_info2}
diff --git a/tests/init.test b/tests/init.test
index 694ce74..41b8624 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -1,141 +1,114 @@
-# Functionality covered: this file contains a collection of tests for the
-# auto loading and namespaces.
+# Functionality covered: this file contains a collection of tests for the auto
+# loading and namespaces.
 #
-# 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.
-#
-# RCS: @(#) $Id: init.test,v 1.14 2005/05/24 19:13:46 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.3.4
     namespace import -force ::tcltest::*
 }
 
 # Clear out any namespaces called test_ns_*
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
-
+catch {namespace delete {*}[namespace children :: test_ns_*]}
+
 # Six cases - white box testing
 
 test init-1.1 {auto_qualify - absolute cmd - namespace} {
     auto_qualify ::foo::bar ::blue
 } ::foo::bar
-
 test init-1.2 {auto_qualify - absolute cmd - global} {
     auto_qualify ::global ::sub
 } global
-
 test init-1.3 {auto_qualify - no colons cmd - global} {
     auto_qualify nocolons ::
 } nocolons 
-
 test init-1.4 {auto_qualify - no colons cmd - namespace} {
     auto_qualify nocolons ::sub
 } {::sub::nocolons nocolons}
-
 test init-1.5 {auto_qualify - colons in cmd - global} {
     auto_qualify foo::bar ::
 } ::foo::bar
-
 test init-1.6 {auto_qualify - colons in cmd - namespace} {
     auto_qualify foo::bar ::sub
 } {::sub::foo::bar ::foo::bar}
-
 # Some additional tests
-
 test init-1.7 {auto_qualify - multiples colons 1} {
     auto_qualify :::foo::::bar ::blue
 } ::foo::bar
-
 test init-1.8 {auto_qualify - multiple colons 2} {
     auto_qualify :::foo ::bar
 } foo
-
-
-# we use a sub interp and auto_reset and double the tests because there is 2
+
+# We use a sub-interp and auto_reset and double the tests because there is 2
 # places where auto_loading occur (before loading the indexes files and after)
 
 set testInterp [interp create]
-interp eval $testInterp [list set argv $argv]
-interp eval $testInterp [list package require tcltest]
-interp eval $testInterp [list namespace import -force ::tcltest::*]
-
+tcltest::loadIntoSlaveInterpreter $testInterp {*}$argv
 interp eval $testInterp {
+    namespace import -force ::tcltest::*
+    customMatch pairwise {apply {{mode pair} {
+	if {[llength $pair] != 2} {error "need a pair of values to check"}
+	string $mode [lindex $pair 0] [lindex $pair 1]
+    }}}
 
-auto_reset
-catch {rename parray {}}
-
-test init-2.0 {load parray - stage 1} {
-    set ret [catch {parray} error]
-    rename parray {} ; # remove it, for the next test - that should not fail.
-    list $ret $error
-} {1 {wrong # args: should be "parray a ?pattern?"}}
-
-
-test init-2.1 {load parray - stage 2} {
-    set ret [catch {parray} error]
-    list $ret $error
-} {1 {wrong # args: should be "parray a ?pattern?"}}
-
-
+    auto_reset
+    catch {rename parray {}}
+
+test init-2.0 {load parray - stage 1} -body {
+    parray
+} -returnCodes error -cleanup {
+    rename parray {}  ;# remove it, for the next test - that should not fail.
+} -result {wrong # args: should be "parray a ?pattern?"}
+test init-2.1 {load parray - stage 2} -body {
+    parray
+} -returnCodes error -result {wrong # args: should be "parray a ?pattern?"}
 auto_reset
 catch {rename ::safe::setLogCmd {}}
-#unset auto_index(::safe::setLogCmd)
-#unset auto_oldpath
-
+#unset -nocomplain auto_index(::safe::setLogCmd) auto_oldpath
 test init-2.2 {load ::safe::setLogCmd - stage 1} {
     ::safe::setLogCmd
-    rename ::safe::setLogCmd {} ; # should not fail
+    rename ::safe::setLogCmd {}  ;# should not fail
 } {}
-
 test init-2.3 {load ::safe::setLogCmd - stage 2} {
     ::safe::setLogCmd
-    rename ::safe::setLogCmd {} ; # should not fail
+    rename ::safe::setLogCmd {}  ;# should not fail
 } {}
-
 auto_reset
 catch {rename ::safe::setLogCmd {}}
-
 test init-2.4 {load safe:::setLogCmd - stage 1} {
-    safe:::setLogCmd ; # intentionally 3 :
-    rename ::safe::setLogCmd {} ; # should not fail
+    safe:::setLogCmd  ;# intentionally 3 :
+    rename ::safe::setLogCmd {}  ;# should not fail
 } {}
-
 test init-2.5 {load safe:::setLogCmd - stage 2} {
-    safe:::setLogCmd ; # intentionally 3 :
-    rename ::safe::setLogCmd {} ; # should not fail
+    safe:::setLogCmd  ;# intentionally 3 :
+    rename ::safe::setLogCmd {}  ;# should not fail
 } {}
-
 auto_reset
 catch {rename ::safe::setLogCmd {}}
-
 test init-2.6 {load setLogCmd from safe:: - stage 1} {
     namespace eval safe setLogCmd 
-    rename ::safe::setLogCmd {} ; # should not fail
+    rename ::safe::setLogCmd {}  ;# should not fail
 } {}
-
 test init-2.7 {oad setLogCmd from safe::  - stage 2} {
     namespace eval safe setLogCmd 
-    rename ::safe::setLogCmd {} ; # should not fail
+    rename ::safe::setLogCmd {}  ;# should not fail
 } {}
-
-
-
 test init-2.8 {load tcl::HistAdd} -setup {
     auto_reset
     catch {rename ::tcl::HistAdd {}}
 } -body {
     # 3 ':' on purpose
-    list [catch {tcl:::HistAdd} error] $error
-} -cleanup {
-    rename ::tcl::HistAdd {} ; 
-} -result {1 {wrong # args: should be "tcl:::HistAdd command ?exec?"}}
-
+    tcl:::HistAdd
+} -returnCodes error -cleanup {
+    rename ::tcl::HistAdd {}
+} -result {wrong # args: should be "tcl:::HistAdd event ?exec?"}
 
 test init-3.0 {random stuff in the auto_index, should still work} {
     set auto_index(foo:::bar::blah) {
@@ -144,18 +117,18 @@ test init-3.0 {random stuff in the auto_index, should still work} {
     foo:::bar::blah
 } 1
 
-# Tests that compare the error stack trace generated when autoloading
-# with that generated when no autoloading is necessary.  Ideally they
-# should be the same.
+# Tests that compare the error stack trace generated when autoloading with
+# that generated when no autoloading is necessary.  Ideally they should be the
+# same.
 
 set count 0
 foreach arg [subst -nocommands -novariables {
-		c
-                {argument
+    c
+    {argument
                 which spans
                 multiple lines}
-                {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
-                {argument which spans multiple lines
+    {argument which is all on one line but which is of such great length that the Tcl C library will truncate it when appending it onto the global error stack}
+    {argument which spans multiple lines
                 and is long enough to be truncated and
 "               <- includes a false lead in the prune point search
                 and must be longer still to force truncation}
@@ -164,34 +137,33 @@ foreach arg [subst -nocommands -novariables {
 		error stack cannot be uniquely determined.
 		foo bar foo
 "}
-                {contrived example: rare circumstance 
+    {contrived example: rare circumstance 
 		where the point at which to prune the
 		error stack cannot be uniquely determined.
 		foo bar
 "}
-		{argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
-	}] {
+    {argument that contains non-ASCII character, \u20ac, and which is of such great length that it will be longer than 150 bytes so it will be truncated by the Tcl C library}
+	}] {    ;# emacs needs -> "
 
-    test init-4.$count.0 {::errorInfo produced by [unknown]} {
+    test init-4.$count.0 {::errorInfo produced by [unknown]} -setup {
 	auto_reset
+    } -body {
 	catch {parray a b $arg}
 	set first $::errorInfo
 	catch {parray a b $arg}
-	set second $::errorInfo
-	string equal $first $second
-    } 1
-
-    test init-4.$count.1 {::errorInfo produced by [unknown]} {
+	list $first $::errorInfo
+    } -match pairwise -result equal
+    test init-4.$count.1 {::errorInfo produced by [unknown]} -setup {
 	auto_reset
+    } -body {
 	namespace eval junk [list array set $arg [list 1 2 3 4]]
 	trace variable ::junk::$arg r \
 		"[list error [subst {Variable \"$arg\" is write-only}]] ;# "
 	catch {parray ::junk::$arg}
 	set first $::errorInfo
 	catch {parray ::junk::$arg}
-	set second $::errorInfo
-	string equal $first $second
-    } 1
+	list $first $::errorInfo
+    } -match pairwise -result equal
 
     incr count
 }
@@ -207,8 +179,8 @@ test init-5.0 {return options passed through ::unknown} -setup {
     list $code $foo $bar $code2 $foo2 $bar2
 } -cleanup {
     unset ::auto_index(::xxx)
-} -result {2 xxx {-code 1 -level 1} 2 xxx {-code 1 -level 1}}
-
+} -match glob -result {2 xxx {-errorcode NONE -code 1 -level 1} 2 xxx {-code 1 -level 1 -errorcode NONE}}
+
 cleanupTests
 }	;#  End of [interp eval $testInterp]
 
@@ -217,3 +189,7 @@ interp delete $testInterp
 ::tcltest::cleanupTests
 return
 
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/interp.test b/tests/interp.test
index f801247..ad99fac 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -9,59 +9,57 @@
 #
 # 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.46 2005/06/17 14:26:15 dkf Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2.1
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testinterpdelete [llength [info commands testinterpdelete]]
 
-set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source}
+set hidden_cmds {cd encoding exec exit fconfigure file 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
 }
-
-proc equiv {x} {return $x}
-
+
 # Part 0: Check out options for interp command
-test interp-1.1 {options for interp command} {
-    list [catch {interp} msg] $msg
-} {1 {wrong # args: should be "interp cmd ?arg ...?"}}
-test interp-1.2 {options for interp command} {
-    list [catch {interp frobox} msg] $msg
-} {1 {bad option "frobox": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+test interp-1.1 {options for interp command} -returnCodes error -body {
+    interp
+} -result {wrong # args: should be "interp cmd ?arg ...?"}
+test interp-1.2 {options for interp command} -returnCodes error -body {
+    interp frobox
+} -result {bad option "frobox": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
 test interp-1.3 {options for interp command} {
     interp delete
 } ""
-test interp-1.4 {options for interp command} {
-    list [catch {interp delete foo bar} msg] $msg
-} {1 {could not find interpreter "foo"}}
-test interp-1.5 {options for interp command} {
-    list [catch {interp exists foo bar} msg] $msg
-} {1 {wrong # args: should be "interp exists ?path?"}}
+test interp-1.4 {options for interp command} -returnCodes error -body {
+    interp delete foo bar
+} -result {could not find interpreter "foo"}
+test interp-1.5 {options for interp command} -returnCodes error -body {
+    interp exists foo bar
+} -result {wrong # args: should be "interp exists ?path?"}
 #
 # test interp-0.6 was removed
 #
-test interp-1.6 {options for interp command} {
-    list [catch {interp slaves foo bar zop} msg] $msg
-} {1 {wrong # args: should be "interp slaves ?path?"}}
-test interp-1.7 {options for interp command} {
-    list [catch {interp hello} msg] $msg
-} {1 {bad option "hello": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
-test interp-1.8 {options for interp command} {
-    list [catch {interp -froboz} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
-test interp-1.9 {options for interp command} {
-    list [catch {interp -froboz -safe} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}} 
-test interp-1.10 {options for interp command} {
-    list [catch {interp target} msg] $msg
-} {1 {wrong # args: should be "interp target path alias"}}
-
+test interp-1.6 {options for interp command} -returnCodes error -body {
+    interp slaves foo bar zop
+} -result {wrong # args: should be "interp slaves ?path?"}
+test interp-1.7 {options for interp command} -returnCodes error -body {
+    interp hello
+} -result {bad option "hello": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+test interp-1.8 {options for interp command} -returnCodes error -body {
+    interp -froboz
+} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+test interp-1.9 {options for interp command} -returnCodes error -body {
+    interp -froboz -safe
+} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer} 
+test interp-1.10 {options for interp command} -returnCodes error -body {
+    interp target
+} -result {wrong # args: should be "interp target path alias"}
 
 # Part 1: Basic interpreter creation tests:
 test interp-2.1 {basic interpreter creation} {
@@ -113,11 +111,11 @@ test interp-2.12 {anonymous interps vs existing procs} {
     set x [interp create -safe]
     regexp "interp(\[0-9]+)" $x dummy anothernum
     expr $anothernum - $thenum
-} 1    
+} 1
 test interp-2.13 {correct default when no $path arg is given} -body {
     interp create --
 } -match regexp -result {interp[0-9]+}
-    
+
 foreach i [interp slaves] {
     interp delete $i
 }
@@ -133,24 +131,24 @@ test interp-3.2 {testing interp exists and interp slaves} {
 test interp-3.3 {testing interp exists and interp slaves} {
     interp exists nonexistent
 } 0
-test interp-3.4 {testing interp exists and interp slaves} {
-    list [catch {interp slaves a b c} msg] $msg
-} {1 {wrong # args: should be "interp slaves ?path?"}}
-test interp-3.5 {testing interp exists and interp slaves} {
-    list [catch {interp exists a b c} msg] $msg
-} {1 {wrong # args: should be "interp exists ?path?"}}
+test interp-3.4 {testing interp exists and interp slaves} -body {
+    interp slaves a b c
+} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
+test interp-3.5 {testing interp exists and interp slaves} -body {
+    interp exists a b c
+} -returnCodes error -result {wrong # args: should be "interp exists ?path?"}
 test interp-3.6 {testing interp exists and interp slaves} {
     interp exists
 } 1
 test interp-3.7 {testing interp exists and interp slaves} {
     interp slaves
 } a
-test interp-3.8 {testing interp exists and interp slaves} {
-    list [catch {interp slaves a b c} msg] $msg
-} {1 {wrong # args: should be "interp slaves ?path?"}}
+test interp-3.8 {testing interp exists and interp slaves} -body {
+    interp slaves a b c
+} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
 test interp-3.9 {testing interp exists and interp slaves} {
     interp create {a a2} -safe
-    expr {[lsearch [interp slaves a] a2] >= 0}
+    expr {"a2" in [interp slaves a]}
 } 1
 test interp-3.10 {testing interp exists and interp slaves} {
     interp exists {a a2}
@@ -164,12 +162,12 @@ test interp-4.1 {testing interp delete} {
     catch {interp create a}
     interp delete a
 } ""
-test interp-4.2 {testing interp delete} {
-    list [catch {interp delete nonexistent} msg] $msg
-} {1 {could not find interpreter "nonexistent"}}
-test interp-4.3 {testing interp delete} {
-    list [catch {interp delete x y z} msg] $msg
-} {1 {could not find interpreter "x"}}
+test interp-4.2 {testing interp delete} -returnCodes error -body {
+    interp delete nonexistent
+} -result {could not find interpreter "nonexistent"}
+test interp-4.3 {testing interp delete} -returnCodes error -body {
+    interp delete x y z
+} -result {could not find interpreter "x"}
 test interp-4.4 {testing interp delete} {
     interp delete
 } ""
@@ -177,7 +175,7 @@ test interp-4.5 {testing interp delete} {
     interp create a
     interp create {a x1}
     interp delete {a x1}
-    expr {[lsearch [interp slaves a] x1] >= 0}
+    expr {"x1" in [interp slaves a]}
 } 0
 test interp-4.6 {testing interp delete} {
     interp create c1
@@ -185,14 +183,14 @@ test interp-4.6 {testing interp delete} {
     interp create c3
     interp delete c1 c2 c3
 } ""
-test interp-4.7 {testing interp delete} {
+test interp-4.7 {testing interp delete} -returnCodes error -body {
     interp create c1
     interp create c2
-    list [catch {interp delete c1 c2 c3} msg] $msg
-} {1 {could not find interpreter "c3"}}
-test interp-4.8 {testing interp delete} {
-    list [catch {interp delete {}} msg] $msg
-} {1 {cannot delete the current interpreter}}
+    interp delete c1 c2 c3
+} -result {could not find interpreter "c3"}
+test interp-4.8 {testing interp delete} -returnCodes error -body {
+    interp delete {}
+} -result {cannot delete the current interpreter}
 
 foreach i [interp slaves] {
     interp delete $i
@@ -217,9 +215,9 @@ interp create a
 test interp-6.1 {testing eval} {
     a eval expr 3 + 5
 } 8
-test interp-6.2 {testing eval} {
-    list [catch {a eval foo} msg] $msg
-} {1 {invalid command name "foo"}}
+test interp-6.2 {testing eval} -returnCodes error -body {
+    a eval foo
+} -result {invalid command name "foo"}
 test interp-6.3 {testing eval} {
     a eval {proc foo {} {expr 3 + 5}}
     a eval foo
@@ -227,15 +225,14 @@ test interp-6.3 {testing eval} {
 test interp-6.4 {testing eval} {
     interp eval a foo
 } 8
-
 test interp-6.5 {testing eval} {
     interp create {a x2}
     interp eval {a x2} {proc frob {} {expr 4 * 9}}
     interp eval {a x2} frob
 } 36
-test interp-6.6 {testing eval} {
-    list [catch {interp eval {a x2} foo} msg] $msg
-} {1 {invalid command name "foo"}}
+test interp-6.6 {testing eval} -returnCodes error -body {
+    interp eval {a x2} foo
+} -result {invalid command name "foo"}
 
 # UTILITY PROCEDURE RUNNING IN MASTER INTERPRETER:
 proc in_master {args} {
@@ -259,9 +256,9 @@ test interp-7.4 {testing basic alias creation} {
 test interp-7.5 {testing basic alias creation} {
     lsort [a aliases]
 } {bar foo}
-test interp-7.6 {testing basic aliases arg checking} {
-    list [catch {a aliases too many args} msg] $msg
-} {1 {wrong # args: should be "a aliases"}}
+test interp-7.6 {testing basic aliases arg checking} -returnCodes error -body {
+    a aliases too many args
+} -result {wrong # args: should be "a aliases"}
 
 # Part 7: testing basic alias invocation
 test interp-8.1 {testing basic alias invocation} {
@@ -274,10 +271,10 @@ test interp-8.2 {testing basic alias invocation} {
     a alias bar in_master a1 a2 a3
     a eval bar s1 s2 s3
 } {seen in master: {a1 a2 a3 s1 s2 s3}}
-test interp-8.3 {testing basic alias invocation} {
+test interp-8.3 {testing basic alias invocation} -returnCodes error -body {
    catch {interp create a}
-   list [catch {a alias} msg] $msg
-} {1 {wrong # args: should be "a alias aliasName ?targetName? ?args..?"}}
+   a alias
+} -result {wrong # args: should be "a alias aliasName ?targetName? ?arg ...?"}
 
 # Part 8: Testing aliases for non-existent or hidden targets
 test interp-9.1 {testing aliases for non-existent targets} {
@@ -379,7 +376,7 @@ test interp-10.7 {testing aliases between interpreters} {
     set x [foo 33]
     a eval {rename zoppo {}}
     interp alias "" foo a {}
-    equiv $x
+    return $x
 } {33 33 33}
 
 # Part 10: Testing "interp target"
@@ -503,6 +500,92 @@ test interp-14.4 {testing interp alias - alias over master} {
     interp create a
     list [catch {interp alias "" a a eval} msg] $msg [info commands a]
 } {1 {cannot define or rename alias "a": interpreter deleted} {}}
+test interp-14.5 {testing interp-alias: wrong # args} -body {
+    proc setx x {set x}
+    interp alias {} a {} setx
+    catch {a 1 2}
+    set ::errorInfo
+} -cleanup {
+    rename setx {}
+    rename a {}
+} -result {wrong # args: should be "a x"
+    while executing
+"a 1 2"}
+test interp-14.6 {testing interp-alias: wrong # args} -setup {
+    proc setx x {set x}
+    catch {interp delete a}
+    interp create a
+} -body {
+    interp alias a a {} setx
+    catch {a eval a 1 2}
+    set ::errorInfo
+} -cleanup {
+    rename setx {}
+    interp delete a
+} -result {wrong # args: should be "a x"
+    invoked from within
+"a 1 2"
+    invoked from within
+"a eval a 1 2"}
+test interp-14.7 {testing interp-alias: wrong # args} -setup {
+    proc setx x {set x}
+    catch {interp delete a}
+    interp create a
+} -body {
+    interp alias a a {} setx
+    a eval {
+	catch {a 1 2}
+	set ::errorInfo
+    }
+} -cleanup {
+    rename setx {}
+    interp delete a
+} -result {wrong # args: should be "a x"
+    invoked from within
+"a 1 2"}
+test interp-14.8 {testing interp-alias: error messages} -body {
+    proc setx x {return -code error x}
+    interp alias {} a {} setx
+    catch {a 1}
+    set ::errorInfo
+} -cleanup {
+    rename setx {}
+    rename a {}
+} -result {x
+    while executing
+"a 1"}
+test interp-14.9 {testing interp-alias: error messages} -setup {
+    proc setx x {return -code error x}
+    catch {interp delete a}
+    interp create a
+} -body {
+    interp alias a a {} setx
+    catch {a eval a 1}
+    set ::errorInfo
+} -cleanup {
+    rename setx {}
+    interp delete a
+} -result {x
+    invoked from within
+"a 1"
+    invoked from within
+"a eval a 1"}
+test interp-14.10 {testing interp-alias: error messages} -setup {
+    proc setx x {return -code error x}
+    catch {interp delete a}
+    interp create a
+} -body {
+    interp alias a a {} setx
+    a eval {
+	catch {a 1}
+	set ::errorInfo
+    }
+} -cleanup {
+    rename setx {}
+    interp delete a
+} -result {x
+    invoked from within
+"a 1"}
 
 # part 15: testing file sharing
 test interp-15.1 {testing file sharing} {
@@ -584,8 +667,7 @@ test interp-15.8 {testing file transferring} -body {
 # Torture tests for interpreter deletion order
 #
 proc kill {} {interp delete xxx}
-
-test interp-15.9 {testing deletion order} {
+test interp-16.0 {testing deletion order} {
     catch {interp delete xxx}
     interp create xxx
     xxx alias kill kill
@@ -1509,7 +1591,28 @@ test interp-20.49 {interp invokehidden -namespace} -setup {
     interp delete slave
     removeFile script
 } -result ::foo
-
+test interp-20.50 {Bug 2486550} -setup {
+    interp create slave
+} -body {
+    slave hide coroutine
+    slave invokehidden coroutine
+} -cleanup {
+    interp delete slave
+} -returnCodes error -match glob -result *
+test interp-20.50.1 {Bug 2486550} -setup {
+    interp create slave
+} -body {
+    slave hide coroutine
+    catch {slave invokehidden coroutine} m o
+    dict get $o -errorinfo
+} -cleanup {
+    unset -nocomplain m 0
+    interp delete slave
+} -returnCodes ok -result {wrong # args: should be "coroutine name cmd ?arg ...?"
+    while executing
+"coroutine"
+    invoked from within
+"slave invokehidden coroutine"}
 
 test interp-21.1 {interp hidden} {
     interp hidden {}
@@ -1517,67 +1620,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}
@@ -1677,181 +1786,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 [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} {bar clock} {cd encoding exec exit fconfigure file glob load open pwd socket source} {bar clock} {bar cd encoding exec exit fconfigure file glob load open pwd socket source} clock {cd encoding exec exit fconfigure file glob load open pwd socket source}} 
+} -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
-    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
-    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} {
@@ -1862,16 +1951,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} {
@@ -1882,16 +1970,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} {
@@ -1899,20 +1985,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} {
@@ -1920,28 +2003,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}}
-
-unset hidden_cmds
+} -result {1 {1 2 3} 1 {1 2 3}}
 
-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
@@ -1951,7 +2028,6 @@ test interp-26.1 {result code transmission : interp eval direct} {
     # Test that all the possibles error codes from Tcl get passed up
     # from the slave interp's context to the master, even though the
     # slave nominally thinks the command is running at the root level.
-    
     catch {interp delete a}
     interp create a
     set res {}
@@ -1962,8 +2038,6 @@ test interp-26.1 {result code transmission : interp eval direct} {
     interp delete a
     set res
 } {-1 0 1 2 3 4 5}
-
-
 test interp-26.2 {result code transmission : interp eval indirect} {
     # retcode == 2 == return is special
     catch {interp delete a}
@@ -1977,12 +2051,10 @@ test interp-26.2 {result code transmission : interp eval indirect} {
     interp delete a
     set res
 } {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
-
 test interp-26.3 {result code transmission : aliases} {
-    # Test that all the possibles error codes from Tcl get passed up
-    # from the slave interp's context to the master, even though the
-    # slave nominally thinks the command is running at the root level.
-    
+    # Test that all the possibles error codes from Tcl get passed up from the
+    # slave interp's context to the master, even though the slave nominally
+    # thinks the command is running at the root level.
     catch {interp delete a}
     interp create a
     set res {}
@@ -1996,7 +2068,6 @@ test interp-26.3 {result code transmission : aliases} {
     interp delete a
     set res
 } {-1 0 1 2 3 4 5}
-
 test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \
 	{knownBug} {
     # The known bug is that code 2 is returned, not the -code argument
@@ -2010,36 +2081,35 @@ test interp-26.4 {result code transmission: invoke hidden direct--bug 1637} \
     interp delete a
     set res
 } {-1 0 1 2 3 4 5}
-
-test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} \
-	{knownBug} {
-    # The known bug is that the break and continue should raise errors
-    # that they are used outside a loop.
+test interp-26.5 {result code transmission: invoke hidden indirect--bug 1637} -setup {
     catch {interp delete a}
     interp create a
+} -body {
+    # The known bug is that the break and continue should raise errors that
+    # they are used outside a loop.
     set res {}
     interp eval a {proc retcode {code} {return -code $code ret$code}}
     interp hide a retcode
     for {set code -1} {$code<=5} {incr code} {
 	lappend res [catch {interp invokehidden a retcode $code} msg] $msg
     }
+    return $res
+} -cleanup {
     interp delete a
-    set res
-} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
-
-test interp-26.6 {result code transmission: all combined--bug 1637} \
-	{knownBug} {
-    # Test that all the possibles error codes from Tcl get passed
-    # In both directions.  This doesn't work.
-    set interp [interp create];
+} -result {-1 ret-1 0 ret0 1 ret1 2 ret2 3 ret3 4 ret4 5 ret5}
+test interp-26.6 {result code transmission: all combined--bug 1637} -setup {
+    set interp [interp create]
+} -constraints knownBug -body {
+    # Test that all the possibles error codes from Tcl get passed in both
+    # directions.  This doesn't work.
     proc MyTestAlias {interp args} {
-	global aliasTrace;
-	lappend aliasTrace $args;
-	interp invokehidden $interp {expand}$args
+	global aliasTrace
+	lappend aliasTrace $args
+	interp invokehidden $interp {*}$args
     }
     foreach c {return} {
-	interp hide $interp  $c;
-        interp alias $interp $c {} MyTestAlias $interp $c;
+	interp hide $interp  $c
+        interp alias $interp $c {} MyTestAlias $interp $c
     }
     interp eval $interp {proc ret {code} {return -code $code ret$code}}
     set res {}
@@ -2047,231 +2117,247 @@ test interp-26.6 {result code transmission: all combined--bug 1637} \
     for {set code -1} {$code<=5} {incr code} {
 	lappend res [catch {interp eval $interp ret $code} msg] $msg
     }
-    interp delete $interp;
-    set res
-} {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
-
-# Some tests might need to be added to check for difference between
-# toplevel and non toplevel evals.
-
+    return $res
+} -cleanup {
+    interp delete $interp
+} -result {-1 ret-1 0 ret0 1 ret1 0 ret2 3 ret3 4 ret4 5 ret5}
+# Some tests might need to be added to check for difference between toplevel
+# and non-toplevel evals.
 # End of return code transmission section
-
-test interp-26.7 {errorInfo transmission: regular interps} {
-    set interp [interp create];
+test interp-26.7 {errorInfo transmission: regular interps} -setup {
+    set interp [interp create]
+} -body {
     proc MyError {secret} {
 	return -code error "msg"
     }
     proc MyTestAlias {interp args} {
 	MyError "some secret"
     }
-    interp alias $interp test {} MyTestAlias $interp;
-    set res [interp eval $interp {catch test;set errorInfo}]
-    interp delete $interp;
-    set res
-} {msg
+    interp alias $interp test {} MyTestAlias $interp
+    interp eval $interp {catch test;set ::errorInfo}
+} -cleanup {
+    interp delete $interp
+} -result {msg
     while executing
 "MyError "some secret""
     (procedure "MyTestAlias" line 2)
     invoked from within
 "test"}
-
-test interp-26.8 {errorInfo transmission: safe interps--bug 1637} {knownBug} {
-    # this test fails because the errorInfo is fully transmitted
-    # whether the interp is safe or not.  The errorInfo should never
-    # report data from the master interpreter because it could
-    # contain sensitive information.
-    set interp [interp create -safe];
+test interp-26.8 {errorInfo transmission: safe interps--bug 1637} -setup {
+    set interp [interp create -safe]
+} -constraints knownBug -body {
+    # this test fails because the errorInfo is fully transmitted whether the
+    # interp is safe or not.  The errorInfo should never report data from the
+    # master interpreter because it could contain sensitive information.
     proc MyError {secret} {
 	return -code error "msg"
     }
     proc MyTestAlias {interp args} {
 	MyError "some secret"
     }
-    interp alias $interp test {} MyTestAlias $interp;
-    set res [interp eval $interp {catch test;set errorInfo}]
-    interp delete $interp;
-    set res
-} {msg
+    interp alias $interp test {} MyTestAlias $interp
+    interp eval $interp {catch test;set ::errorInfo}
+} -cleanup {
+    interp delete $interp
+} -result {msg
     while executing
 "test"}
 
 # Interps & Namespaces
-test interp-27.1 {interp aliases & namespaces} {
-    set i [interp create];
-    set aliasTrace {};
+test interp-27.1 {interp aliases & namespaces} -setup {
+    set i [interp create]
+} -body {
+    set aliasTrace {}
     proc tstAlias {args} { 
-	global aliasTrace;
-	lappend aliasTrace [list [namespace current] $args];
+	global aliasTrace
+	lappend aliasTrace [list [namespace current] $args]
     }
-    $i alias foo::bar tstAlias foo::bar;
+    $i alias foo::bar tstAlias foo::bar
     $i eval foo::bar test
+    return $aliasTrace
+} -cleanup {
     interp delete $i
-    set aliasTrace;
-} {{:: {foo::bar test}}}
-
-test interp-27.2 {interp aliases & namespaces} {
-    set i [interp create];
-    set aliasTrace {};
+} -result {{:: {foo::bar test}}}
+test interp-27.2 {interp aliases & namespaces} -setup {
+    set i [interp create]
+} -body {
+    set aliasTrace {}
     proc tstAlias {args} { 
-	global aliasTrace;
-	lappend aliasTrace [list [namespace current] $args];
+	global aliasTrace
+	lappend aliasTrace [list [namespace current] $args]
     }
-    $i alias foo::bar tstAlias foo::bar;
+    $i alias foo::bar tstAlias foo::bar
     $i eval namespace eval foo {bar test}
+    return $aliasTrace
+} -cleanup {
     interp delete $i
-    set aliasTrace;
-} {{:: {foo::bar test}}}
-
-test interp-27.3 {interp aliases & namespaces} {
-    set i [interp create];
-    set aliasTrace {};
+} -result {{:: {foo::bar test}}}
+test interp-27.3 {interp aliases & namespaces} -setup {
+    set i [interp create]
+} -body {
+    set aliasTrace {}
     proc tstAlias {args} { 
-	global aliasTrace;
-	lappend aliasTrace [list [namespace current] $args];
+	global aliasTrace
+	lappend aliasTrace [list [namespace current] $args]
     }
     interp eval $i {namespace eval foo {proc bar {} {error "bar called"}}}
-    interp alias $i foo::bar {} tstAlias foo::bar;
+    interp alias $i foo::bar {} tstAlias foo::bar
     interp eval $i {namespace eval foo {bar test}}
+    return $aliasTrace
+} -cleanup {
     interp delete $i
-    set aliasTrace;
-} {{:: {foo::bar test}}}
-
-test interp-27.4 {interp aliases & namespaces} {
-    set i [interp create];
+} -result {{:: {foo::bar test}}}
+test interp-27.4 {interp aliases & namespaces} -setup {
+    set i [interp create]
+} -body {
     namespace eval foo2 {
-	variable aliasTrace {};
+	variable aliasTrace {}
 	proc bar {args} { 
-	    variable aliasTrace;
-	    lappend aliasTrace [list [namespace current] $args];
+	    variable aliasTrace
+	    lappend aliasTrace [list [namespace current] $args]
 	}
     }
-    $i alias foo::bar foo2::bar foo::bar;
+    $i alias foo::bar foo2::bar foo::bar
     $i eval namespace eval foo {bar test}
-    set r $foo2::aliasTrace;
-    namespace delete foo2;
-    set r
-} {{::foo2 {foo::bar test}}}
-
-# the following tests are commented out while we don't support
-# hiding in namespaces
-
-# test interp-27.5 {interp hidden & namespaces} {
-#    set i [interp create];
-#    interp eval $i {
-#        namespace eval foo {
-#	    proc bar {args} {
-#		return "bar called ([namespace current]) ($args)"
-#	    }
-#	}
-#    }
-#    set res [list [interp eval $i {namespace eval foo {bar test1}}]]
-#    interp hide $i foo::bar;
-#    lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg]
-#    interp delete $i;
-#    set res;
-#} {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}}
-
-# test interp-27.6 {interp hidden & aliases & namespaces} {
-#     set i [interp create];
-#     set v root-master;
-#     namespace eval foo {
-# 	variable v foo-master;
-# 	proc bar {interp args} {
-# 	    variable v;
-# 	    list "master bar called ($v) ([namespace current]) ($args)"\
-# 		    [interp invokehidden $interp foo::bar $args];
-# 	}
-#     }
-#     interp eval $i {
-#        namespace eval foo {
-# 	    namespace export *
-# 	    variable v foo-slave;
-# 	    proc bar {args} {
-# 		variable v;
-# 		return "slave bar called ($v) ([namespace current]) ($args)"
-# 	    }
-# 	}
-#     }
-#     set res [list [interp eval $i {namespace eval foo {bar test1}}]]
-#     $i hide foo::bar;
-#     $i alias foo::bar foo::bar $i;
-#     set res [concat $res [interp eval $i {
-# 	set v root-slave;
-#         namespace eval test {
-# 	    variable v foo-test;
-# 	    namespace import ::foo::*;
-# 	    bar test2
-#         }
-#     }]]
-#     namespace delete foo;
-#     interp delete $i;
-#     set res
-# } {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}}
-
-
-# test interp-27.7 {interp hidden & aliases & imports & namespaces} {
-#     set i [interp create];
-#     set v root-master;
-#     namespace eval mfoo {
-# 	variable v foo-master;
-# 	proc bar {interp args} {
-# 	    variable v;
-# 	    list "master bar called ($v) ([namespace current]) ($args)"\
-# 		    [interp invokehidden $interp test::bar $args];
-# 	}
-#     }
-#     interp eval $i {
-#       namespace eval foo {
-# 	    namespace export *
-# 	    variable v foo-slave;
-# 	    proc bar {args} {
-# 		variable v;
-# 		return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
-# 	    }
-# 	}
-# 	set v root-slave;
-#       namespace eval test {
-# 	    variable v foo-test;
-# 	    namespace import ::foo::*;
-#         }
-#     }
-#     set res [list [interp eval $i {namespace eval test {bar test1}}]]
-#     $i hide test::bar;
-#     $i alias test::bar mfoo::bar $i;
-#     set res [concat $res [interp eval $i {test::bar test2}]];
-#     namespace delete mfoo;
-#     interp delete $i;
-#     set res
-# } {{slave bar called (foo-slave) (bar test1) (::tcltest) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
-
-#test interp-27.8 {hiding, namespaces and integrity} {
-#    namespace eval foo {
-#	variable v 3;
-#	proc bar {} {variable v; set v}
-#	# next command would currently generate an unknown command "bar" error.
-#	interp hide {} bar;
-#    }
-#    namespace delete foo;
-#    list [catch {interp invokehidden {} foo} msg] $msg;
-#} {1 {invalid hidden command name "foo"}}
-
-
-test interp-28.1 {getting fooled by slave's namespace ?} {
-    set i [interp create -safe];
+    return $foo2::aliasTrace
+} -cleanup {
+    namespace delete foo2
+    interp delete $i
+} -result {{::foo2 {foo::bar test}}}
+test interp-27.5 {interp hidden & namespaces} -setup {
+    set i [interp create]
+} -constraints knownBug -body {
+    interp eval $i {
+	namespace eval foo {
+	    proc bar {args} {
+		return "bar called ([namespace current]) ($args)"
+	    }
+	}
+    }
+    set res [list [interp eval $i {namespace eval foo {bar test1}}]]
+    interp hide $i foo::bar
+    lappend res [list [catch {interp eval $i {namespace eval foo {bar test2}}} msg] $msg]
+} -cleanup {
+    interp delete $i
+} -result {{bar called (::foo) (test1)} {1 {invalid command name "bar"}}}
+test interp-27.6 {interp hidden & aliases & namespaces} -setup {
+    set i [interp create]
+} -constraints knownBug -body {
+    set v root-master
+    namespace eval foo {
+	variable v foo-master
+	proc bar {interp args} {
+	    variable v
+	    list "master bar called ($v) ([namespace current]) ($args)"\
+		[interp invokehidden $interp foo::bar $args]
+	}
+    }
+    interp eval $i {
+	namespace eval foo {
+	    namespace export *
+	    variable v foo-slave
+	    proc bar {args} {
+		variable v
+		return "slave bar called ($v) ([namespace current]) ($args)"
+	    }
+	}
+    }
+    set res [list [interp eval $i {namespace eval foo {bar test1}}]]
+    $i hide foo::bar
+    $i alias foo::bar foo::bar $i
+    set res [concat $res [interp eval $i {
+	set v root-slave
+	namespace eval test {
+	    variable v foo-test
+	    namespace import ::foo::*
+	    bar test2
+	}
+    }]]
+} -cleanup {
+    namespace delete foo
+    interp delete $i
+} -result {{slave bar called (foo-slave) (::foo) (test1)} {master bar called (foo-master) (::foo) (test2)} {slave bar called (foo-slave) (::foo) (test2)}}
+test interp-27.7 {interp hidden & aliases & imports & namespaces} -setup {
+    set i [interp create]
+} -constraints knownBug -body {
+    set v root-master
+    namespace eval mfoo {
+	variable v foo-master
+	proc bar {interp args} {
+	    variable v
+	    list "master bar called ($v) ([namespace current]) ($args)"\
+		[interp invokehidden $interp test::bar $args]
+	}
+    }
+    interp eval $i {
+	namespace eval foo {
+	    namespace export *
+	    variable v foo-slave
+	    proc bar {args} {
+		variable v
+		return "slave bar called ($v) ([info level 0]) ([uplevel namespace current]) ([namespace current]) ($args)"
+	    }
+	}
+	set v root-slave
+	namespace eval test {
+	    variable v foo-test
+	    namespace import ::foo::*
+	}
+    }
+    set res [list [interp eval $i {namespace eval test {bar test1}}]]
+    $i hide test::bar
+    $i alias test::bar mfoo::bar $i
+    set res [concat $res [interp eval $i {test::bar test2}]]
+} -cleanup {
+    namespace delete mfoo
+    interp delete $i
+} -result {{slave bar called (foo-slave) (bar test1) (::tcltest) (::foo) (test1)} {master bar called (foo-master) (::mfoo) (test2)} {slave bar called (foo-slave) (test::bar test2) (::) (::foo) (test2)}}
+test interp-27.8 {hiding, namespaces and integrity} knownBug {
+    namespace eval foo {
+	variable v 3
+	proc bar {} {variable v; set v}
+	# next command would currently generate an unknown command "bar" error.
+	interp hide {} bar
+    }
+    namespace delete foo
+    list [catch {interp invokehidden {} foo::bar} msg] $msg
+} {1 {invalid hidden command name "foo"}}
+
+test interp-28.1 {getting fooled by slave's namespace ?} -setup {
+    set i [interp create -safe]
     proc master {interp args} {interp hide $interp list}
-    $i alias master master $i;
+} -body {
+    $i alias master master $i
     set r [interp eval $i {
         namespace eval foo {
 	    proc list {args} {
-		return "dummy foo::list";
+		return "dummy foo::list"
 	    }
-	    master;
+	    master
 	}
 	info commands list
     }]
-    interp delete $i;
-    set r
-} {}
+} -cleanup {
+    rename master {}
+    interp delete $i
+} -result {}
+test interp-28.2 {master's nsName cache should not cross} -setup {
+    set i [interp create]
+    $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}}
+} -body {
+    $i eval {
+	set x {namespace children ::}
+	set y [list namespace children ::]
+	namespace delete {*}[filter [{*}$y]]
+	set j [interp create]
+	$j alias filter filter
+	$j eval {namespace delete {*}[filter [namespace children ::]]}
+	namespace eval foo {}
+	list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]]
+    }
+} -cleanup {
+    interp delete $i
+} -result {::foo ::foo {} {}}
 
 # Part 29: recursion limit
 #  29.1.*  Argument checking
@@ -2284,96 +2370,81 @@ test interp-28.1 {getting fooled by slave's namespace ?} {
 test interp-29.1.1 {interp recursionlimit argument checking} {
     list [catch {interp recursionlimit} msg] $msg
 } {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
-
 test interp-29.1.2 {interp recursionlimit argument checking} {
     list [catch {interp recursionlimit foo bar} msg] $msg
 } {1 {could not find interpreter "foo"}}
-
 test interp-29.1.3 {interp recursionlimit argument checking} {
     list [catch {interp recursionlimit foo bar baz} msg] $msg
 } {1 {wrong # args: should be "interp recursionlimit path ?newlimit?"}}
-
 test interp-29.1.4 {interp recursionlimit argument checking} {
     interp create moo
     set result [catch {interp recursionlimit moo bar} msg]
     interp delete moo
     list $result $msg
 } {1 {expected integer but got "bar"}}
-
 test interp-29.1.5 {interp recursionlimit argument checking} {
     interp create moo
     set result [catch {interp recursionlimit moo 0} msg]
     interp delete moo
     list $result $msg
 } {1 {recursion limit must be > 0}}
-
 test interp-29.1.6 {interp recursionlimit argument checking} {
     interp create moo
     set result [catch {interp recursionlimit moo -1} msg]
     interp delete moo
     list $result $msg
 } {1 {recursion limit must be > 0}}
-
 test interp-29.1.7 {interp recursionlimit argument checking} {
     interp create moo
     set result [catch {interp recursionlimit moo [expr {wide(1)<<32}]} msg]
     interp delete moo
     list $result [string range $msg 0 35]
 } {1 {integer value too large to represent}}
-
 test interp-29.1.8 {slave recursionlimit argument checking} {
     interp create moo
     set result [catch {moo recursionlimit foo bar} msg]
     interp delete moo
     list $result $msg
 } {1 {wrong # args: should be "moo recursionlimit ?newlimit?"}}
-
 test interp-29.1.9 {slave recursionlimit argument checking} {
     interp create moo
     set result [catch {moo recursionlimit foo} msg]
     interp delete moo
     list $result $msg
 } {1 {expected integer but got "foo"}}
-
 test interp-29.1.10 {slave recursionlimit argument checking} {
     interp create moo
     set result [catch {moo recursionlimit 0} msg]
     interp delete moo
     list $result $msg
 } {1 {recursion limit must be > 0}}
-
 test interp-29.1.11 {slave recursionlimit argument checking} {
     interp create moo
     set result [catch {moo recursionlimit -1} msg]
     interp delete moo
     list $result $msg
 } {1 {recursion limit must be > 0}}
-
 test interp-29.1.12 {slave recursionlimit argument checking} {
     interp create moo
     set result [catch {moo recursionlimit [expr {wide(1)<<32}]} msg]
     interp delete moo
     list $result [string range $msg 0 35]
 } {1 {integer value too large to represent}}
-
 test interp-29.2.1 {query recursion limit} {
     interp recursionlimit {}
 } 1000
-
 test interp-29.2.2 {query recursion limit} {
     set i [interp create]
     set n [interp recursionlimit $i]
     interp delete $i
     set n
 } 1000
-
 test interp-29.2.3 {query recursion limit} {
     set i [interp create]
     set n [$i recursionlimit]
     interp delete $i
     set n
 } 1000
-
 test interp-29.2.4 {query recursion limit} {
     set i [interp create]
     set r [$i eval {
@@ -2384,7 +2455,6 @@ test interp-29.2.4 {query recursion limit} {
     interp delete $i
     set r
 } {42 42}
-
 test interp-29.2.5 {query recursion limit} {
     set i [interp create]
     set n1 [interp recursionlimit $i 42]
@@ -2392,7 +2462,6 @@ test interp-29.2.5 {query recursion limit} {
     interp delete $i
     list $n1 $n2
 } {42 42}
-
 test interp-29.2.6 {query recursion limit} {
     set i [interp create]
     set n1 [interp recursionlimit $i 42]
@@ -2400,7 +2469,6 @@ test interp-29.2.6 {query recursion limit} {
     interp delete $i
     list $n1 $n2
 } {42 42}
-
 test interp-29.2.7 {query recursion limit} {
     set i [interp create]
     set n1 [$i recursionlimit 42]
@@ -2408,7 +2476,6 @@ test interp-29.2.7 {query recursion limit} {
     interp delete $i
     list $n1 $n2
 } {42 42}
-
 test interp-29.2.8 {query recursion limit} {
     set i [interp create]
     set n1 [$i recursionlimit 42]
@@ -2416,7 +2483,6 @@ test interp-29.2.8 {query recursion limit} {
     interp delete $i
     list $n1 $n2
 } {42 42}
-
 test interp-29.3.1 {recursion limit} {
     set i [interp create]
     set r [interp eval $i {
@@ -2427,8 +2493,7 @@ test interp-29.3.1 {recursion limit} {
     }]
     interp delete $i
     set r
-} {1 {too many nested evaluations (infinite loop?)} 48}
-
+} {1 {too many nested evaluations (infinite loop?)} 49}
 test interp-29.3.2 {recursion limit} {
     set i [interp create]
     interp recursionlimit $i 50
@@ -2439,8 +2504,7 @@ test interp-29.3.2 {recursion limit} {
     }]
    interp delete $i
    set r
-} {1 {too many nested evaluations (infinite loop?)} 48}
-
+} {1 {too many nested evaluations (infinite loop?)} 49}
 test interp-29.3.3 {recursion limit} {
     set i [interp create]
     $i recursionlimit 50
@@ -2451,8 +2515,7 @@ test interp-29.3.3 {recursion limit} {
     }]
    interp delete $i
    set r
-} {1 {too many nested evaluations (infinite loop?)} 48}
-
+} {1 {too many nested evaluations (infinite loop?)} 49}
 test interp-29.3.4 {recursion limit error reporting} {
     interp create slave
     set r1 [slave eval {
@@ -2473,7 +2536,6 @@ test interp-29.3.4 {recursion limit error reporting} {
     interp delete slave
     list $r1 $r2
 } {1 {falling back due to new recursion limit}}
-
 test interp-29.3.5 {recursion limit error reporting} {
     interp create slave
     set r1 [slave eval {
@@ -2494,7 +2556,6 @@ test interp-29.3.5 {recursion limit error reporting} {
     interp delete slave
     list $r1 $r2
 } {1 {falling back due to new recursion limit}}
-
 test interp-29.3.6 {recursion limit error reporting} {
     interp create slave
     set r1 [slave eval {
@@ -2515,8 +2576,11 @@ test interp-29.3.6 {recursion limit error reporting} {
     interp delete slave
     list $r1 $r2
 } {0 ok}
-
-test interp-29.3.7 {recursion limit error reporting} {
+#
+# Note that TEBC does not verify the interp's nesting level itself; the nesting
+# level will only be verified when it invokes a non-bcc'd command.
+#
+test interp-29.3.7a {recursion limit error reporting} {
     interp create slave
     after 0 {interp recursionlimit slave 5}
     set r1 [slave eval {
@@ -2525,8 +2589,51 @@ test interp-29.3.7 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+test interp-29.3.7b {recursion limit error reporting} {
+    interp create slave
+    after 0 {interp recursionlimit slave 5}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+			update
+		        eval {	# 5
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+test interp-29.3.7c {recursion limit error reporting} {
+    interp create slave
+    after 0 {interp recursionlimit slave 5}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+		        eval {	# 5
+			    update
+			    set set set
+			    $set x ok
 			}
 		    }
 		}
@@ -2537,8 +2644,7 @@ test interp-29.3.7 {recursion limit error reporting} {
     interp delete slave
     list $r1 $r2
 } {1 {too many nested evaluations (infinite loop?)}}
-
-test interp-29.3.8 {recursion limit error reporting} {
+test interp-29.3.8a {recursion limit error reporting} {
     interp create slave
     after 0 {interp recursionlimit slave 4}
     set r1 [slave eval {
@@ -2547,8 +2653,29 @@ test interp-29.3.8 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+test interp-29.3.8b {recursion limit error reporting} {
+    interp create slave
+    after 0 {interp recursionlimit slave 4}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+			update
+		        eval {	# 5
+			    set x ok
 			}
 		    }
 		}
@@ -2559,8 +2686,7 @@ test interp-29.3.8 {recursion limit error reporting} {
     interp delete slave
     list $r1 $r2
 } {1 {too many nested evaluations (infinite loop?)}}
-
-test interp-29.3.9 {recursion limit error reporting} {
+test interp-29.3.9a {recursion limit error reporting} {
     interp create slave
     after 0 {interp recursionlimit slave 6}
     set r1 [slave eval {
@@ -2569,8 +2695,8 @@ test interp-29.3.9 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
 			}
 		    }
 		}
@@ -2581,8 +2707,28 @@ test interp-29.3.9 {recursion limit error reporting} {
     interp delete slave
     list $r1 $r2
 } {0 ok}
-
-test interp-29.3.10 {recursion limit error reporting} {
+test interp-29.3.9b {recursion limit error reporting} {
+    interp create slave
+    after 0 {interp recursionlimit slave 6}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+		        eval {	# 5
+			    set set set
+			    $set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+test interp-29.3.10a {recursion limit error reporting} {
     interp create slave
     after 0 {slave recursionlimit 4}
     set r1 [slave eval {
@@ -2602,9 +2748,29 @@ test interp-29.3.10 {recursion limit error reporting} {
     set r2 [slave eval { set msg }]
     interp delete slave
     list $r1 $r2
+} {0 ok}
+test interp-29.3.10b {recursion limit error reporting} {
+    interp create slave
+    after 0 {slave recursionlimit 4}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+			update
+		        eval {	# 5
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
 } {1 {too many nested evaluations (infinite loop?)}}
-
-test interp-29.3.11 {recursion limit error reporting} {
+test interp-29.3.11a {recursion limit error reporting} {
     interp create slave
     after 0 {slave recursionlimit 5}
     set r1 [slave eval {
@@ -2613,8 +2779,30 @@ test interp-29.3.11 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+test interp-29.3.11b {recursion limit error reporting} {
+    interp create slave
+    after 0 {slave recursionlimit 5}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+		        eval {	# 5
+			    update
+			    set set set
+			    $set x ok
 			}
 		    }
 		}
@@ -2625,8 +2813,7 @@ test interp-29.3.11 {recursion limit error reporting} {
     interp delete slave
     list $r1 $r2
 } {1 {too many nested evaluations (infinite loop?)}}
-
-test interp-29.3.12 {recursion limit error reporting} {
+test interp-29.3.12a {recursion limit error reporting} {
     interp create slave
     after 0 {slave recursionlimit 6}
     set r1 [slave eval {
@@ -2635,8 +2822,30 @@ test interp-29.3.12 {recursion limit error reporting} {
 	        eval {		# 3
 		    eval {	# 4
 		        eval {	# 5
-			     update
-			     set x ok
+			    update
+			    set x ok
+			}
+		    }
+		}
+	    }
+	} msg
+    }]
+    set r2 [slave eval { set msg }]
+    interp delete slave
+    list $r1 $r2
+} {0 ok}
+test interp-29.3.12b {recursion limit error reporting} {
+    interp create slave
+    after 0 {slave recursionlimit 6}
+    set r1 [slave eval {
+        catch { 		# nesting level 1
+	    eval {		# 2
+	        eval {		# 3
+		    eval {	# 4
+		        eval {	# 5
+			    update
+			    set set set
+			    $set x ok
 			}
 		    }
 		}
@@ -2647,7 +2856,6 @@ test interp-29.3.12 {recursion limit error reporting} {
     interp delete slave
     list $r1 $r2
 } {0 ok}
-
 test interp-29.4.1 {recursion limit inheritance} {
     set i [interp create]
     set ii [interp eval $i {
@@ -2662,8 +2870,7 @@ test interp-29.4.1 {recursion limit inheritance} {
     }]
    interp delete $i
    set r
-} 49
-
+} 50
 test interp-29.4.2 {recursion limit inheritance} {
     set i [interp create]
     $i recursionlimit 50
@@ -2676,8 +2883,7 @@ test interp-29.4.2 {recursion limit inheritance} {
     }]
    interp delete $i
    set r
-} 49
-
+} 50
 test interp-29.5.1 {does slave recursion limit affect master?} {
     set before [interp recursionlimit {}]
     set i [interp create]
@@ -2687,7 +2893,6 @@ test interp-29.5.1 {does slave recursion limit affect master?} {
     interp delete $i
     list [expr {$before == $after}] $slavelimit
 } {1 20000}
-
 test interp-29.5.2 {does slave recursion limit affect master?} {
     set before [interp recursionlimit {}]
     set i [interp create]
@@ -2697,7 +2902,6 @@ test interp-29.5.2 {does slave recursion limit affect master?} {
     interp delete $i
     list [expr {$before == $after}] $slavelimit
 } {1 20000}
-
 test interp-29.5.3 {does slave recursion limit affect master?} {
     set before [interp recursionlimit {}]
     set i [interp create]
@@ -2707,7 +2911,6 @@ test interp-29.5.3 {does slave recursion limit affect master?} {
     interp delete $i
     list [expr {$before == $after}] $slavelimit
 } {1 20000}
-
 test interp-29.5.4 {does slave recursion limit affect master?} {
     set before [interp recursionlimit {}]
     set i [interp create]
@@ -2717,21 +2920,18 @@ test interp-29.5.4 {does slave recursion limit affect master?} {
     interp delete $i
     list [expr {$before == $after}] $slavelimit
 } {1 20000}
-
 test interp-29.6.1 {safe interpreter recursion limit} {
     interp create slave -safe
     set n [interp recursionlimit slave]
     interp delete slave
     set n
 } 1000
-
 test interp-29.6.2 {safe interpreter recursion limit} {
     interp create slave -safe
     set n [slave recursionlimit]
     interp delete slave
     set n
 } 1000
-
 test interp-29.6.3 {safe interpreter recursion limit} {
     interp create slave -safe
     set n1 [interp recursionlimit slave 42]
@@ -2739,7 +2939,6 @@ test interp-29.6.3 {safe interpreter recursion limit} {
     interp delete slave
     list $n1 $n2
 } {42 42}
-
 test interp-29.6.4 {safe interpreter recursion limit} {
     interp create slave -safe
     set n1 [slave recursionlimit 42]
@@ -2747,7 +2946,6 @@ test interp-29.6.4 {safe interpreter recursion limit} {
     interp delete slave
     list $n1 $n2
 } {42 42}
-
 test interp-29.6.5 {safe interpreter recursion limit} {
     interp create slave -safe
     set n1 [interp recursionlimit slave 42]
@@ -2755,7 +2953,6 @@ test interp-29.6.5 {safe interpreter recursion limit} {
     interp delete slave
     list $n1 $n2
 } {42 42}
-
 test interp-29.6.6 {safe interpreter recursion limit} {
     interp create slave -safe
     set n1 [slave recursionlimit 42]
@@ -2763,7 +2960,6 @@ test interp-29.6.6 {safe interpreter recursion limit} {
     interp delete slave
     list $n1 $n2
 } {42 42}
-
 test interp-29.6.7 {safe interpreter recursion limit} {
     interp create slave -safe
     set n1 [slave recursionlimit 42]
@@ -2771,14 +2967,12 @@ test interp-29.6.7 {safe interpreter recursion limit} {
     interp delete slave
     list $n1 $n2
 } {42 42}
-
 test interp-29.6.8 {safe interpreter recursion limit} {
     interp create slave -safe
     set n [catch {slave eval {interp recursionlimit {} 42}} msg]
     interp delete slave
     list $n $msg
 } {1 {permission denied: safe interpreters cannot change recursion limit}}
-
 test interp-29.6.9 {safe interpreter recursion limit} {
     interp create slave -safe
     set result [
@@ -2793,7 +2987,6 @@ test interp-29.6.9 {safe interpreter recursion limit} {
     interp delete slave
     set result
 } {1 {permission denied: safe interpreters cannot change recursion limit}}
-
 test interp-29.6.10 {safe interpreter recursion limit} {
     interp create slave -safe
     set result [
@@ -2846,13 +3039,12 @@ test interp-31.1 {alias invocation scope} {
 	upvar 1 $varName localVar
 	set localVar $value
     }
-
     interp alias {} myNewSet {} mySet
     proc testMyNewSet {value} {
 	myNewSet a $value
 	return $a
     }
-    catch {unset a}
+    unset -nocomplain a
     set result [testMyNewSet "ok"]
     rename testMyNewSet {}
     rename mySet {}
@@ -2860,8 +3052,9 @@ test interp-31.1 {alias invocation scope} {
     set result
 } ok
 
-test interp-32.1 {parent's working directory should be inherited by a child interp} {
+test interp-32.1 {parent's working directory should be inherited by a child interp} -setup {
     cd [temporaryDirectory]
+} -body {
     set parent [pwd]
     set i [interp create]
     set child [$i eval pwd]
@@ -2874,10 +3067,11 @@ test interp-32.1 {parent's working directory should be inherited by a child inte
     cd ..
     file delete cwd_test
     interp delete $i
-    cd [workingDirectory]
     expr {[string equal $parent $child] ? 1 :
              "\{$parent\} != \{$child\}"}
-} 1
+} -cleanup {
+    cd [workingDirectory]
+} -result 1
 
 test interp-33.1 {refCounting for target words of alias [Bug 730244]} {
     # This test will panic if Bug 730244 is not fixed.
@@ -3113,13 +3307,83 @@ test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
     interp delete $i
     lappend result $msg
 } -result {1 {time limit exceeded}}
+test interp-34.11 {time limit extension in callbacks} -setup {
+    proc cb1 {i t} {
+	global result
+	lappend result cb1
+	$i limit time -seconds $t -command cb2
+    }
+    proc cb2 {} {
+	global result
+	lappend result cb2
+    }
+} -body {
+    set i [interp create]
+    set t0 [clock seconds]
+    $i limit time -seconds [expr {$t0+1}] -granularity 1 \
+	-command "cb1 $i [expr {$t0+2}]"
+    set ::result {}
+    lappend ::result [catch {
+	$i eval {
+	    for {set i 0} {$i<30} {incr i} {
+		after 100
+	    }
+	}
+    } msg] $msg
+    set t1 [clock seconds]
+    lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+    interp delete $i
+    return $::result
+} -result {cb1 cb2 1 {time limit exceeded} ok} -cleanup {
+    rename cb1 {}
+    rename cb2 {}
+}
+test interp-34.12 {time limit extension in callbacks} -setup {
+    proc cb1 {i} {
+	global result times
+	lappend result cb1
+	set times [lassign $times t]
+	$i limit time -seconds $t
+    }
+} -body {
+    set i [interp create]
+    set t0 [clock seconds]
+    set ::times "[expr {$t0+2}] [expr {$t0+100}]"
+    $i limit time -seconds [expr {$t0+1}] -granularity 1 -command "cb1 $i"
+    set ::result {}
+    lappend ::result [catch {
+	$i eval {
+	    for {set i 0} {$i<30} {incr i} {
+		after 100
+	    }
+	}
+    } msg] $msg
+    set t1 [clock seconds]
+    lappend ::result [expr {$t1-$t0>=2 ? "ok" : "$t0,$t1"}]
+    interp delete $i
+    return $::result
+} -result {cb1 cb1 0 {} ok} -cleanup {
+    rename cb1 {}
+}
+test interp-34.13 {time limit granularity and vwait: Bug 2891362} -setup {
+    set i [interp create -safe]
+} -body {
+    $i limit time -seconds [clock add [clock seconds] 1 second]
+    $i eval {
+	after 2000 set x timeout
+	vwait x
+	return $x
+    }
+} -cleanup {
+    interp delete $i
+} -returnCodes error -result {limit exceeded}
 
 test interp-35.1 {interp limit syntax} -body {
     interp limit
-} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"}
+} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"}
 test interp-35.2 {interp limit syntax} -body {
     interp limit {}
-} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?options?"}
+} -returnCodes error -result {wrong # args: should be "interp limit path limitType ?-option value ...?"}
 test interp-35.3 {interp limit syntax} -body {
     interp limit {} foo
 } -returnCodes error -result {bad limit type "foo": must be commands or time}
@@ -3248,6 +3512,13 @@ test interp-35.22 {interp time limits normalize milliseconds} -body {
 } -cleanup {
     interp delete $i
 } -result {2 500}
+# Bug 3398794
+test interp-35.23 {interp command limits can't touch current interp} -body {
+    interp limit {} commands -value 10
+} -returnCodes error -result {limits on current interpreter inaccessible}
+test interp-35.24 {interp time limits can't touch current interp} -body {
+    interp limit {} time -seconds 2
+} -returnCodes error -result {limits on current interpreter inaccessible}
 
 test interp-36.1 {interp bgerror syntax} -body {
     interp bgerror
@@ -3283,10 +3554,94 @@ test interp-36.6 {SlaveBgerror returns handler} -setup {
 } -cleanup {
     interp delete slave
 } -result {foo bar soom}
+test interp-36.7 {SlaveBgerror sets error handler of slave [1999035]} -setup {
+    interp create slave
+    slave alias handler handler
+    slave bgerror handler
+    variable result {untouched}
+    proc handler {args} {
+        variable result
+        set result [lindex $args 0]
+    }
+} -body {
+    slave eval {
+        variable done {}
+        after 0 error foo
+        after 10 [list ::set [namespace which -variable done] {}]
+        vwait [namespace which -variable done]
+    }
+    set result
+} -cleanup {
+    variable result {}
+    unset -nocomplain result
+    interp delete slave
+} -result foo
 
+test interp-37.1 {safe interps and min() and max(): Bug 2895741} -setup {
+    catch {interp delete a}
+    interp create a
+    set result {}
+} -body {
+    interp create {a b} -safe
+    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 -nocomplain result
+    interp delete a
+} -result {26 26}
+
+test interp-38.1 {interp debug one-way switch} -setup {
+    catch {interp delete a}
+    interp create a
+    interp debug a -frame 1
+} -body {
+    # TIP #3xx interp debug frame is a one-way switch
+    interp debug a -frame 0
+} -cleanup {
+    interp delete a
+} -result {1}
+test interp-38.2 {interp debug env var} -setup {
+    catch {interp delete a}
+    set ::env(TCL_INTERP_DEBUG_FRAME) 1
+    interp create a
+} -body {
+    interp debug a
+} -cleanup {
+    unset -nocomplain ::env(TCL_INTERP_DEBUG_FRAME)
+    interp delete a
+} -result {-frame 1}
+test interp-38.3 {interp debug wrong args} -body {
+    interp debug
+} -returnCodes {
+    error
+} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}
+test interp-38.4 {interp debug basic setup} -body {
+    interp debug {}
+} -result {-frame 0}
+test interp-38.5 {interp debug basic setup} -body {
+    interp debug {} -f
+} -result {0}
+test interp-38.6 {interp debug basic setup} -body {
+    interp debug -frames
+} -returnCodes error -result {could not find interpreter "-frames"}
+test interp-38.7 {interp debug basic setup} -body {
+    interp debug {} -frames
+} -returnCodes error -result {bad debug option "-frames": must be -frame}
+test interp-38.8 {interp debug basic setup} -body {
+    interp debug {} -frame 0 bogus
+} -returnCodes {
+    error
+} -result {wrong # args: should be "interp debug path ?-frame ?bool??"}
+
 # cleanup
+unset -nocomplain hidden_cmds
 foreach i [interp slaves] {
     interp delete $i
 }
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/io.test b/tests/io.test
index 9d724b8..edc0b11 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -1,3 +1,4 @@
+# -*- tcl -*-
 # Functionality covered: operation of all IO commands, and all procedures
 # defined in generic/tclIO.c.
 #
@@ -11,31 +12,36 @@
 #
 # 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.68 2005/05/10 18:35:21 kennykb Exp $
 
 if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
     return
 }
-namespace eval ::tcl::test::io {
 
-    namespace import ::tcltest::cleanupTests
-    namespace import ::tcltest::interpreter
-    namespace import ::tcltest::makeFile
-    namespace import ::tcltest::removeFile
-    namespace import ::tcltest::test
-    namespace import ::tcltest::testConstraint
-    namespace import ::tcltest::viewFile
-
-testConstraint testchannel [llength [info commands testchannel]]
-testConstraint exec [llength [info commands exec]]
-testConstraint openpipe 1
-testConstraint fileevent [llength [info commands fileevent]]
-testConstraint fcopy [llength [info commands fcopy]]
-testConstraint testfevent [llength [info commands testfevent]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+namespace eval ::tcl::test::io {
+    namespace import ::tcltest::*
+
+    variable umaskValue
+    variable path
+    variable f
+    variable i
+    variable n
+    variable v
+    variable msg
+    variable expected
+
+testConstraint testchannel      [llength [info commands testchannel]]
+testConstraint exec             [llength [info commands exec]]
+testConstraint openpipe         1
+testConstraint fileevent        [llength [info commands fileevent]]
+testConstraint fcopy            [llength [info commands fcopy]]
+testConstraint testfevent       [llength [info commands testfevent]]
 testConstraint testchannelevent [llength [info commands testchannelevent]]
-testConstraint testmainthread [llength [info commands testmainthread]]
+testConstraint testmainthread   [llength [info commands testmainthread]]
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
 
 # You need a *very* special environment to do some tests.  In
 # particular, many file systems do not support large-files...
@@ -44,7 +50,9 @@ testConstraint largefileSupport 0
 # some tests can only be run is umask is 2
 # if "umask" cannot be run, the tests will be skipped.
 set umaskValue 0
-testConstraint umask [expr {![catch {set umaskValue [exec /bin/sh -c umask]}]}]
+testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}]
+
+testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]
 
 # set up a long data file for some of the following tests
 
@@ -120,6 +128,66 @@ test io-1.8 {Tcl_WriteChars: WriteChars} {
     contents $path(test2)
 } "    \x1b\$B\$O\x1b(B"
 
+test io-1.9 {Tcl_WriteChars: WriteChars} {
+    # When closing a channel with an encoding that appends
+    # escape bytes, check for the case where the escape
+    # bytes overflow the current IO buffer. The bytes
+    # should be moved into a new buffer.
+
+    set data "1234567890 [format %c 12399]"
+
+    set sizes [list]
+
+    # With default buffer size
+    set f [open $path(test2) w]
+    fconfigure      $f -encoding iso2022-jp
+    puts -nonewline $f $data
+    close           $f
+    lappend sizes [file size $path(test2)]
+
+    # With buffer size equal to the length
+    # of the data, the escape bytes would
+    # go into the next buffer.
+
+    set f [open $path(test2) w]
+    fconfigure      $f -encoding iso2022-jp -buffersize 16
+    puts -nonewline $f $data
+    close           $f
+    lappend sizes [file size $path(test2)]
+
+    # With buffer size that is large enough
+    # to hold 1 byte of escaped data, but
+    # not all 3. This should not write
+    # the escape bytes to the first buffer
+    # and then again to the second buffer.
+
+    set f [open $path(test2) w]
+    fconfigure      $f -encoding iso2022-jp -buffersize 17
+    puts -nonewline $f $data
+    close           $f
+    lappend sizes [file size $path(test2)]
+
+    # With buffer size that can hold 2 out of
+    # 3 bytes of escaped data.
+
+    set f [open $path(test2) w]
+    fconfigure      $f -encoding iso2022-jp -buffersize 18
+    puts -nonewline $f $data
+    close           $f
+    lappend sizes [file size $path(test2)]
+
+    # With buffer size that can hold all the
+    # data and escape bytes.
+
+    set f [open $path(test2) w]
+    fconfigure      $f -encoding iso2022-jp -buffersize 19
+    puts -nonewline $f $data
+    close           $f
+    lappend sizes [file size $path(test2)]
+
+    set sizes
+} {19 19 19 19 19}
+
 test io-2.1 {WriteBytes} {
     # loop until all bytes are written
     
@@ -1604,8 +1672,8 @@ test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
 out
 } {err
 }}
-# This test relies on the fact that the smallest available fd is used first.
-test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unix} {
+# This test relies on the fact that stdout is used before stderr
+test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} {
     set f [open $path(test1) w]
     puts -nonewline $f { close stdin
 	close stdout
@@ -1630,8 +1698,8 @@ test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unix} {
     close $f2
     set result
 } {{ close stdin
-file1
-} {file2
+stdout
+} {stderr
 }}
 catch {interp delete z}
 test io-14.5 {Tcl_GetChannel: stdio name translation} {
@@ -2022,6 +2090,8 @@ set path(pipe)   [makeFile {} pipe]
 set path(output) [makeFile {} output]
 test io-27.6 {FlushChannel, async flushing, async close} \
 	{stdio asyncPipeClose openpipe} {
+    # This test may fail on old Unix systems (seen on IRIX64 6.5) with
+    # obsolete gettimeofday() calls.  See Tcl Bugs 3530533, 1942197.
     file delete $path(pipe)
     file delete $path(output)
     set f [open $path(pipe) w]
@@ -2141,7 +2211,7 @@ test io-28.4 {Tcl_Close} {testchannel} {
     close $f
     lappend l [lsort [testchannel open]]
     set x [list $consoleFileNames \
-		[lsort [list {expand}$consoleFileNames $f]] \
+		[lsort [list {*}$consoleFileNames $f]] \
 		$consoleFileNames]
     string compare $l $x
 } 0
@@ -2156,7 +2226,7 @@ test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel openpipe} {
     set f [open "|[list [interpreter] $path(script)]" r]
     set l [gets $f]
     close $f
-    set l
+    lsort $l
 } {file1 file2}
 
 test io-29.1 {Tcl_WriteChars, channel not writable} {
@@ -2542,11 +2612,11 @@ test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} {
     # you disable the debugger's signal interception.
     #
     if {[catch {flush $f} msg]} {
-	set x [list 1 $msg $errorCode]
+	set x [list 1 $msg $::errorCode]
 	catch {close $f}
     } else {
 	if {[catch {close $f} msg]} {
-	    set x [list 1 $msg $errorCode]
+	    set x [list 1 $msg $::errorCode]
 	} else {
 	    set x {this was supposed to fail and did not}
 	}
@@ -2581,6 +2651,8 @@ test io-29.30 {Tcl_WriteChars, crlf mode} {
     file size $path(test1)
 } 25
 test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
+    # This test may fail on old Unix systems (seen on IRIX64 6.5) with
+    # obsolete gettimeofday() calls.  See Tcl Bugs 3530533, 1942197.
     file delete $path(pipe)
     file delete $path(output)
     set f [open $path(pipe) w]
@@ -2622,6 +2694,8 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
 } ok
 test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
 	{stdio asyncPipeClose openpipe} {
+    # This test may fail on old Unix systems (seen on IRIX64 6.5) with
+    # obsolete gettimeofday() calls.  See Tcl Bugs 3530533, 1942197.
     file delete $path(pipe)
     file delete $path(output)
     set f [open $path(pipe) w]
@@ -2672,6 +2746,26 @@ test io-29.33 {Tcl_Flush, implicit flush on exit} {exec} {
     close $f
     set r
 } "hello\nbye\nstrange\n"
+set path(script2) [makeFile {} script2]
+test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} {
+    set f [open $path(script) w]
+    puts $f {
+		fconfigure stdout -blocking 0
+		puts -nonewline stdout [string repeat A 655360]
+		flush stdout
+	}
+    close $f
+    set f [open $path(script2) w]
+    puts $f {after 2000}
+    close $f
+	set t1 [clock milliseconds]
+	set ff [open "|[list [interpreter] $path(script2)]" w]
+	catch {unset ::env(TCL_FLUSH_NONBLOCKING_ON_EXIT)}
+	exec [interpreter] $path(script) >@ $ff
+	set t2 [clock milliseconds]
+	close $ff
+	expr {($t2-$t1)/2000 ? $t2-$t1 : 0}
+} 0
 test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} {
     variable c 0
     variable x running
@@ -2691,7 +2785,7 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
 	variable c
 	variable x
 	set l [gets $s]
-	
+
 	if {[eof $s]} {
 	    close $s
 	    set x done
@@ -2699,8 +2793,8 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
 	    incr c
 	}
     }
-    set ss [socket -server [namespace code accept] 0]
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set cs [socket 127.0.0.1 [lindex [fconfigure $ss -sockname] 2]]
     vwait [namespace which -variable x]
     fconfigure $cs -blocking off
     writelots $cs $l
@@ -2710,19 +2804,19 @@ test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMa
     set c
 } 2000
 test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac fileevent} {
-    # On Mac, this test screws up sockets such that subsequent tests using port 2828 
+    # On Mac, this test screws up sockets such that subsequent tests using port 2828
     # either cause errors or panic().
-     
+
     catch {interp delete x}
     catch {interp delete y}
     interp create x
     interp create y
-    set s [socket -server [namespace code accept] 0]
+    set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     proc accept {s a p} {
 	puts $s hello
 	close $s
     }
-    set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
+    set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
     interp share {} $c x
     interp share {} $c y
     close $c
@@ -3792,7 +3886,7 @@ test io-32.3 {Tcl_Read, negative byte count} {
     set l [list [catch {read $f -1} msg] $msg]
     close $f
     set l
-} {1 {bad argument "-1": should be "nonewline"}}
+} {1 {expected non-negative integer but got "-1"}}
 test io-32.4 {Tcl_Read, positive byte count} {
     set f [open $path(longfile) r]
     set x [read $f 1024]
@@ -4286,7 +4380,7 @@ test io-34.15 {Tcl_Tell combined with seeking} {
     close $f1
     list $c1 $c2
 } {10 20}
-test io-34.16 {Tcl_tell on pipe: always -1} {stdio openpipe} {
+test io-34.16 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
     set f1 [open "|[list [interpreter]]" r+]
     set c [tell $f1]
     close $f1
@@ -4631,6 +4725,77 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
     close $f
     list $c $l $e
 } {21 8 1}
+test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr
+    puts $f abc\ndef
+    close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $s $l $e [scan [string index $in end] %c]
+} -result {8 8 1 13}
+test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr -eofchar \x1a
+    puts $f abc\ndef
+    close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $s $l $e [scan [string index $in end] %c]
+} -result {9 8 1 13}
+test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -constraints knownBug -body {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr -eofchar \x1a
+    puts $f {}
+    close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $s $l $e [scan [string index $in end] %c]
+} -result {2 1 1 13}
+test io-35.18c {Tcl_Eof, eof char, cr write, crlf read} -body {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr
+    puts $f {}
+    close $f
+    set s [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $s $l $e [scan [string index $in end] %c]
+} -result {1 1 1 13}
+test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body {
+    file delete $path(test1)
+    set f [open $path(test1) w]
+    fconfigure $f -translation cr -eofchar {}
+    set i [format abc\ndef\n%cqrs\nuvw 26]
+    puts $f $i
+    close $f
+    set c [file size $path(test1)]
+    set f [open $path(test1) r]
+    fconfigure $f -translation crlf -eofchar \x1a
+    set l [string length [set in [read $f]]]
+    set e [eof $f]
+    close $f
+    list $c $l $e [scan [string index $in end] %c]
+} -result {17 8 1 13}
 
 # Test Tcl_InputBlocked
 
@@ -4792,7 +4957,7 @@ test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
     lappend l [fconfigure $f -buffersize]
     close $f
     set l
-} {4096 10000 1 1 1 100000 100000}
+} {4096 10000 1 1 1 100000 1048576}
 test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
     # This test crashes the interp if Bug #427196 is not fixed
 
@@ -4953,22 +5118,22 @@ test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
     close $f1
     set x
 } {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
-test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
+test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size clipped to lower bound} {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -buffersize -10
     set x [fconfigure $f -buffersize]
     close $f
     set x
-} 4096
-test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
+} 1
+test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size clipped to upper bound} {
     file delete $path(test1)
     set f [open $path(test1) w]
     fconfigure $f -buffersize 10000000
     set x [fconfigure $f -buffersize]
     close $f
     set x
-} 4096
+} 1048576
 test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
     file delete $path(test1)
     set f [open $path(test1) w]
@@ -5033,7 +5198,7 @@ test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA}
 test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
 	{socket} {
     proc accept {s a p} {close $s}
-    set s1 [socket -server [namespace code accept] 0]
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $s1 -sockname] 2]
     set s2 [socket 127.0.0.1 $port]
     update
@@ -5046,7 +5211,7 @@ test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
 test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
 	{socket} {
     proc accept {s a p} {close $s}
-    set s1 [socket -server [namespace code accept] 0]
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $s1 -sockname] 2]
     set s2 [socket 127.0.0.1 $port]
     update
@@ -5059,7 +5224,7 @@ test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
 test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
 	{socket} {
     proc accept {s a p} {close $s}
-    set s1 [socket -server [namespace code accept] 0]
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $s1 -sockname] 2]
     set s2 [socket 127.0.0.1 $port]
     update
@@ -5072,7 +5237,7 @@ test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
 test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
 	{socket} {
     proc accept {s a p} {close $s}
-    set s1 [socket -server [namespace code accept] 0]
+    set s1 [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set port [lindex [fconfigure $s1 -sockname] 2]
     set s2 [socket 127.0.0.1 $port]
     update
@@ -5109,7 +5274,7 @@ test io-39.22a {Tcl_SetChannelOption, invariance} {
 test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
         writeable, it should still have valid -eofchar and -translation options } {
     set l [list]
-    set sock [socket -server [namespace code accept] 0]
+    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
     close $sock
     set l
@@ -5117,7 +5282,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
 test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
         writable so we can't change -eofchar or -translation } {
     set l [list]
-    set sock [socket -server [namespace code accept] 0]
+    set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     fconfigure $sock -eofchar D -translation lf
     lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
     close $sock
@@ -5141,24 +5306,24 @@ test io-40.1 {POSIX open access modes: RDWR} {
 } {zzy abzzy}
 test io-40.2 {POSIX open access modes: CREAT} {unix} {
     file delete $path(test3)
-    set f [open $path(test3) {WRONLY CREAT} 0600]
+    set f [open $path(test3) {WRONLY CREAT} 0o600]
     file stat $path(test3) stats
-    set x [format "0%o" [expr $stats(mode)&0777]]
+    set x [format "0o%o" [expr $stats(mode)&0o777]]
     puts $f "line 1"
     close $f
     set f [open $path(test3) r]
     lappend x [gets $f]
     close $f
     set x
-} {0600 {line 1}}
+} {0o600 {line 1}}
 test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
     # This test only works if your umask is 2, like ouster's.
     file delete $path(test3)
     set f [open $path(test3) {WRONLY CREAT}]
     close $f
     file stat $path(test3) stats
-    format "0%o" [expr $stats(mode)&0777]
-} [format %04o [expr {0666 & ~ $umaskValue}]]
+    format "0%o" [expr $stats(mode)&0o777]
+} [format %04o [expr {0o666 & ~ $umaskValue}]]
 test io-40.4 {POSIX open access modes: CREAT} {
     file delete $path(test3)
     set f [open $path(test3) w]
@@ -5278,19 +5443,18 @@ test io-40.15 {POSIX open access modes: RDWR} {
     close $f
     lappend x [viewFile test3]
 } {zzy abzzy}
-testConstraint makeFileInHome [expr {![file exists ~/_test_] && [file writable ~]}]
 test io-40.16 {tilde substitution in open} -constraints makeFileInHome -setup {
     makeFile {Some text} _test_ ~
 } -body {
-    file exists [file join $env(HOME) _test_]
+    file exists [file join $::env(HOME) _test_]
 } -cleanup {
     removeFile _test_ ~
 } -result 1
 test io-40.17 {tilde substitution in open} {
-    set home $env(HOME)
-    unset env(HOME)
+    set home $::env(HOME)
+    unset ::env(HOME)
     set x [list [catch {open ~/foo} msg] $msg]
-    set env(HOME) $home
+    set ::env(HOME) $home
     set x
 } {1 {couldn't find HOME environment variable to expand path}}
 
@@ -5343,13 +5507,6 @@ test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent
     lappend result [fileevent $f readable]
 } {13 11 12 {}}
 
-#
-# Test fileevent on a pipe
-#
-if {[testConstraint openpipe]} {
-    catch {set f2 [open "|[list cat -u]" r+]}
-    catch {set f3 [open "|[list cat -u]" r+]}
-}
 
 test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} {
     set result {}
@@ -5362,7 +5519,10 @@ test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs f
     fileevent $f writable {}
     lappend result [fileevent $f readable] [fileevent $f writable]
 } {{script 1} {} {script 1} {write script} {} {write script} {} {}}
-test io-43.2 {Tcl_FileeventCmd: deleting when many present} {stdio unixExecs fileevent} {
+test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
     set result {}
     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
     fileevent $f r "read f"
@@ -5375,9 +5535,15 @@ test io-43.2 {Tcl_FileeventCmd: deleting when many present} {stdio unixExecs fil
     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
     fileevent $f r {}
     lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
-} {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
-
-test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs fileevent} {
+} -cleanup {
+    catch {close $f2}
+    catch {close $f3}
+} -result {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
+
+test io-44.1 {FileEventProc procedure: normal read event} -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
     fileevent $f2 readable [namespace code {
 	set x [gets $f2]; fileevent $f2 readable {}
     }]
@@ -5385,10 +5551,15 @@ test io-44.1 {FileEventProc procedure: normal read event} {stdio unixExecs filee
     variable x initial
     vwait [namespace which -variable x]
     set x
-} {text}
+} -cleanup {
+    catch {close $f2}
+    catch {close $f3}
+} -result {text}
 test io-44.2 {FileEventProc procedure: error in read event} -constraints {
-    stdio unixExecs fileevent
+    stdio unixExecs fileevent openpipe
 } -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
     proc myHandler {msg options} {
 	variable x $msg
     }
@@ -5402,8 +5573,13 @@ test io-44.2 {FileEventProc procedure: error in read event} -constraints {
     list $x [fileevent $f2 readable]
 } -cleanup {
     interp bgerror {} $handler
+    catch {close $f2}
+    catch {close $f3}
 } -result {bogus {}}
-test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs fileevent} {
+test io-44.3 {FileEventProc procedure: normal write event} -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
+} -constraints {stdio unixExecs fileevent openpipe} -body {
     fileevent $f2 writable [namespace code {
 	lappend x "triggered"
 	incr count -1
@@ -5417,10 +5593,15 @@ test io-44.3 {FileEventProc procedure: normal write event} {stdio unixExecs file
     vwait [namespace which -variable x]
     vwait [namespace which -variable x]
     set x
-} {initial triggered triggered triggered}
+} -cleanup {
+    catch {close $f2}
+    catch {close $f3}
+} -result {initial triggered triggered triggered}
 test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
-    stdio unixExecs fileevent
+    stdio unixExecs fileevent openpipe
 } -setup {
+    set f2 [open "|[list cat -u]" r+]
+    set f3 [open "|[list cat -u]" r+]
     proc myHandler {msg options} {
 	variable x $msg
     }
@@ -5433,6 +5614,8 @@ test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
     list $x [fileevent $f2 writable]
 } -cleanup {
     interp bgerror {} $handler
+    catch {close $f2}
+    catch {close $f3}
 } -result {bad-write {}}
 test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
     set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
@@ -5451,8 +5634,6 @@ test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fi
     set x
 } {initial foo eof}
 
-catch {close $f2}
-catch {close $f3}
 close $f
 makeFile "foo bar" foo
 
@@ -6378,27 +6559,29 @@ test io-51.1 {Test old socket deletion on Macintosh} {socket} {
 	close $s
 	set wait done
     }
-    set ss [socket -server [namespace code accept] 0]
+    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
+    set port [lindex [fconfigure $ss -sockname] 2]
+
     variable wait ""
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set cs [socket 127.0.0.1 $port]
     vwait [namespace which -variable wait]
     lappend result [gets $cs]
     close $cs
 
     set wait ""
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set cs [socket 127.0.0.1 $port]
     vwait [namespace which -variable wait]
     lappend result [gets $cs]
     close $cs
 
     set wait ""
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set cs [socket 127.0.0.1 $port]
     vwait [namespace which -variable wait]
     lappend result [gets $cs]
     close $cs
 
     set wait ""
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set cs [socket 127.0.0.1 $port]
     vwait [namespace which -variable wait]
     lappend result [gets $cs]
     close $cs
@@ -6457,13 +6640,47 @@ test io-52.4 {TclCopyChannel} {fcopy} {
     close $f2
     lappend result [file size $path(test1)]
 } {0 0 40}
-test io-52.5 {TclCopyChannel} {fcopy} {
+test io-52.5 {TclCopyChannel, all} {fcopy} {
+    file delete $path(test1)
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    fconfigure $f1 -translation lf -blocking 0
+    fconfigure $f2 -translation lf -blocking 0
+    fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    close $f1
+    close $f2
+    set s1 [file size $thisScript]
+    set s2 [file size $path(test1)]
+    if {"$s1" == "$s2"} {
+        lappend result ok
+    }
+    set result
+} {0 0 ok}
+test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} {
+    file delete $path(test1)
+    set f1 [open $thisScript]
+    set f2 [open $path(test1) w]
+    fconfigure $f1 -translation lf -blocking 0
+    fconfigure $f2 -translation lf -blocking 0
+    fcopy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
+    set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
+    close $f1
+    close $f2
+    set s1 [file size $thisScript]
+    set s2 [file size $path(test1)]
+    if {"$s1" == "$s2"} {
+        lappend result ok
+    }
+    set result
+} {0 0 ok}
+test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} {
     file delete $path(test1)
     set f1 [open $thisScript]
     set f2 [open $path(test1) w]
     fconfigure $f1 -translation lf -blocking 0
     fconfigure $f2 -translation lf -blocking 0
-    fcopy $f1 $f2 -size -1
+    fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
     set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
     close $f1
     close $f2
@@ -6722,7 +6939,7 @@ proc FcopyTestDone {bytes {error {}}} {
 }
 test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
     variable fcopyTestDone
-    set listen [socket -server [namespace code FcopyTestAccept] 0]
+    set listen [socket -server [namespace code FcopyTestAccept] -myaddr 127.0.0.1 0]
     set in [open $thisScript]	;# 126 K
     set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
     catch {unset fcopyTestDone}
@@ -6803,6 +7020,280 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} {
     # -1=error 0=script error N=number of bytes
     expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
 } {3450}
+test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
+    # copy progress callback. errors out intentionally
+    proc ::cmd args {
+	lappend ::RES "CMD $args"
+	error !STOP
+    }
+    # capture callback error here
+    proc ::bgerror args {
+	lappend ::RES "bgerror/OK $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 {
+    # Record input size, so that result is always defined
+    lappend ::RES [file size $bar]
+    # Run the copy. Should not invoke -command now.
+    fcopy $f $g -size 2 -command ::cmd
+    # Check that -command was not called synchronously
+    set sbs [file size $bar]
+    lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs
+    # Now let the async part happen. Should capture the error in cmd
+    # via bgerror. If not break the event loop via timer.
+    set token [after 1000 {
+	lappend ::RES {bgerror/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 {}
+    rename ::bgerror {}
+    removeFile foo
+    removeFile bar
+} -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}}
+test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -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 {
+    # Initialize and force eof on the input.
+    seek $f 0 end ; read $f 1
+    set ::RES [eof $f]
+    # Run the copy. Should not invoke -command now.
+    fcopy $f $g -size 2 -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 {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]
+    set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
+    fconfigure $pipe -translation binary -buffering line
+    puts $pipe {
+	fconfigure stdout -translation binary -buffering line
+	puts stderr Waiting...
+	after 1000
+	foreach x {a b c} {
+	    puts stderr Looping...
+	    puts $x
+	    after 500
+	}
+	proc bye args {
+	    if {[gets stdin line]<0} {
+		puts stderr "CHILD: EOF detected, exiting"
+		exit
+	    } else {
+		puts stderr "CHILD: ignoring line: $line"
+	    }
+	}
+	puts stderr Now-sleeping-forever
+	fileevent stdin readable bye
+	vwait forever
+    }
+    proc ::done args {
+	set ::forever OK
+	return
+    }
+    set ::forever {}
+    set out [open $out w]
+} -constraints {stdio openpipe fcopy} -body {
+    fcopy $pipe $out -size 6 -command ::done
+    set token [after 5000 {
+	set ::forever {fcopy hangs}
+    }]
+    vwait ::forever
+    catch {after cancel $token}
+    set ::forever
+} -cleanup {
+    close $pipe
+    rename ::done {}
+    after 1000;			# Give Windows time to kill the process
+    catch {close $out}
+    catch {removeFile out}
+    catch {removeFile err}
+    catch {unset ::forever}
+} -result OK
+test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
+    set err [makeFile {} err]
+    set pipe [open "|[list [info nameofexecutable] 2> $err]" r+]
+    fconfigure $pipe -translation binary -buffering line
+    puts $pipe {
+	fconfigure stderr -buffering line
+	# Kill server when pipe closed by invoker.
+	proc bye args {
+	    if {![eof stdin]} { gets stdin ; return }
+	    puts stderr BYE
+	    exit
+	}
+	# Server code. Bi-directional copy between 2 sockets.
+	proc geof {sok} {
+	    puts stderr DONE/$sok
+	    close $sok
+	}
+	proc new {sok args} {
+	    puts stderr NEW/$sok
+	    global l srv
+	    fconfigure $sok -translation binary -buffering none
+	    lappend l $sok
+	    if {[llength $l]==2} {
+		close $srv
+		foreach {a b} $l break
+		fcopy $a $b -command [list geof $a]
+		fcopy $b $a -command [list geof $b]
+		puts stderr 2COPY
+	    }
+	    puts stderr ...
+	}
+	puts stderr SRV
+	set l {}
+	set srv [socket -server new 9999]
+	puts stderr WAITING
+	fileevent stdin readable bye
+	puts OK
+	vwait forever
+    }
+    # wait for OK from server.
+    gets $pipe
+    # Now the two clients.
+    proc ::done {sock} {
+	if {[eof $sock]} { close $sock ; return }
+	lappend ::forever [gets $sock]
+	return
+    }
+    set a [socket 127.0.0.1 9999]
+    set b [socket 127.0.0.1 9999]
+    fconfigure $a -translation binary -buffering none
+    fconfigure $b -translation binary -buffering none
+    fileevent  $a readable [list ::done $a]
+    fileevent  $b readable [list ::done $b]
+} -constraints {stdio openpipe fcopy} -body {
+    # Now pass data through the server in both directions.
+    set ::forever {}
+    puts $a AB
+    vwait ::forever
+    puts $b BA
+    vwait ::forever
+    set ::forever
+} -cleanup {
+    catch {close $a}
+    catch {close $b}
+    close $pipe
+    rename ::done {}
+    after 1000 ;# Give Windows time to kill the process
+    removeFile err
+    catch {unset ::forever}
+} -result {AB BA}
+test io-53.11 {Bug 2895565} -setup {
+    set in [makeFile {} in]
+    set f [open $in w]
+    fconfigure $f -encoding utf-8 -translation binary
+    puts -nonewline $f [string repeat "Ho hum\n" 11]
+    close $f
+    set inChan [open $in r]
+    fconfigure $inChan -translation binary
+    set out [makeFile {} out]
+    set outChan [open $out w]
+    fconfigure $outChan -encoding cp1252 -translation crlf
+    proc CopyDone {bytes args} {
+	variable done
+	if {[llength $args]} {
+	    set done "Error: '[lindex $args 0]' after $bytes bytes copied"
+	} else {
+	    set done "$bytes bytes copied"
+	}
+    }
+} -body {
+    variable done
+    after 2000 [list set [namespace which -variable done] timeout]
+    fcopy $inChan $outChan -size 40 -command [namespace which CopyDone]
+    vwait [namespace which -variable done]
+    set done
+} -cleanup {
+    close $outChan
+    close $inChan
+    removeFile out
+    removeFile in
+} -result {40 bytes copied}
 
 test io-54.1 {Recursive channel events} {socket fileevent} {
     # This test checks to see if file events are delivered during recursive
@@ -6825,14 +7316,14 @@ test io-54.1 {Recursive channel events} {socket fileevent} {
 	}
 	incr x
     }
-    set ss [socket -server [namespace code accept] 0]
+    set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
 
     # We need to delay on some systems until the creation of the
     # server socket completes.
 
     set done 0
     for {set i 0} {$i < 10} {incr i} {
-	if {![catch {set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]}]} {
+	if {![catch {set cs [socket 127.0.0.1 [lindex [fconfigure $ss -sockname] 2]]}]} {
 	    set done 1
 	    break
 	}
@@ -6861,7 +7352,7 @@ test io-54.1 {Recursive channel events} {socket fileevent} {
 test io-54.2 {Testing for busy-wait in recursive channel events} {socket fileevent} {
     set accept {}
     set after {}
-    variable s [socket -server [namespace code accept] 0]
+    variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     proc accept {s a p} {
 	variable counter
 	variable accept
@@ -6971,7 +7462,7 @@ test io-57.1 {buffered data and file events, gets} {fileevent} {
 	variable s2
 	set s2 $sock
     }
-    set server [socket -server [namespace code accept] 0]
+    set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
     variable s2
     vwait [namespace which -variable s2]
@@ -6994,7 +7485,7 @@ test io-57.2 {buffered data and file events, read} {fileevent} {
 	variable s2
 	set s2 $sock
     }
-    set server [socket -server [namespace code accept] 0]
+    set server [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
     variable s2
     vwait [namespace which -variable s2]
@@ -7045,7 +7536,7 @@ test io-59.1 {Thread reference of channels} {testmainthread testchannel} {
     # More complicated tests (like that the reference changes as a
     # channel is moved from thread to thread) can be done only in the
     # extension which fully implements the moving of channels between
-    # threads, i.e. 'Threads'. Or we have to extend [testthread] as well.
+    # threads, i.e. 'Threads'.
 
     set f [open $path(longfile) r]
     set result [testchannel mthread $f]
@@ -7111,9 +7602,268 @@ test io-61.1 {Reset eof state after changing the eof char} -setup {
     removeFile eofchar
 } -result {77 = 23431}
 
+
+# Test the cutting and splicing of channels, this is incidentially the
+# attach/detach facility of package Thread, but __without any
+# safeguards__. It can also be used to emulate transfer of channels
+# between threads, and is used for that here.
+
+test io-70.0 {Cutting & Splicing channels} {testchannel} {
+    set f [makeFile {... dummy ...} cutsplice]
+    set c [open $f r]
+
+    set     res {}
+    lappend res [catch {seek $c 0 start}]
+    testchannel cut $c
+
+    lappend res [catch {seek $c 0 start}]
+    testchannel splice $c
+
+    lappend res [catch {seek $c 0 start}]
+    close $c
+
+    removeFile cutsplice
+
+    set res
+} {0 1 0}
+
+
+test io-70.1 {Transfer channel} {testchannel thread} {
+    set f [makeFile {... dummy ...} cutsplice]
+    set c [open $f r]
+
+    set     res {}
+    lappend res [catch {seek $c 0 start}]
+    testchannel cut $c
+    lappend res [catch {seek $c 0 start}]
+
+    set tid [thread::create -preserved]
+    thread::send $tid [list set c $c]
+    thread::send $tid {load {} Tcltest}
+    lappend res [thread::send $tid {
+	testchannel splice $c
+	set res [catch {seek $c 0 start}]
+	close $c
+	set res
+    }]
+
+    thread::release $tid
+    removeFile cutsplice
+
+    set res
+} {0 1 0}
+
+# ### ### ### ######### ######### #########
+
+foreach {n msg expected} {
+     0 {}                                 {}
+     1 {{message only}}                   {{message only}}
+     2 {-options x}                       {-options x}
+     3 {-options {x y} {the message}}     {-options {x y} {the message}}
+
+     4 {-code 1     -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     5 {-code 0     -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     6 {-code 1     -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     7 {-code 0     -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+     8 {-code error -level 0 -f ba snarf} {-code error -level 0 -f ba snarf}
+     9 {-code ok    -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    10 {-code error -level 5 -f ba snarf} {-code error -level 0 -f ba snarf}
+    11 {-code ok    -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    12 {-code boss  -level 0 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    13 {-code boss  -level 5 -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    14 {-code 1     -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    15 {-code 0     -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    16 {-code 1     -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    17 {-code 0     -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    18 {-code error -level 0 -f ba}       {-code error -level 0 -f ba}
+    19 {-code ok    -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    20 {-code error -level 5 -f ba}       {-code error -level 0 -f ba}
+    21 {-code ok    -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    22 {-code boss  -level 0 -f ba}       {-code 1     -level 0 -f ba}
+    23 {-code boss  -level 5 -f ba}       {-code 1     -level 0 -f ba}
+    24 {-code 1     -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    25 {-code 0     -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    26 {-code error -level X -f ba snarf} {-code error -level 0 -f ba snarf}
+    27 {-code ok    -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    28 {-code boss  -level X -f ba snarf} {-code 1     -level 0 -f ba snarf}
+    29 {-code 1     -level X -f ba}       {-code 1     -level 0 -f ba}
+    30 {-code 0     -level X -f ba}       {-code 1     -level 0 -f ba}
+    31 {-code error -level X -f ba}       {-code error -level 0 -f ba}
+    32 {-code ok    -level X -f ba}       {-code 1     -level 0 -f ba}
+    33 {-code boss  -level X -f ba}       {-code 1     -level 0 -f ba}
+
+    34 {-code 1 -code 1     -level 0 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    35 {-code 1 -code 0     -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    36 {-code 1 -code 1     -level 5 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    37 {-code 1 -code 0     -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    38 {-code 1 -code error -level 0 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+    39 {-code 1 -code ok    -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    40 {-code 1 -code error -level 5 -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+    41 {-code 1 -code ok    -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    42 {-code 1 -code boss  -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    43 {-code 1 -code boss  -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    44 {-code 1 -code 1     -level 0 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    45 {-code 1 -code 0     -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    46 {-code 1 -code 1     -level 5 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    47 {-code 1 -code 0     -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    48 {-code 1 -code error -level 0 -f ba}       {-code 1 -code error -level 0 -f ba}
+    49 {-code 1 -code ok    -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    50 {-code 1 -code error -level 5 -f ba}       {-code 1 -code error -level 0 -f ba}
+    51 {-code 1 -code ok    -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    52 {-code 1 -code boss  -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    53 {-code 1 -code boss  -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    54 {-code 1 -code 1     -level X -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    55 {-code 1 -code 0     -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    56 {-code 1 -code error -level X -f ba snarf} {-code 1 -code error -level 0 -f ba snarf}
+    57 {-code 1 -code ok    -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    58 {-code 1 -code boss  -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    59 {-code 1 -code 1     -level X -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    60 {-code 1 -code 0     -level X -f ba}       {-code 1             -level 0 -f ba}
+    61 {-code 1 -code error -level X -f ba}       {-code 1 -code error -level 0 -f ba}
+    62 {-code 1 -code ok    -level X -f ba}       {-code 1             -level 0 -f ba}
+    63 {-code 1 -code boss  -level X -f ba}       {-code 1             -level 0 -f ba}
+
+    64 {-code 0 -code 1     -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    65 {-code 0 -code 0     -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    66 {-code 0 -code 1     -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    67 {-code 0 -code 0     -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    68 {-code 0 -code error -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    69 {-code 0 -code ok    -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    70 {-code 0 -code error -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    71 {-code 0 -code ok    -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    72 {-code 0 -code boss  -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    73 {-code 0 -code boss  -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    74 {-code 0 -code 1     -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    75 {-code 0 -code 0     -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    76 {-code 0 -code 1     -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    77 {-code 0 -code 0     -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    78 {-code 0 -code error -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    79 {-code 0 -code ok    -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    80 {-code 0 -code error -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    81 {-code 0 -code ok    -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    82 {-code 0 -code boss  -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    83 {-code 0 -code boss  -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    84 {-code 0 -code 1     -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    85 {-code 0 -code 0     -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    86 {-code 0 -code error -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    87 {-code 0 -code ok    -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    88 {-code 0 -code boss  -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    89 {-code 0 -code 1     -level X -f ba}       {-code 1 -level 0 -f ba}
+    90 {-code 0 -code 0     -level X -f ba}       {-code 1 -level 0 -f ba}
+    91 {-code 0 -code error -level X -f ba}       {-code 1 -level 0 -f ba}
+    92 {-code 0 -code ok    -level X -f ba}       {-code 1 -level 0 -f ba}
+    93 {-code 0 -code boss  -level X -f ba}       {-code 1 -level 0 -f ba}
+
+    94 {-code 1     -code 1 -level 0 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    95 {-code 0     -code 1 -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    96 {-code 1     -code 1 -level 5 -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    97 {-code 0     -code 1 -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    98 {-code error -code 1 -level 0 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+    99 {-code ok    -code 1 -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a0 {-code error -code 1 -level 5 -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+    a1 {-code ok    -code 1 -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a2 {-code boss  -code 1 -level 0 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a3 {-code boss  -code 1 -level 5 -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    a4 {-code 1     -code 1 -level 0 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    a5 {-code 0     -code 1 -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    a6 {-code 1     -code 1 -level 5 -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    a7 {-code 0     -code 1 -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    a8 {-code error -code 1 -level 0 -f ba}       {-code error -code 1 -level 0 -f ba}
+    a9 {-code ok    -code 1 -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    b0 {-code error -code 1 -level 5 -f ba}       {-code error -code 1 -level 0 -f ba}
+    b1 {-code ok    -code 1 -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    b2 {-code boss  -code 1 -level 0 -f ba}       {-code 1             -level 0 -f ba}
+    b3 {-code boss  -code 1 -level 5 -f ba}       {-code 1             -level 0 -f ba}
+    b4 {-code 1     -code 1 -level X -f ba snarf} {-code 1 -code 1     -level 0 -f ba snarf}
+    b5 {-code 0     -code 1 -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    b6 {-code error -code 1 -level X -f ba snarf} {-code error -code 1 -level 0 -f ba snarf}
+    b7 {-code ok    -code 1 -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    b8 {-code boss  -code 1 -level X -f ba snarf} {-code 1             -level 0 -f ba snarf}
+    b9 {-code 1     -code 1 -level X -f ba}       {-code 1 -code 1     -level 0 -f ba}
+    c0 {-code 0     -code 1 -level X -f ba}       {-code 1             -level 0 -f ba}
+    c1 {-code error -code 1 -level X -f ba}       {-code error -code 1 -level 0 -f ba}
+    c2 {-code ok    -code 1 -level X -f ba}       {-code 1             -level 0 -f ba}
+    c3 {-code boss  -code 1 -level X -f ba}       {-code 1             -level 0 -f ba}
+
+    c4 {-code 1     -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c5 {-code 0     -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c6 {-code 1     -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c7 {-code 0     -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c8 {-code error -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    c9 {-code ok    -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d0 {-code error -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d1 {-code ok    -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d2 {-code boss  -code 0 -level 0 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d3 {-code boss  -code 0 -level 5 -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    d4 {-code 1     -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    d5 {-code 0     -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    d6 {-code 1     -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    d7 {-code 0     -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    d8 {-code error -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    d9 {-code ok    -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    e0 {-code error -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    e1 {-code ok    -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    e2 {-code boss  -code 0 -level 0 -f ba}       {-code 1 -level 0 -f ba}
+    e3 {-code boss  -code 0 -level 5 -f ba}       {-code 1 -level 0 -f ba}
+    e4 {-code 1     -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e5 {-code 0     -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e6 {-code error -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e7 {-code ok    -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e8 {-code boss  -code 0 -level X -f ba snarf} {-code 1 -level 0 -f ba snarf}
+    e9 {-code 1     -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f0 {-code 0     -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f1 {-code error -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f2 {-code ok    -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+    f3 {-code boss  -code 0 -level X -f ba}       {-code 1 -level 0 -f ba}
+} {
+    test io-71.$n {Tcl_SetChannelError} {testchannel} {
+
+	set f [makeFile {... dummy ...} cutsplice]
+	set c [open $f r]
+
+	set res [testchannel setchannelerror $c [lrange $msg 0 end]]
+	close $c
+	removeFile cutsplice
+
+	set res
+    } [lrange $expected 0 end]
+
+    test io-72.$n {Tcl_SetChannelErrorInterp} {testchannel} {
+
+	set f [makeFile {... dummy ...} cutsplice]
+	set c [open $f r]
+
+	set res [testchannel setchannelerrorinterp $c [lrange $msg 0 end]]
+	close $c
+	removeFile cutsplice
+
+	set res
+    } [lrange $expected 0 end]
+}
+
+test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} {
+    # Test for Bug 1847044 - don't spoil type unless we have a valid channel
+    catch {close [lreplace [list a] 0 end]}
+} {1}
+
+test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup {
+    # Invalidate intrep of 'channel' Tcl_Obj when transiting between interpreters.
+    set f [open [info script] r]
+} -body {
+    interp create foo
+    seek $f 0
+    set code [catch {interp eval foo [list seek $f 0]} msg]
+    # The string map converts the changing channel handle to a fixed string
+    list $code [string map [list $f @@] $msg]
+} -cleanup {
+    close $f
+} -result {1 {can not find channel named "@@"}}
+
+# ### ### ### ######### ######### #########
+
 # cleanup
-foreach file [list fooBar longfile script output test1 pipe my_script foo \
-	bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
+foreach file [list fooBar longfile script script2 output test1 pipe my_script \
+	test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
     removeFile $file
 }
 cleanupTests
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index fd09bc7..3976d25 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -1,3 +1,4 @@
+# -*- tcl -*-
 # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
 #		    fblocked, fconfigure, open, channel, fcopy
 #
@@ -11,15 +12,21 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: ioCmd.test,v 1.23 2005/05/10 18:35:22 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-testConstraint fcopy [llength [info commands fcopy]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+# Custom constraints used in this file
+testConstraint fcopy		[llength [info commands fcopy]]
+testConstraint testchannel	[llength [info commands testchannel]]
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+
+#----------------------------------------------------------------------
 
 test iocmd-1.1 {puts command} {
    list [catch {puts} msg] $msg
@@ -29,7 +36,7 @@ test iocmd-1.2 {puts command} {
 } {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
 test iocmd-1.3 {puts command} {
    list [catch {puts froboz -nonewline kablooie} msg] $msg
-} {1 {bad argument "kablooie": should be "nonewline"}}
+} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
 test iocmd-1.4 {puts command} {
    list [catch {puts froboz hello} msg] $msg
 } {1 {can not find channel named "froboz"}}
@@ -61,7 +68,6 @@ test iocmd-1.8 {puts command} {
     file size $path(test1)
 } 9
 
-
 test iocmd-2.1 {flush command} {
    list [catch {flush} msg] $msg
 } {1 {wrong # args: should be "flush channelId"}}
@@ -112,8 +118,8 @@ test iocmd-4.4 {read command} {
    list [catch {read -nonewline} msg] $msg
 } {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
 test iocmd-4.5 {read command} {
-   list [catch {read -nonew file4} msg] $msg $errorCode
-} {1 {can not find channel named "-nonew"} NONE}
+   list [catch {read -nonew file4} msg] $msg $::errorCode
+} {1 {can not find channel named "-nonew"} {TCL LOOKUP CHANNEL -nonew}}
 test iocmd-4.6 {read command} {
    list [catch {read stdout} msg] $msg
 } {1 {channel "stdout" wasn't opened for reading}}
@@ -127,45 +133,44 @@ test iocmd-4.8 {read command with incorrect combination of arguments} {
     puts $f "and this one"
     close $f
     set f [open $path(test1)]
-    set x [list [catch {read -nonewline $f 20 z} msg] $msg $errorCode]
+    set x [list [catch {read -nonewline $f 20 z} msg] $msg $::errorCode]
     close $f
     set x
-} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE}
+} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} {TCL WRONGARGS}}
 test iocmd-4.9 {read command} {
-    list [catch {read stdin foo} msg] $msg $errorCode
-} {1 {bad argument "foo": should be "nonewline"} NONE}
+    list [catch {read stdin foo} msg] $msg $::errorCode
+} {1 {expected non-negative integer but got "foo"} {TCL VALUE NUMBER}}
 test iocmd-4.10 {read command} {
-    list [catch {read file107} msg] $msg $errorCode
-} {1 {can not find channel named "file107"} NONE}
-
+    list [catch {read file107} msg] $msg $::errorCode
+} {1 {can not find channel named "file107"} {TCL LOOKUP CHANNEL file107}}
 set path(test3) [makeFile {} test3]
-
 test iocmd-4.11 {read command} {
     set f [open $path(test3) w]
-    set x [list [catch {read $f} msg] $msg $errorCode]
+    set x [list [catch {read $f} msg] $msg $::errorCode]
     close $f
     string compare [string tolower $x] \
 	[list 1 [format "channel \"%s\" wasn't opened for reading" $f] none]
 } 0
-test iocmd-4.12 {read command} {
+test iocmd-4.12 {read command} -setup {
     set f [open $path(test1)]
-    set x [list [catch {read $f 12z} msg] $msg $errorCode]
+} -body {
+    list [catch {read $f 12z} msg] $msg $::errorCode
+} -cleanup {
     close $f
-    set x
-} {1 {expected integer but got "12z"} NONE}
-
-test iocmd-5.1 {seek command} {
-    list [catch {seek} msg] $msg
-} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
-test iocmd-5.2 {seek command} {
-    list [catch {seek a b c d e f g} msg] $msg
-} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
-test iocmd-5.3 {seek command} {
-    list [catch {seek stdin gugu} msg] $msg
-} {1 {expected integer but got "gugu"}}
-test iocmd-5.4 {seek command} {
-    list [catch {seek stdin 100 gugu} msg] $msg
-} {1 {bad origin "gugu": must be start, current, or end}}
+} -result {1 {expected non-negative integer but got "12z"} {TCL VALUE NUMBER}}
+
+test iocmd-5.1 {seek command} -returnCodes error -body {
+    seek
+} -result {wrong # args: should be "seek channelId offset ?origin?"}
+test iocmd-5.2 {seek command} -returnCodes error -body {
+    seek a b c d e f g
+} -result {wrong # args: should be "seek channelId offset ?origin?"}
+test iocmd-5.3 {seek command} -returnCodes error -body {
+    seek stdin gugu
+} -result {expected integer but got "gugu"}
+test iocmd-5.4 {seek command} -returnCodes error -body {
+    seek stdin 100 gugu
+} -result {bad origin "gugu": must be start, current, or end}
 
 test iocmd-6.1 {tell command} {
     list [catch {tell} msg] $msg
@@ -179,20 +184,34 @@ test iocmd-6.3 {tell command} {
 
 test iocmd-7.1 {close command} {
     list [catch {close} msg] $msg
-} {1 {wrong # args: should be "close channelId"}}
+} {1 {wrong # args: should be "close channelId ?direction?"}}
 test iocmd-7.2 {close command} {
     list [catch {close a b c d e} msg] $msg
-} {1 {wrong # args: should be "close channelId"}}
+} {1 {wrong # args: should be "close channelId ?direction?"}}
 test iocmd-7.3 {close command} {
     list [catch {close aaa} msg] $msg
 } {1 {can not find channel named "aaa"}}
+test iocmd-7.4 {close command} -setup {
+    set chan [open [info script] r]
+} -body {
+    chan close $chan bar
+} -cleanup {
+    close $chan
+} -returnCodes error -result "bad direction \"bar\": must be read or write"
+test iocmd-7.5 {close command} -setup {
+    set chan [open [info script] r]
+} -body {
+    chan close $chan write
+} -cleanup {
+    close $chan
+} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed"
 
 test iocmd-8.1 {fconfigure command} {
     list [catch {fconfigure} msg] $msg
-} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
+} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}}
 test iocmd-8.2 {fconfigure command} {
     list [catch {fconfigure a b c d e f} msg] $msg
-} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
+} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}}
 test iocmd-8.3 {fconfigure command} {
     list [catch {fconfigure a b} msg] $msg
 } {1 {can not find channel named "a"}}
@@ -240,102 +259,109 @@ test iocmd-8.9 {fconfigure command} {
 test iocmd-8.10 {fconfigure command} {
     list [catch {fconfigure a b} msg] $msg
 } {1 {can not find channel named "a"}}
-
 set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
-
 test iocmd-8.11 {fconfigure command} {
     set chan [open $path(fconfigure.dummy) r]
     set res [list [catch {fconfigure $chan -froboz blarfo} msg] $msg]
     close $chan
     set res
 } {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
-
 test iocmd-8.12 {fconfigure command} {
     set chan [open $path(fconfigure.dummy) r]
     set res [list [catch {fconfigure $chan -b blarfo} msg] $msg]
     close $chan
     set res
 } {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
-
 test iocmd-8.13 {fconfigure command} {
     set chan [open $path(fconfigure.dummy) r]
     set res [list [catch {fconfigure $chan -buffer blarfo} msg] $msg]
     close $chan
     set res
 } {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
-
 removeFile fconfigure.dummy
-
 test iocmd-8.14 {fconfigure command} {
     fconfigure stdin -buffers
 } 4096
-
-proc iocmdSSETUP {} {
-    uplevel {
-	set srv [socket -server iocmdSRV 0]
-	set port [lindex [fconfigure $srv -sockname] 2]
-	proc iocmdSRV {sock ip port} {close $sock}
-	set cli [socket 127.0.0.1 $port]
+test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOrPc} -setup {
+    set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
+    set port [lindex [fconfigure $srv -sockname] 2]
+    proc iocmdSRV {sock ip port} {close $sock}
+    set cli [socket 127.0.0.1 $port]
+} -body {
+    fconfigure $cli -blah
+} -cleanup {
+    close $cli
+    close $srv
+    unset cli srv port
+    rename iocmdSRV {}
+} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}
+test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup {
+    set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
+    set port [lindex [fconfigure $srv -sockname] 2]
+    proc iocmdSRV {sock ip port} {close $sock}
+    set cli [socket 127.0.0.1 $port]
+} -body {
+    expr {[lindex [fconfigure $cli -peername] 2] == $port}
+} -cleanup {
+    close $cli
+    close $srv
+    unset cli srv port
+    rename iocmdSRV {}
+} -result 1
+test iocmd-8.17 {fconfigure command / tcp channel} -constraints nonPortable -setup {
+    set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0]
+    set port [lindex [fconfigure $srv -sockname] 2]
+    proc iocmdSRV {sock ip port} {close $sock}
+    set cli [socket 127.0.0.1 $port]
+} -body {
+    # It is possible that you don't get the connection reset by peer
+    # error but rather a valid answer. Depends on the tcp implementation
+    update
+    puts $cli "blah"
+    flush $cli;			# that flush could/should fail too
+    update
+    regsub -all {can([^:])+: } [catch {fconfigure $cli -peername} msg] {}
+} -cleanup {
+    close $cli
+    close $srv
+    unset cli srv port
+    rename iocmdSRV {}
+} -result 1
+test iocmd-8.18 {fconfigure command / unix tty channel} -constraints {nonPortable unix} -setup {
+    set tty ""
+} -body {
+    # might fail if /dev/ttya is unavailable
+    set tty [open /dev/ttya]
+    fconfigure $tty -blah blih
+} -cleanup {
+    if {$tty ne ""} {
+	close $tty
     }
-}
-proc iocmdSSHTDWN {} {
-    uplevel {
-	close $cli
-	close $srv
-	unset cli srv port
-	rename iocmdSRV {}
+} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}
+test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable win} -setup {
+    set tty ""
+} -body {
+    # might fail early if com1 is unavailable
+    set tty [open com1]
+    fconfigure $tty -blah blih
+} -cleanup {
+    if {$tty ne ""} {
+	close $tty
     }
-}
-
-test iocmd-8.15.1 {fconfigure command / tcp channel} {socket unixOrPc} {
-	iocmdSSETUP
-	set r [list [catch {fconfigure $cli -blah} msg] $msg]
-	iocmdSSHTDWN
-	set r
-} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}}
-test iocmd-8.16 {fconfigure command / tcp channel} {socket} {
-	iocmdSSETUP
-	set r [expr [lindex [fconfigure $cli -peername] 2]==$port]
-	iocmdSSHTDWN
-	set r
-} 1
-test iocmd-8.17 {fconfigure command / tcp channel} {nonPortable} {
-	# It is possible that you don't get the connection reset by peer
-        # error but rather a valid answer. depends of the tcp implementation
-	iocmdSSETUP
-	update;
-	puts $cli "blah"; flush $cli; # that flush could/should fail too
-	update;
-	set r [catch {fconfigure $cli -peername} msg]
-	iocmdSSHTDWN
-	regsub -all {can([^:])+: } $r {} r;
-	set r
-} 1
-test iocmd-8.18 {fconfigure command / unix tty channel} {nonPortable unix} {
-	# might fail if /dev/ttya is unavailable
-	set tty [open /dev/ttya]
-	set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
-	close $tty;
-	set r;
-} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}}
-test iocmd-8.19 {fconfigure command / win tty channel} {nonPortable win} {
-	# might fail if com1 is unavailable
-	set tty [open com1]
-	set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
-	close $tty;
-	set r;
-} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, or -pollinterval}}
+} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar}
+# TODO: Test parsing of serial channel options (nonportable, since requires an
+# open channel to work with).
 
 test iocmd-9.1 {eof command} {
-    list [catch {eof} msg] $msg $errorCode
-} {1 {wrong # args: should be "eof channelId"} NONE}
+    list [catch {eof} msg] $msg $::errorCode
+} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
 test iocmd-9.2 {eof command} {
-    list [catch {eof a b} msg] $msg $errorCode
-} {1 {wrong # args: should be "eof channelId"} NONE}
+    list [catch {eof a b} msg] $msg $::errorCode
+} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}}
 test iocmd-9.3 {eof command} {
     catch {close file100}
-    list [catch {eof file100} msg] $msg $errorCode
-} {1 {can not find channel named "file100"} NONE}
+    list [catch {eof file100} msg] $msg $::errorCode
+} {1 {can not find channel named "file100"} {TCL LOOKUP CHANNEL file100}}
 
 # The tests for Tcl_ExecObjCmd are in exec.test
 
@@ -362,14 +388,17 @@ file delete $path(test5)
 test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
     set f [open $path(test4) w]
     close $f
-    list [catch {open "| cat < $path(test4) > $path(test5)" w} msg] $msg $errorCode
-} {1 {can't write input to command: standard input was redirected} NONE}
+    list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode
+} {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}}
 test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
-    list [catch {open "| echo > $path(test5)" r} msg] $msg $errorCode
-} {1 {can't read output from command: standard output was redirected} NONE}
+    list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode
+} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
 test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
-    list [catch {open "| echo > $path(test5)" r+} msg] $msg $errorCode
-} {1 {can't read output from command: standard output was redirected} NONE}
+    list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
+} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
+test iocmd-11.4 {I/O to command pipelines} unixOrPc {
+    list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
+} {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}
 
 test iocmd-12.1 {POSIX open access modes: RDONLY} {
     file delete $path(test1)
@@ -418,7 +447,7 @@ test iocmd-12.5 {POSIX open access modes: RDWR} -match regexp -body {
     open $path(test3) RDWR
 } -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
 test iocmd-12.6 {POSIX open access modes: errors} {
-    concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$errorInfo
+    concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$::errorInfo
 } "1 unmatched open brace in list
 unmatched open brace in list
     while processing open access modes \"FOO {BAR BAZ\"
@@ -448,7 +477,7 @@ test iocmd-12.10 {POSIX open access modes: BINARY} {
 } 5
 test iocmd-12.11 {POSIX open access modes: BINARY} {
     set f [open $path(test1) {WRONLY BINARY TRUNC}]
-    puts $f \u0248	;# gets truncated to \u0048
+    puts $f \u0248		;# gets truncated to \u0048
     close $f
     set f [open $path(test1) r]
     fconfigure $f -translation binary
@@ -473,9 +502,9 @@ test iocmd-13.5 {errors in open command} {
     list [catch {open $path(test1) r+1} msg] $msg
 } {1 {illegal access mode "r+1"}}
 test iocmd-13.6 {errors in open command} {
-    set msg [list [catch {open _non_existent_} msg] $msg $errorCode]
+    set msg [list [catch {open _non_existent_} msg] $msg $::errorCode]
     regsub [file join {} _non_existent_] $msg "_non_existent_" msg
-	string tolower $msg
+    string tolower $msg
 } {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
 test iocmd-13.7 {errors in open command} {
     list [catch {open $path(test1) b} msg] $msg
@@ -486,10 +515,61 @@ test iocmd-13.8 {errors in open command} {
 test iocmd-13.9 {errors in open command} {
     list [catch {open $path(test1) r++} msg] $msg
 } {1 {illegal access mode "r++"}}
+test iocmd-13.10.1 {open for append, a mode} -setup {
+    set log   [makeFile {} out]
+    set chans {}
+} -body {
+    foreach i { 0 1 2 3 4 5 6 7 8 9 } {
+	puts [set ch [open $log a]] $i
+	lappend chans $ch
+    }
+    foreach ch $chans {catch {close $ch}}
+    lsort [split [string trim [viewFile out]] \n]
+} -cleanup {
+    removeFile out
+    # Ensure that channels are gone, even if body failed to do so
+    foreach ch $chans {catch {close $ch}}
+} -result {0 1 2 3 4 5 6 7 8 9}
+test iocmd-13.10.2 {open for append, O_APPEND} -setup {
+    set log   [makeFile {} out]
+    set chans {}
+} -body {
+    foreach i { 0 1 2 3 4 5 6 7 8 9 } {
+	puts [set ch [open $log {WRONLY CREAT APPEND}]] $i
+	lappend chans $ch
+    }
+    foreach ch $chans {catch {close $ch}}
+    lsort [split [string trim [viewFile out]] \n]
+} -cleanup {
+    removeFile out
+    # Ensure that channels are gone, even if body failed to do so
+    foreach ch $chans {catch {close $ch}}
+} -result {0 1 2 3 4 5 6 7 8 9}
+test ioCmd-13.11 {open ... a+ must not use O_APPEND: Bug 1773127} -setup {
+    set f [makeFile {} ioutil41.tmp]
+    set fid [open $f wb]
+    puts -nonewline $fid 123
+    close $fid
+} -body {
+    set fid [open $f ab+]
+    puts -nonewline $fid 456
+    seek $fid 2
+    set d [read $fid 2]
+    seek $fid 4
+    puts -nonewline $fid x
+    close $fid
+    set fid [open $f rb]
+    append d [read $fid]
+    close $fid
+    return $d
+} -cleanup {
+    removeFile $f
+} -result 341234x6
+
 
 test iocmd-14.1 {file id parsing errors} {
-    list [catch {eof gorp} msg] $msg $errorCode
-} {1 {can not find channel named "gorp"} NONE}
+    list [catch {eof gorp} msg] $msg $::errorCode
+} {1 {can not find channel named "gorp"} {TCL LOOKUP CHANNEL gorp}}
 test iocmd-14.2 {file id parsing errors} {
     list [catch {eof filex} msg] $msg
 } {1 {can not find channel named "filex"}}
@@ -540,10 +620,8 @@ test iocmd-15.5 {Tcl_FcopyObjCmd} {fcopy} {
 } {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
 
 set path(test2) [makeFile {} test2]
-
 set f [open $path(test1) w]
 close $f
-
 set rfile [open $path(test1) r]
 set wfile [open $path(test2) w]
 
@@ -572,6 +650,3185 @@ test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} {
 close $rfile
 close $wfile
 
+# ### ### ### ######### ######### #########
+## Testing the reflected channel.
+
+test iocmd-20.0 {chan, wrong#args} {
+    catch {chan} msg
+    set msg
+} {wrong # args: should be "chan subcommand ?arg ...?"}
+test iocmd-20.1 {chan, unknown method} -body {
+    chan foo
+} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be *}
+
+# --- --- --- --------- --------- ---------
+# chan create, and method "initalize"
+
+test iocmd-21.0 {chan create, wrong#args, not enough} {
+    catch {chan create} msg
+    set msg
+} {wrong # args: should be "chan create mode cmdprefix"}
+test iocmd-21.1 {chan create, wrong#args, too many} {
+    catch {chan create a b c} msg
+    set msg
+} {wrong # args: should be "chan create mode cmdprefix"}
+test iocmd-21.2 {chan create, invalid r/w mode, empty} {
+    proc foo {} {}
+    catch {chan create {} foo} msg
+    rename foo {}
+    set msg
+} {bad mode list: is empty}
+test iocmd-21.3 {chan create, invalid r/w mode, bad string} {
+    proc foo {} {}
+    catch {chan create {c} foo} msg
+    rename foo {}
+    set msg
+} {bad mode "c": must be read or write}
+test iocmd-21.4 {chan create, bad handler, not a list} {
+    catch {chan create {r w} "foo \{"} msg
+    set msg
+} {unmatched open brace in list}
+test iocmd-21.5 {chan create, bad handler, not a command} {
+    catch {chan create {r w} foo} msg
+    set msg
+} {invalid command name "foo"}
+test iocmd-21.6 {chan create, initialize failed, bad signature} {
+    proc foo {} {}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} {wrong # args: should be "foo"}
+test iocmd-21.7 {chan create, initialize failed, bad signature} {
+    proc foo {} {}
+    catch {chan create {r w} ::foo} msg
+    rename foo {}
+    set msg
+} {wrong # args: should be "::foo"}
+test iocmd-21.8 {chan create, initialize failed, bad result, not a list} -body {
+    proc foo {args} {return "\{"}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set ::errorInfo
+} -match glob -result {chan handler "foo initialize" returned non-list: *}
+test iocmd-21.9 {chan create, initialize failed, bad result, not a list} -body {
+    proc foo {args} {return \{\{\}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} -match glob -result {chan handler "foo initialize" returned non-list: *}
+test iocmd-21.10 {chan create, initialize failed, bad result, empty list} -body {
+    proc foo {args} {}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} -match glob -result {*all required methods*}
+test iocmd-21.11 {chan create, initialize failed, bad result, bogus method name} -body {
+    proc foo {args} {return 1}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} -match glob -result {*bad method "1": must be *}
+test iocmd-21.12 {chan create, initialize failed, bad result, bogus method name} -body {
+    proc foo {args} {return {a b c}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} -match glob -result {*bad method "c": must be *}
+test iocmd-21.13 {chan create, initialize failed, bad result, required methods missing} -body {
+    proc foo {args} {return {initialize finalize}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} -match glob -result {*all required methods*}
+test iocmd-21.14 {chan create, initialize failed, bad result, mode/handler mismatch} -body {
+    proc foo {args} {return {initialize finalize watch read}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} -match glob -result {*lacks a "write" method}
+test iocmd-21.15 {chan create, initialize failed, bad result, mode/handler mismatch} -body {
+    proc foo {args} {return {initialize finalize watch write}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} -match glob -result {*lacks a "read" method}
+test iocmd-21.16 {chan create, initialize failed, bad result, cget(all) mismatch} -body {
+    proc foo {args} {return {initialize finalize watch cget write read}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} -match glob -result {*supports "cget" but not "cgetall"}
+test iocmd-21.17 {chan create, initialize failed, bad result, cget(all) mismatch} -body {
+    proc foo {args} {return {initialize finalize watch cgetall read write}}
+    catch {chan create {r w} foo} msg
+    rename foo {}
+    set msg
+} -match glob -result {*supports "cgetall" but not "cget"}
+test iocmd-21.18 {chan create, initialize ok, creates channel} -match glob -body {
+    proc foo {args} {
+	global  res
+	lappend res $args
+	if {[lindex $args 0] ne "initialize"} {return}
+	return {initialize finalize watch read write}
+    }
+    set res {}
+    lappend res [file channel rc*]
+    lappend res [chan create {r w} foo]
+    lappend res [close [lindex $res end]]
+    lappend res [file channel rc*]
+    rename foo {}
+    set res
+} -result {{} {initialize rc* {read write}} rc* {finalize rc*} {} {}}
+test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match glob -body {
+    proc foo {args} {
+	global  res
+	lappend res $args
+	return {}
+    }
+    set res {}
+    lappend res [file channel rc*]
+    lappend res [catch {chan create {r w} foo} msg]
+    lappend res $msg
+    lappend res [file channel rc*]
+    rename foo {}
+    set res
+} -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}}
+test iocmd-21.20 {Bug 88aef05cda} -setup {
+    proc foo {method chan args} {
+	switch -- $method blocking {
+	    chan configure $chan -blocking [lindex $args 0]
+	    return
+	} initialize {
+	    return {initialize finalize watch blocking read write
+		    configure cget cgetall}
+	} finalize {
+	    return
+	}
+    }
+    set ch [chan create {read write} foo]
+} -body {
+    list [catch {chan configure $ch -blocking 0} m] $m
+} -cleanup {
+    close $ch
+    rename foo {}
+} -match glob -result {1 {*nested eval*}}
+test iocmd-21.21 {[close] in [read] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    close $chan
+	    return a
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    read $ch 0
+} -cleanup {
+    close $ch
+    rename foo {}
+} -result {}
+test iocmd-21.22 {[close] in [read] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return a
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    read $ch 1
+} -returnCodes error -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -match glob -result {*invalid argument*}
+test iocmd-21.23 {[close] in [gets] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return \n
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    gets $ch
+} -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -result {}
+test iocmd-21.24 {[close] in binary [gets] segfaults} -setup {
+    proc foo {method chan args} {
+	switch -- $method initialize {
+	    return {initialize finalize watch read}
+	} finalize {} watch {} read {
+	    catch {close $chan}
+	    return \n
+	}
+    }
+    set ch [chan create read foo]
+} -body {
+    chan configure $ch -translation binary
+    gets $ch
+} -cleanup {
+    catch {close $ch}
+    rename foo {}
+} -result {}
+
+# --- --- --- --------- --------- ---------
+# Helper commands to record the arguments to handler methods.
+
+# Stored in a script so that the threads and interpreters needing this
+# code do not need their own copy but can access this variable.
+
+set helperscript {
+
+proc note  {item}  {global res; lappend res $item; return}
+proc track {}      {upvar args item; note $item; return}
+proc notes {items} {foreach i $items {note $i}}
+# This forces the return options to be in the order that the test expects!
+proc noteOpts opts {global res; lappend res [dict merge {
+    -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
+} $opts]; return}
+
+# Helper command, canned result for 'initialize' method.
+# Gets the optional methods as arguments. Use return features
+# to post the result higher up.
+
+proc init {args} {
+    lappend args initialize finalize watch read write
+    return -code return $args
+}
+proc oninit {args} {
+    upvar args hargs
+    if {[lindex $hargs 0] ne "initialize"} {return}
+    lappend args initialize finalize watch read write
+    return -code return $args
+}
+proc onfinal {} {
+    upvar args hargs
+    if {[lindex $hargs 0] ne "finalize"} {return}
+    return -code return ""
+}
+}
+
+# Set everything up in the main thread.
+eval $helperscript
+
+# --- --- --- --------- --------- ---------
+# method finalize
+
+test iocmd-22.1 {chan finalize, handler destruction has no effect on channel} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return}
+    note [set c [chan create {r w} foo]]
+    rename foo {}
+    note [file channels rc*]
+    note [catch {close $c} msg]; note $msg
+    note [file channels rc*]
+    set res
+} -result {{initialize rc* {read write}} rc* rc* 1 {invalid command name "foo"} {}}
+test iocmd-22.2 {chan finalize, for close} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return {}}
+    note [set c [chan create {r w} foo]]
+    close $c
+    # Close deleted the channel.
+    note [file channels rc*]
+    # Channel destruction does not kill handler command!
+    note [info command foo]
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
+test iocmd-22.3 {chan finalize, for close, error, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return -code error 5}
+    note [set c [chan create {r w} foo]]
+    note [catch {close $c} msg]; note $msg
+    # Channel is gone despite error.
+    note [file channels rc*]
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
+test iocmd-22.4 {chan finalize, for close, error, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; error FOO}
+    note [set c [chan create {r w} foo]]
+    note [catch {close $c} msg]; note $msg; note $::errorInfo
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO {FOO
+*"close $c"}}
+test iocmd-22.5 {chan finalize, for close, arbitrary result, ignored} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return SOMETHING}
+    note [set c [chan create {r w} foo]]
+    note [catch {close $c} msg]; note $msg
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
+test iocmd-22.6 {chan finalize, for close, break, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return -code 3}
+    note [set c [chan create {r w} foo]]
+    note [catch {close $c} msg]; note $msg
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
+test iocmd-22.7 {chan finalize, for close, continue, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return -code 4}
+    note [set c [chan create {r w} foo]]
+    note [catch {close $c} msg]; note $msg
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
+test iocmd-22.8 {chan finalize, for close, custom code, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return -code 777 BANG}
+    note [set c [chan create {r w} foo]]
+    note [catch {close $c} msg]; note $msg
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*}
+test iocmd-22.9 {chan finalize, for close, ignore level, close error} -match glob -setup {
+    set res {}
+} -body {
+    proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
+    note [set c [chan create {r w} foo]]
+    note [catch {close $c} msg opt]; note $msg; noteOpts $opt
+    return $res
+} -cleanup {
+    rename foo {}
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}
+
+# --- === *** ###########################
+# method read
+
+test iocmd-23.1 {chan read, regular data return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return snarf
+    }
+    set c [chan create {r w} foo]
+    note [read $c 10]
+    close $c
+    rename foo {}
+    set res
+} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
+test iocmd-23.2 {chan read, bad data return, to much} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return [string repeat snarf 1000]
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 {read delivered more than requested}}
+test iocmd-23.3 {chan read, for non-readable channel} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track; note MUST_NOT_HAPPEN
+    }
+    set c [chan create {w} foo]
+    note [catch {read $c 2} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {1 {channel "rc*" wasn't opened for reading}}
+test iocmd-23.4 {chan read, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!}
+test iocmd-23.5 {chan read, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 *bad code*}
+test iocmd-23.6 {chan read, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 *bad code*}
+test iocmd-23.7 {chan read, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 *bad code*}
+test iocmd-23.8 {chan read, level is squashed} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -level 55 -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
+    close $c
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
+test iocmd-23.9 {chan read, no data means eof} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return ""
+    }
+    set c [chan create {r w} foo]
+} -body {
+    note [read $c 2]
+    note [eof $c]
+    set res
+} -cleanup {
+    close $c
+    rename foo {}
+    unset res
+} -result {{read rc* 4096} {} 1}
+test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	error EAGAIN
+    }
+    set c [chan create {r w} foo]
+} -body {
+    note [read $c 2]
+    note [eof $c]
+    set res
+} -cleanup {
+    close $c
+    rename foo {}
+    unset res
+} -result {{read rc* 4096} {} 0}
+test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	set args [lassign $args sub id]
+	if {$sub ne "read"} {return}
+	close $id
+	return {}
+    }
+    set c [chan create {r} foo]
+    note [read $c]
+    rename foo {}
+    set res
+} -result {{read rc* 4096} {}}
+
+# --- === *** ###########################
+# method write
+
+test iocmd-24.1 {chan write, regular write} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	set     written [string length [lindex $args 2]]
+	note   $written
+	return $written
+    }
+    set c [chan create {r w} foo]
+    puts -nonewline $c snarf; flush $c
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarf} 5}
+test iocmd-24.2 {chan write, partial write is ok} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	set     written [string length [lindex $args 2]]
+	if {$written > 10} {set written [expr {$written / 2}]}
+	note   $written
+	return $written
+    }
+    set c [chan create {r w} foo]
+    puts -nonewline $c snarfsnarfsnarf; flush $c
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
+test iocmd-24.3 {chan write, failed write} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note -1; return -1}
+    set c [chan create {r w} foo]
+    puts -nonewline $c snarfsnarfsnarf; flush $c
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} -1}
+test iocmd-24.4 {chan write, non-writable channel} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r} foo]
+    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {1 {channel "rc*" wasn't opened for writing}}
+test iocmd-24.5 {chan write, bad result, more written than data} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return 10000}
+    set c [chan create {r w} foo]
+    note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarf} 1 {write wrote more than requested}}
+test iocmd-24.6 {chan write, bad result, zero-length write} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return 0}
+    set c [chan create {r w} foo]
+    note [catch {puts -nonewline $c snarf; flush $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarf} 1 {write wrote nothing}}
+test iocmd-24.7 {chan write, failed write, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+    note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
+test iocmd-24.8 {chan write, failed write, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; error BOOM!}
+    set c [chan create {r w} foo]
+    notes [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+    note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!}
+test iocmd-24.9 {chan write, failed write, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+    note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*}
+test iocmd-24.10 {chan write, failed write, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+    note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*}
+test iocmd-24.11 {chan write, failed write, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+    note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*}
+test iocmd-24.12 {chan write, failed write, non-numeric return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return BANG}
+    set c [chan create {r w} foo]
+    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+    note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}}
+test iocmd-24.13 {chan write, failed write, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
+    note $msg
+    noteOpts $opt
+    close $c
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}}
+test iocmd-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return 3
+    }
+    set c [chan create {r w} foo]
+} -body {
+    note [puts -nonewline $c ABC ; flush $c]
+    set res
+} -cleanup {
+    close $c
+    rename foo {}
+    unset res
+} -result {{write rc* ABC} {}}
+test iocmd-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	# Note: The EAGAIN signals that the channel cannot accept
+	# write requests right now, this in turn causes the IO core to
+	# request the generation of writable events (see expected
+	# result below, and compare to case 24.14 above).
+	error EAGAIN
+    }
+    set c [chan create {r w} foo]
+} -body {
+    note [puts -nonewline $c ABC ; flush $c]
+    set res
+} -cleanup {
+    close $c
+    rename foo {}
+    unset res
+} -result {{write rc* ABC} {watch rc* write} {}}
+
+# --- === *** ###########################
+# method cgetall
+
+test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    note [fconfigure $c]
+    close $c
+    rename foo {}
+    set res
+} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
+    set res {}
+    proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
+    set c [chan create {r w} foo]
+    note [fconfigure $c]
+    close $c
+    rename foo {}
+    set res
+} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+test iocmd-25.3 {chan configure, cgetall, regular result} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return "-bar foo -snarf x"
+    }
+    set c [chan create {r w} foo]
+    note [fconfigure $c]
+    close $c
+    rename foo {}
+    set res
+} -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
+test iocmd-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return "-bar"
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
+test iocmd-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return "\{"
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 {unmatched open brace in list}}
+test iocmd-25.6 {chan configure, cgetall, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 BOOM!}
+test iocmd-25.7 {chan configure, cgetall, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 *bad code*}
+test iocmd-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 *bad code*}
+test iocmd-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 *bad code*}
+test iocmd-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -level 55 -code 777 BANG
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c} msg opt]; note $msg; noteOpts $opt
+    close $c
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}}
+
+# --- === *** ###########################
+# method configure
+
+test iocmd-26.1 {chan configure, set standard option} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
+    }
+    set c [chan create {r w} foo]
+    note [fconfigure $c -translation lf]
+    close $c
+    rename foo {}
+    set res
+} -result {{}}
+test iocmd-26.2 {chan configure, set option, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 BOOM!}
+test iocmd-26.3 {chan configure, set option, ok return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit configure; onfinal; track; return}
+    set c [chan create {r w} foo]
+    note [fconfigure $c -rc-foo bar]
+    close $c
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} {}}
+test iocmd-26.4 {chan configure, set option, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 *bad code*}
+test iocmd-26.5 {chan configure, set option, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 *bad code*}
+test iocmd-26.6 {chan configure, set option, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -code 444 BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo bar} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 *bad code*}
+test iocmd-26.7 {chan configure, set option, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -level 55 -code 444 BANG
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo bar} msg opt]; note $msg; noteOpts $opt
+    close $c
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}}
+
+# --- === *** ###########################
+# method cget
+
+test iocmd-27.1 {chan configure, get option, ok return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit cget cgetall; onfinal; track; return foo}
+    set c [chan create {r w} foo]
+    note [fconfigure $c -rc-foo]
+    close $c
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} foo}
+test iocmd-27.2 {chan configure, get option, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!}
+test iocmd-27.3 {chan configure, get option, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!}
+test iocmd-27.4 {chan configure, get option, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 *bad code*}
+test iocmd-27.5 {chan configure, get option, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code 333 BOOM!
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 *bad code*}
+test iocmd-27.6 {chan configure, get option, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -level 77 -code 333 BANG
+    }
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -rc-foo} msg opt]; note $msg; noteOpts $opt
+    close $c
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}}
+
+# --- === *** ###########################
+# method seek
+
+test iocmd-28.1 {chan tell, not supported by handler} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    note [tell $c]
+    close $c
+    rename foo {}
+    set res
+} -result {-1}
+test iocmd-28.2 {chan tell, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {tell $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!}
+test iocmd-28.3 {chan tell, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {tell $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 *bad code*}
+test iocmd-28.4 {chan tell, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {tell $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 *bad code*}
+test iocmd-28.5 {chan tell, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {tell $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 *bad code*}
+test iocmd-28.6 {chan tell, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG}
+    set c [chan create {r w} foo]
+    note [catch {tell $c} msg opt]; note $msg; noteOpts $opt
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}}
+test iocmd-28.7 {chan tell, regular return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return 88}
+    set c [chan create {r w} foo]
+    note [tell $c]
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 88}
+test iocmd-28.8 {chan tell, negative return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -1}
+    set c [chan create {r w} foo]
+    note [catch {tell $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 {Tried to seek before origin}}
+test iocmd-28.9 {chan tell, string return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
+    set c [chan create {r w} foo]
+    note [catch {tell $c} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}}
+test iocmd-28.10 {chan seek, not supported by handler} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    note [catch {seek $c 0 start} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {1 {error during seek on "rc*": invalid argument}}
+test iocmd-28.11 {chan seek, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {seek $c 0 start} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!}
+test iocmd-28.12 {chan seek, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {seek $c 0 start} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 *bad code*}
+test iocmd-28.13 {chan seek, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {seek $c 0 start} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 *bad code*}
+test iocmd-28.14 {chan seek, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {seek $c 0 start} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 *bad code*}
+test iocmd-28.15 {chan seek, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG}
+    set c [chan create {r w} foo]
+    note [catch {seek $c 0 start} msg opt]; note $msg; noteOpts $opt
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}}
+test iocmd-28.16 {chan seek, bogus return, negative location} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -45}
+    set c [chan create {r w} foo]
+    note [catch {seek $c 0 start} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 {Tried to seek before origin}}
+test iocmd-28.17 {chan seek, bogus return, string return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
+    set c [chan create {r w} foo]
+    note [catch {seek $c 0 start} msg]; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}}
+test iocmd-28.18 {chan seek, ok result} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return 23}
+    set c [chan create {r w} foo]
+    note [seek $c 0 current]
+    close $c
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} {}}
+foreach {testname code} {
+    iocmd-28.19.0 start
+    iocmd-28.19.1 current
+    iocmd-28.19.2 end
+} {
+    test $testname "chan seek, base conversion, $code" -match glob -body {
+	set res {}
+	proc foo {args} {oninit seek; onfinal; track; return 0}
+	set c [chan create {r w} foo]
+	note [seek $c 0 $code]
+	close $c
+	rename foo {}
+	set res
+    } -result [list [list seek rc* 0 $code] {}]
+}
+
+# --- === *** ###########################
+# method blocking
+
+test iocmd-29.1 {chan blocking, no handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    note [fconfigure $c -blocking]
+    close $c
+    rename foo {}
+    set res
+} -result {1}
+test iocmd-29.2 {chan blocking, no handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    note [fconfigure $c -blocking 0]
+    note [fconfigure $c -blocking]
+    close $c
+    rename foo {}
+    set res
+} -result {{} 0}
+test iocmd-29.3 {chan blocking, retrieval, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    note [fconfigure $c -blocking]
+    close $c
+    rename foo {}
+    set res
+} -result {1}
+test iocmd-29.4 {chan blocking, resetting, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return}
+    set c [chan create {r w} foo]
+    note [fconfigure $c -blocking 0]
+    note [fconfigure $c -blocking]
+    close $c
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} {} 0}
+test iocmd-29.5 {chan blocking, setting, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return}
+    set c [chan create {r w} foo]
+    note [fconfigure $c -blocking 1]
+    note [fconfigure $c -blocking]
+    close $c
+    rename foo {}
+    set res
+} -result {{blocking rc* 1} {} 1}
+test iocmd-29.6 {chan blocking, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; error BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -blocking 0} msg]; note $msg
+    # Catch the close. It changes blocking mode internally, and runs into the error result.
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!}
+test iocmd-29.7 {chan blocking, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -blocking 0} msg]; note $msg
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 *bad code*}
+test iocmd-29.8 {chan blocking, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -blocking 0} msg]; note $msg
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 *bad code*}
+test iocmd-29.9 {chan blocking, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!}
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -blocking 0} msg]; note $msg
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 *bad code*}
+test iocmd-29.10 {chan blocking, level is ignored} -match glob -setup {
+    set res {}
+} -body {
+    proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG}
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -blocking 0} msg opt]; note $msg; noteOpts $opt
+    catch {close $c}
+    return $res
+} -cleanup {
+    rename foo {}
+} -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}}
+test iocmd-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return BOGUS}
+    set c [chan create {r w} foo]
+    note [catch {fconfigure $c -blocking 0} msg]; note $msg
+    catch {close $c}
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 0 {}}
+
+# --- === *** ###########################
+# method watch
+
+test iocmd-30.1 {chan watch, read interest, some return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return IGNORED}
+    set c [chan create {r w} foo]
+    note [fileevent $c readable {set tick $tick}]
+    close $c			;# 2nd watch, interest zero.
+    rename foo {}
+    set res
+} -result {{watch rc* read} {} {watch rc* {}}}
+test iocmd-30.2 {chan watch, write interest, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED}
+    set c [chan create {r w} foo]
+    note [fileevent $c writable {set tick $tick}]
+    note [fileevent $c writable {}]
+    close $c
+    rename foo {}
+    set res
+} -result {{watch rc* write} {} {watch rc* {}} {}}
+test iocmd-30.3 {chan watch, accumulated interests} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    note [fileevent $c writable {set tick $tick}]
+    note [fileevent $c readable {set tick $tick}]
+    note [fileevent $c writable {}]
+    note [fileevent $c readable {}]
+    close $c
+    rename foo {}
+    set res
+} -result {{watch rc* write} {} {watch rc* {read write}} {} {watch rc* read} {} {watch rc* {}} {}}
+test iocmd-30.4 {chan watch, unchanged interest not forwarded} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    note [fileevent $c writable {set tick $tick}]
+    note [fileevent $c readable {set tick $tick}] ;# Script is changing,
+    note [fileevent $c readable {set tock $tock}] ;# interest does not.
+    close $c		;# 3rd and 4th watch, removing the event handlers.
+    rename foo {}
+    set res
+} -result {{watch rc* write} {} {watch rc* {read write}} {} {} {watch rc* write} {watch rc* {}}}
+
+# --- === *** ###########################
+# chan postevent
+
+test iocmd-31.1 {chan postevent, restricted to reflected channels} -match glob -body {
+    set c [open [makeFile {} goo] r]
+    catch {chan postevent $c {r w}} msg
+    close $c
+    removeFile goo
+    set msg
+} -result {can not find reflected channel named "file*"}
+test iocmd-31.2 {chan postevent, unwanted events} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    catch {chan postevent $c {r w}} msg; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{tried to post events channel "rc*" is not interested in}}
+test iocmd-31.3 {chan postevent, bad input, empty list} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    catch {chan postevent $c {}} msg; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{bad event list: is empty}}
+test iocmd-31.4 {chan postevent, bad input, illlegal keyword} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    catch {chan postevent $c goo} msg; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{bad event "goo": must be read or write}}
+test iocmd-31.5 {chan postevent, bad input, not a list} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    catch {chan postevent $c "\{"} msg; note $msg
+    close $c
+    rename foo {}
+    set res
+} -result {{unmatched open brace in list}}
+test iocmd-31.6 {chan postevent, posted events do happen} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    note [fileevent $c readable {note TOCK}]
+    set stop [after 10000 {note TIMEOUT}]
+    after  1000 {note [chan postevent $c r]}
+    vwait ::res
+    catch {after cancel $stop}
+    close $c
+    rename foo {}
+    set res
+} -result {{watch rc* read} {} TOCK {} {watch rc* {}}}
+test iocmd-31.7 {chan postevent, posted events do happen} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    note [fileevent $c writable {note TOCK}]
+    set stop [after 10000 {note TIMEOUT}]
+    after  1000 {note [chan postevent $c w]}
+    vwait ::res
+    catch {after cancel $stop}
+    close $c
+    rename foo {}
+    set res
+} -result {{watch rc* write} {} TOCK {} {watch rc* {}}}
+test iocmd-31.8 {chan postevent after close throws error} -match glob -setup {
+    proc foo {args} {oninit; onfinal; track; return}
+    proc dummy args { return }
+    set c [chan create {r w} foo]
+    fileevent $c readable dummy
+} -body {
+    close $c
+    chan postevent $c read
+} -cleanup {
+    rename foo   {}
+    rename dummy {}
+} -returnCodes error -result {can not find reflected channel named "rc*"}
+
+# --- === *** ###########################
+# 'Pull the rug' tests. Create channel in a interpreter A, move to
+# other interpreter B, destroy the origin interpreter (A) before or
+# during access from B. Must not crash, must return proper errors.
+
+test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {
+
+    set ida [interp create];#puts <<$ida>>
+    set idb [interp create];#puts <<$idb>>
+
+    # Magic to get the test* commands in the slaves
+    load {} Tcltest $ida
+    load {} Tcltest $idb
+
+    # Set up channel in interpreter
+    interp eval $ida $helperscript
+    set chan [interp eval $ida {
+	proc foo {args} {oninit seek; onfinal; track; return}
+	set chan [chan create {r w} foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd interpreter.
+    interp eval $ida [list testchannel cut    $chan]
+    interp eval $idb [list testchannel splice $chan]
+
+    # Kill origin interpreter, then access channel from 2nd interpreter.
+    interp delete $ida
+
+    set     res {}
+    lappend res [catch {interp eval $idb [list puts  $chan shoo]} msg] $msg
+    lappend res [catch {interp eval $idb [list tell  $chan]}      msg] $msg
+    lappend res [catch {interp eval $idb [list seek  $chan 1]}    msg] $msg
+    lappend res [catch {interp eval $idb [list gets  $chan]}      msg] $msg
+    lappend res [catch {interp eval $idb [list close $chan]}      msg] $msg
+    set res
+
+} -constraints {testchannel} \
+    -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
+
+test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body {
+
+    set ida [interp create];#puts <<$ida>>
+    set idb [interp create];#puts <<$idb>>
+
+    # Magic to get the test* commands in the slaves
+    load {} Tcltest $ida
+    load {} Tcltest $idb
+
+    # Set up channel in thread
+    set chan [interp eval $ida $helperscript]
+    set chan [interp eval $ida {
+	proc foo {args} {
+	    oninit; onfinal; track;
+	    # destroy interpreter during channel access
+	    # Actually not possible for an interp to destroy itself.
+	    interp delete {}
+	    return}
+	set chan [chan create {r w} foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd thread.
+    interp eval $ida [list testchannel cut    $chan]
+    interp eval $idb [list testchannel splice $chan]
+
+    # Run access from interpreter B, this will give us a synchronous
+    # response.
+
+    interp eval $idb [list set chan $chan]
+    set res [interp eval $idb {
+	# wait a bit, give the main thread the time to start its event
+	# loop to wait for the response from B
+	after 2000
+	catch { puts $chan shoo } res
+	set res
+    }]
+    set res
+} -constraints {testchannel impossible} \
+    -result {Owner lost}
+
+test iocmd-32.2 {delete interp of reflected chan} {
+    # Bug 3034840
+    # Run this test in an interp with memory debugging to panic
+    # on the double free
+    interp create slave
+    slave eval {
+        proc no-op args {}
+        proc driver {sub args} {return {initialize finalize watch read}}
+        chan event [chan create read driver] readable no-op
+    }
+    interp delete slave
+} {}
+
+# ### ### ### ######### ######### #########
+## Same tests as above, but exercising the code forwarding and
+## receiving driver operations to the originator thread.
+
+# -*- tcl -*-
+# ### ### ### ######### ######### #########
+## Testing the reflected channel (Thread forwarding).
+#
+## The id numbers refer to the original test without thread
+## forwarding, and gaps due to tests not applicable to forwarding are
+## left to keep this asociation.
+
+# ### ### ### ######### ######### #########
+## Helper command. Runs a script in a separate thread and returns the
+## result. A channel is transfered into the thread as well, and list of
+## configuation variables
+
+proc inthread {chan script args} {
+    # Test thread.
+
+    set tid [thread::create -preserved]
+    thread::send $tid {load {} Tcltest}
+
+    # Init thread configuration.
+    # - Listed variables
+    # - Id of main thread
+    # - A number of helper commands
+
+    foreach v $args {
+	upvar 1 $v x
+	thread::send $tid [list set $v $x]
+
+    }
+    thread::send $tid [list set mid [thread::id]]
+    thread::send $tid {
+	proc note {item} {global notes; lappend notes $item}
+	proc notes {} {global notes; return $notes}
+	proc noteOpts opts {global notes; lappend notes [dict merge {
+	    -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
+	} $opts]}
+    }
+    thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
+
+    # Transfer channel (cut/splice aka detach/attach)
+
+    testchannel cut $chan
+    thread::send $tid [list testchannel splice $chan]
+
+    # Run test script, also run local event loop!
+    # The local event loop waits for the result to come back.
+    # It is also necessary for the execution of forwarded channel
+    # operations.
+
+    set ::tres ""
+    thread::send -async $tid {
+	after 500
+	catch {s} res; # This runs the script, 's' was defined at (*)
+	thread::send -async $mid [list set ::tres $res]
+    }
+    vwait ::tres
+    # Remove test thread, and return the captured result.
+
+    thread::release $tid
+    return $::tres
+}
+
+# ### ### ### ######### ######### #########
+
+# ### ### ### ######### ######### #########
+
+test iocmd.tf-22.2 {chan finalize, for close} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return {}}
+    note [set c [chan create {r w} foo]]
+    note [inthread $c {
+	close $c
+	# Close the deleted the channel.
+	file channels rc*
+    } c]
+    # Channel destruction does not kill handler command!
+    note [info command foo]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo}
+test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return -code error 5}
+    note [set c [chan create {r w} foo]]
+    notes [inthread $c {
+	note [catch {close $c} msg]; note $msg
+	# Channel is gone despite error.
+	note [file channels rc*]
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}}
+test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; error FOO}
+    note [set c [chan create {r w} foo]]
+    notes [inthread $c {
+	note [catch {close $c} msg]; note $msg
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO}
+test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return SOMETHING}
+    note [set c [chan create {r w} foo]]
+    notes [inthread $c {
+	note [catch {close $c} msg]; note $msg
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}}
+test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return -code 3}
+    note [set c [chan create {r w} foo]]
+    notes [inthread $c {
+	note [catch {close $c} msg]; note $msg
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return -code 4}
+    note [set c [chan create {r w} foo]]
+    notes [inthread $c {
+	note [catch {close $c} msg]; note $msg
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return -code 777 BANG}
+    note [set c [chan create {r w} foo]]
+    notes [inthread $c {
+	note [catch {close $c} msg]; note $msg
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match glob -body {
+    set res {}
+    proc foo {args} {track; oninit; return -level 5 -code 777 BANG}
+    note [set c [chan create {r w} foo]]
+    notes [inthread $c {
+	note [catch {close $c} msg opt]; note $msg; noteOpts $opt
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} \
+    -constraints {testchannel thread}
+
+# --- === *** ###########################
+# method read
+
+test iocmd.tf-23.1 {chan read, regular data return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return snarf
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [read $c 10]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf}
+test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return [string repeat snarf 1000]
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {[read $c 2]} msg]; note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{read rc* 4096} 1 {read delivered more than requested}}
+test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track; note MUST_NOT_HAPPEN
+    }
+    set c [chan create {w} foo]
+    notes [inthread $c {
+	note [catch {[read $c 2]} msg]; note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for reading}}
+test iocmd.tf-23.4 {chan read, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {read $c 2} msg]; note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 BOOM!} \
+    -constraints {testchannel thread}
+test iocmd.tf-23.5 {chan read, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {read $c 2} msg]; note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {read $c 2} msg]; note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {read $c 2} msg]; note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return -level 55 -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {read $c 2} msg opt]; note $msg; noteOpts $opt
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \
+    -constraints {testchannel thread}
+test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return ""
+    }
+    set c [chan create {r w} foo]
+} -body {
+    notes [inthread $c {
+	note [read $c 2]
+	note [eof $c]
+	close $c
+	notes
+    } c]
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {{read rc* 4096} {} 1} \
+    -constraints {testchannel thread}
+test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	error EAGAIN
+    }
+    set c [chan create {r w} foo]
+} -body {
+    notes [inthread $c {
+	note [read $c 2]
+	note [eof $c]
+	close $c
+	notes
+    } c]
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {{read rc* 4096} {} 0} \
+    -constraints {testchannel thread}
+
+# --- === *** ###########################
+# method write
+
+test iocmd.tf-24.1 {chan write, regular write} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	set     written [string length [lindex $args 2]]
+	note   $written
+	return $written
+    }
+    set c [chan create {r w} foo]
+    inthread $c {
+	puts -nonewline $c snarf; flush $c
+	close $c
+    } c
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{write rc* snarf} 5}
+test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	set     written [string length [lindex $args 2]]
+	if {$written > 10} {set written [expr {$written / 2}]}
+	note   $written
+	return $written
+    }
+    set c [chan create {r w} foo]
+    inthread $c {
+	puts -nonewline $c snarfsnarfsnarf; flush $c
+	close $c
+    } c
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8}
+test iocmd.tf-24.3 {chan write, failed write} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note -1; return -1}
+    set c [chan create {r w} foo]
+    inthread $c {
+	puts -nonewline $c snarfsnarfsnarf; flush $c
+	close $c
+    } c
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} -1}
+test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for writing}}
+test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return 10000}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarf; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}}
+test iocmd.tf-24.6 {chan write, zero writes} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return 0}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarf; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}}
+test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code error BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
+    -constraints {testchannel thread}
+test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; error BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \
+    -constraints {testchannel thread}
+test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code break BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return BANG}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} \
+    -constraints {testchannel thread}
+test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {puts -nonewline $c snarfsnarfsnarf; flush $c} msg opt]
+	note $msg
+	noteOpts $opt
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} \
+    -constraints {testchannel thread}
+test iocmd.tf-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	return 3
+    }
+    set c [chan create {r w} foo]
+} -body {
+    notes [inthread $c {
+	note [puts -nonewline $c ABC ; flush $c]
+	close $c
+	notes
+    } c]
+    set res
+} -cleanup {
+    rename foo {}
+    unset res
+} -result {{write rc* ABC} {}} \
+    -constraints {testchannel thread}
+test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	# Note: The EAGAIN signals that the channel cannot accept
+	# write requests right now, this in turn causes the IO core to
+	# request the generation of writable events (see expected
+	# result below, and compare to case 24.14 above).
+	error EAGAIN
+    }
+    set c [chan create {r w} foo]
+} -body {
+    notes [inthread $c {
+	note [puts -nonewline $c ABC ; flush $c]
+	close $c
+	notes
+    } c]
+    set res
+} -cleanup {
+    proc foo {args} {onfinal; set ::done-24.15 1; return 3}
+    after 1000 {set ::done-24.15 2}
+    vwait done-24.15
+    rename foo {}
+    unset res
+} -result {{write rc* ABC} {watch rc* write} {}} \
+    -constraints {testchannel thread}
+
+test iocmd.tf-24.16 {chan write, note the background flush setup by close due to the EAGAIN leaving data in buffers.} -match glob -setup {
+    set res {}
+    proc foo {args} {
+	oninit; onfinal; track
+	# Note: The EAGAIN signals that the channel cannot accept
+	# write requests right now, this in turn causes the IO core to
+	# request the generation of writable events (see expected
+	# result below, and compare to case 24.14 above).
+	error EAGAIN
+    }
+    set c [chan create {r w} foo]
+} -body {
+    notes [inthread $c {
+	note [puts -nonewline $c ABC ; flush $c]
+	close $c
+	notes
+    } c]
+    # Replace handler with all-tracking one which doesn't error.
+    # This will tell us if a write-due-flush is there.
+    proc foo {args} { onfinal; note BG ; track ; set ::endbody-24.16 1}
+    # Flush (sic!) the event-queue to capture the write from a
+    # BG-flush.
+    after 1000 {set ::endbody-24.16 2}
+    vwait endbody-24.16
+    set res
+} -cleanup {
+    proc foo {args} {onfinal; set ::done-24.16 1; return 3}
+    after 1000 {set ::done-24.16 2}
+    vwait done-24.16
+    rename foo {}
+    unset res
+} -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \
+    -constraints {testchannel thread}
+
+test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
+    -constraints {testchannel thread} -setup {
+    # This test exposes how the execution of postevent in the handler thread causes
+    # a crash if we are not properly injecting the events into the owning thread instead.
+    # With the injection the test will simply complete without crash.
+
+    set beat 10000
+    set drive 999
+    set data ...---...
+
+    proc LOG {text} {
+	#puts stderr "[thread::id]: $text"
+	return
+    }
+
+    proc POST {hi} {
+	LOG "-> [info level 0]"
+	chan postevent $hi read
+	LOG "<- [info level 0]"
+
+	set ::timer [after $::drive [info level 0]]
+	return
+    }
+
+    proc HANDLER {op ch args} {
+	lappend ::res [lrange [info level 0] 1 end]
+	LOG "-> [info level 0]"
+	set ret {}
+	switch -glob -- $op {
+	    init* {set ret {initialize finalize watch read}}
+	    watch {
+		set l [lindex $args 0]
+		if {[llength $l]} {
+		    set ::timer [after $::drive [list POST $ch]]
+		} else {
+		    after cancel $::timer
+		}
+	    }
+	    finalize {
+		catch { after cancel $::timer }
+		after 500 {set ::forever now}
+	    }
+	    read {
+		set ret $::data
+		set ::data {} ; # Next is EOF.
+	    }
+	}
+	LOG "<- [info level 0] : $ret"
+	return $ret
+    }
+} -body {
+    LOG BEGIN
+    set ch [chan create {read} HANDLER]
+
+    set tid [thread::create {
+	proc LOG {text} {
+	    #puts stderr "\t\t\t\t\t\t[thread::id]: $text"
+	    return
+	}
+	LOG THREAD-STARTED
+	load {} Tcltest
+	proc bgerror s {
+	    LOG BGERROR:$s
+	}
+	vwait forever
+	LOG THREAD-DONE
+    }]
+
+    testchannel cut $ch
+    thread::send $tid [list set thech $ch]
+    thread::send $tid [list set beat $beat]
+    thread::send -async $tid {
+	LOG SPLICE-BEG
+	testchannel splice $thech
+	LOG SPLICE-END
+	proc PROCESS {ch} {
+	    LOG "-> [info level 0]"
+	    if {[eof $ch]} {
+		close $ch
+		set ::done 1
+		set c <<EOF>>
+	    } else {
+		set c [read $ch 1]
+	    }
+	    LOG "GOTCHAR: $c"
+	    LOG "<- [info level 0]"
+	}
+	LOG THREAD-FILEEVENT
+	fconfigure $thech -translation binary -blocking 0
+	fileevent  $thech readable [list PROCESS $thech]
+	LOG THREAD-NOEVENT-LOOP
+	set done 0
+	while {!$done} {
+	    after $beat
+	    LOG THREAD-HEARTBEAT
+	    update
+	}
+	LOG THREAD-LOOP-DONE
+	thread::exit
+    }
+
+    LOG MAIN_WAITING
+    vwait forever
+    LOG MAIN_DONE
+
+    set res
+} -cleanup {
+    rename LOG {}
+    rename POST {}
+    rename HANDLER {}
+    unset beat drive data forever res tid ch
+} -match glob \
+    -result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}}
+
+# --- === *** ###########################
+# method cgetall
+
+test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} \
+    -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body {
+    set res {}
+    proc foo {args} {oninit cget cgetall; onfinal; track; return ""}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} \
+    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}}
+test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return "-bar foo -snarf x"
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} \
+    -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}}
+test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return "-bar"
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}}
+test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return "\{"
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{cgetall rc*} 1 {unmatched open brace in list}}
+test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{cgetall rc*} 1 BOOM!}
+test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code 777 BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -level 55 -code 777 BANG
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c} msg opt]
+	note $msg
+	noteOpts $opt
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}} \
+    -constraints {testchannel thread}
+
+# --- === *** ###########################
+# method configure
+
+test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c -translation lf]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{}}
+test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} 1 BOOM!}
+test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit configure; onfinal; track; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c -rc-foo bar]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} {}}
+test iocmd.tf-26.4 {chan configure, set option, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -code break BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -code 444 BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit configure; onfinal; track
+	return -level 55 -code 444 BANG
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo bar} msg opt]
+	note $msg
+	noteOpts $opt
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}} \
+    -constraints {testchannel thread}
+
+# --- === *** ###########################
+# method cget
+
+test iocmd.tf-27.1 {chan configure, get option, ok return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit cget cgetall; onfinal; track; return foo}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c -rc-foo]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{cget rc* -rc-foo} foo}
+test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{cget rc* -rc-foo} 1 BOOM!}
+test iocmd.tf-27.3 {chan configure, get option, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code error BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 BOOM!} \
+    -constraints {testchannel thread}
+test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code continue BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -code 333 BOOM!
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {
+	oninit cget cgetall; onfinal; track
+	return -level 77 -code 333 BANG
+    }
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -rc-foo} msg opt]
+	note $msg
+	noteOpts $opt
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}} \
+    -constraints {testchannel thread}
+
+# --- === *** ###########################
+# method seek
+
+test iocmd.tf-28.1 {chan tell, not supported by handler} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [tell $c]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {-1} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.2 {chan tell, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {tell $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 BOOM!} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {tell $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {tell $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {tell $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {tell $c} msg opt]
+	note $msg
+	noteOpts $opt
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.7 {chan tell, regular return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return 88}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [tell $c]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 88} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.8 {chan tell, negative return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -1}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {tell $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 {Tried to seek before origin}} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.9 {chan tell, string return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {tell $c} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {1 {error during seek on "rc*": invalid argument}} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.11 {chan seek, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 BOOM!} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg opt]
+	note $msg
+	noteOpts $opt
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return -45}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 {Tried to seek before origin}} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return BOGUS}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {seek $c 0 start} msg]
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} \
+    -constraints {testchannel thread}
+test iocmd.tf-28.18 {chan seek, ok result} -match glob -body {
+    set res {}
+    proc foo {args} {oninit seek; onfinal; track; return 23}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [seek $c 0 current]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{seek rc* 0 current} {}} \
+    -constraints {testchannel thread}
+foreach {testname code} {
+    iocmd.tf-28.19.0 start
+    iocmd.tf-28.19.1 current
+    iocmd.tf-28.19.2 end
+} {
+    test $testname "chan seek, base conversion, $code" -match glob -body {
+	set res {}
+	proc foo {args} {oninit seek; onfinal; track; return 0}
+	set c [chan create {r w} foo]
+	notes [inthread $c {
+	    note [seek $c 0 $code]
+	    close $c
+	    notes
+	} c code]
+	rename foo {}
+	set res
+    } -result [list [list seek rc* 0 $code] {}] \
+	-constraints {testchannel thread}
+}
+
+# --- === *** ###########################
+# method blocking
+
+test iocmd.tf-29.1 {chan blocking, no handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {1} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c -blocking 0]
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{} 0} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {1} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c -blocking 0]
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} {} 0} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fconfigure $c -blocking 1]
+	note [fconfigure $c -blocking]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{blocking rc* 1} {} 1} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.6 {chan blocking, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; error BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg]
+	note $msg
+	# Catch the close. It changes blocking mode internally, and runs into the error result.
+	catch {close $c}
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 BOOM!} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg]
+	note $msg
+	catch {close $c}
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg]
+	note $msg
+	catch {close $c}
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg]
+	note $msg
+	catch {close $c}
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 *bad code*} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg opt]
+	note $msg
+	noteOpts $opt
+	catch {close $c}
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}} \
+    -constraints {testchannel thread}
+test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glob -body {
+    set res {}
+    proc foo {args} {oninit blocking; onfinal; track; return BOGUS}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [catch {fconfigure $c -blocking 0} msg]
+	note $msg
+	catch {close $c}
+	notes
+    } c]
+    rename foo {}
+    set res
+} -result {{blocking rc* 0} 0 {}} \
+    -constraints {testchannel thread}
+
+# --- === *** ###########################
+# method watch
+
+test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return IGNORED}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fileevent $c readable {set tick $tick}]
+	close $c		;# 2nd watch, interest zero.
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{watch rc* read} {watch rc* {}} {}}
+test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fileevent $c writable {set tick $tick}]
+	note [fileevent $c writable {}]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} -result {{watch rc* write} {watch rc* {}} {} {}}
+test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fileevent $c writable {set tick $tick}]
+	note [fileevent $c readable {set tick $tick}]
+	note [fileevent $c writable {}]
+	note [fileevent $c readable {}]
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} \
+    -result {{watch rc* write} {watch rc* {read write}} {watch rc* read} {watch rc* {}} {} {} {} {}}
+test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	note [fileevent $c writable {set tick $tick}]
+	note [fileevent $c readable {set tick $tick}] ;# Script is changing,
+	note [fileevent $c readable {set tock $tock}] ;# interest does not.
+	close $c	;# 3rd and 4th watch, removing the event handlers.
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} \
+    -result {{watch rc* write} {watch rc* {read write}} {watch rc* write} {watch rc* {}} {} {} {}}
+
+# --- === *** ###########################
+# postevent
+# Not possible from a thread not containing the command handler.
+# Check that this is rejected.
+
+test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body {
+    set res {}
+    proc foo {args} {oninit; onfinal; track; return}
+    set c [chan create {r w} foo]
+    notes [inthread $c {
+	catch {chan postevent $c r} msg
+	note $msg
+	close $c
+	notes
+    } c]
+    rename foo {}
+    set res
+} -constraints {testchannel thread} \
+    -result {{can not find reflected channel named "rc*"}}
+
+# --- === *** ###########################
+# 'Pull the rug' tests. Create channel in a thread A, move to other
+# thread B, destroy the origin thread (A) before or during access from
+# B. Must not crash, must return proper errors.
+
+test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
+
+    #puts <<$tcltest::mainThread>>main
+    set tida [thread::create -preserved];#puts <<$tida>>
+    thread::send $tida {load {} Tcltest}
+
+    set tidb [thread::create -preserved];#puts <<$tidb>>
+    thread::send $tidb {load {} Tcltest}
+
+    # Set up channel in thread
+    thread::send $tida $helperscript
+    set chan [thread::send $tida {
+	proc foo {args} {oninit seek; onfinal; track; return}
+	set chan [chan create {r w} foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd thread.
+    thread::send $tida [list testchannel cut $chan]
+    thread::send $tidb [list testchannel splice $chan]
+
+    # Kill origin thread, then access channel from 2nd thread.
+    thread::release $tida
+
+    set     res {}
+    lappend res [catch {thread::send $tidb [list puts  $chan shoo]} msg] $msg
+
+    lappend res [catch {thread::send $tidb [list tell  $chan]}      msg] $msg
+    lappend res [catch {thread::send $tidb [list seek  $chan 1]}    msg] $msg
+    lappend res [catch {thread::send $tidb [list gets  $chan]}      msg] $msg
+    lappend res [catch {thread::send $tidb [list close $chan]}      msg] $msg
+    thread::release $tidb
+    set res
+
+} -constraints {testchannel thread} \
+    -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
+
+
+# The test iocmd.tf-32.1 unavoidably exhibits a memory leak.  We are testing
+# the ability of the reflected channel system to react to the situation where
+# the thread in which the driver routines runs exits during driver operations.
+# In this case, thread exit handlers signal back to the owner thread so that the 
+# channel operation does not hang.  There's no way to test this without actually
+# exiting a thread in mid-operation, and that action is unavoidably leaky (which
+# is why [thread::exit] is advised against).
+#
+# Use constraints to skip this test while valgrinding so this expected leak
+# doesn't prevent a finding of "leak-free".
+#
+testConstraint notValgrind [expr {![testConstraint valgrind]}]
+test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {
+
+    #puts <<$tcltest::mainThread>>main
+    set tida [thread::create -preserved];#puts <<$tida>>
+    thread::send $tida {load {} Tcltest}
+    set tidb [thread::create -preserved];#puts <<$tidb>>
+    thread::send $tidb {load {} Tcltest}
+
+    # Set up channel in thread
+    thread::send $tida $helperscript
+    set chan [thread::send $tida {
+	proc foo {args} {
+	    oninit; onfinal; track;
+	    # destroy thread during channel access
+	    thread::exit
+	    }
+	set chan [chan create {r w} foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd thread.
+    thread::send $tida [list testchannel cut    $chan]
+    thread::send $tidb [list testchannel splice $chan]
+
+    # Run access from thread B, wait for response from A (A is not
+    # using event loop at this point, so the event pile up in the
+    # queue.
+
+    thread::send $tidb [list set chan $chan]
+    thread::send $tidb [list set mid [thread::id]]
+    thread::send -async $tidb {
+	# wait a bit, give the main thread the time to start its event
+	# loop to wait for the response from B
+	after 2000
+	catch { puts $chan shoo } res
+	thread::send -async $mid [list set ::res $res]
+    }
+    vwait ::res
+
+    catch {thread::release $tida}
+    thread::release $tidb
+    set res
+} -constraints {testchannel thread notValgrind} \
+    -result {Owner lost}
+
+# ### ### ### ######### ######### #########
+
+# ### ### ### ######### ######### #########
+
+rename track {}
 # cleanup
 foreach file [list test1 test2 test3 test4] {
     removeFile $file
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
new file mode 100644
index 0000000..7f4f7f0
--- /dev/null
+++ b/tests/ioTrans.test
@@ -0,0 +1,1918 @@
+# -*- tcl -*-
+# Functionality covered: operation of the reflected transformation
+#
+# 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) 2007 Andreas Kupries <andreask@activestate.com>
+#                                    <akupries@shaw.ca>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+# Custom constraints used in this file
+testConstraint testchannel [llength [info commands testchannel]]
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+
+# testchannel cut|splice  Both needed to test the reflection in threads.
+# thread::send
+
+#----------------------------------------------------------------------
+
+# ### ### ### ######### ######### #########
+## Testing the reflected transformation.
+
+# Helper commands to record the arguments to handler methods.  Stored in a
+# script so that the tests needing this code do not need their own copy but
+# can access this variable.
+
+set helperscript {
+    if {[lsearch [namespace children] ::tcltest] == -1} {
+	package require tcltest 2
+	namespace import -force ::tcltest::*
+    }
+
+    # This forces the return options to be in the order that the test expects!
+    variable optorder {
+	-code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?!
+	-errorstack !?!
+    }
+    proc noteOpts opts {
+	variable optorder
+	lappend ::res [dict merge $optorder $opts]
+    }
+
+    # Helper command, canned result for 'initialize' method.  Gets the
+    # optional methods as arguments. Use return features to post the result
+    # higher up.
+
+    proc handle.initialize {args} {
+	upvar args hargs
+	if {[lindex $hargs 0] eq "initialize"} {
+	    return -code return [list {*}$args initialize finalize read write]
+	}
+    }
+    proc handle.finalize {} {
+	upvar args hargs
+	if {[lindex $hargs 0] eq "finalize"} {
+	    return -code return ""
+	}
+    }
+    proc handle.read {} {
+	upvar args hargs
+	if {[lindex $hargs 0] eq "read"} {
+	    return -code return "@"
+	}
+    }
+    proc handle.drain {} {
+	upvar args hargs
+	if {[lindex $hargs 0] eq "drain"} {
+	    return -code return "<>"
+	}
+    }
+    proc handle.clear {} {
+	upvar args hargs
+	if {[lindex $hargs 0] eq "clear"} {
+	    return -code return ""
+	}
+    }
+
+    proc tempchan {{mode r+}} {
+	global tempchan
+	return [set tempchan [open [makeFile {test data} tempchanfile] $mode]]
+    }
+    proc tempdone {} {
+	global tempchan
+	catch {close $tempchan}
+	removeFile tempchanfile
+	return
+    }
+    proc tempview {} { viewFile tempchanfile }
+}
+
+# Set everything up in the main thread.
+eval $helperscript
+
+#puts <<[file channels]>>
+
+# ### ### ### ######### ######### #########
+
+test iortrans-1.0 {chan, wrong#args} -returnCodes error -body {
+    chan
+} -result {wrong # args: should be "chan subcommand ?arg ...?"}
+test iortrans-1.1 {chan, unknown method} -returnCodes error -body {
+    chan foo
+} -match glob -result {unknown or ambiguous subcommand "foo": must be*}
+
+# --- --- --- --------- --------- ---------
+# chan push, and method "initalize"
+
+test iortrans-2.0 {chan push, wrong#args, not enough} -returnCodes error -body {
+    chan push
+} -result {wrong # args: should be "chan push channel cmdprefix"}
+test iortrans-2.1 {chan push, wrong#args, too many} -returnCodes error -body {
+    chan push a b c
+} -result {wrong # args: should be "chan push channel cmdprefix"}
+test iortrans-2.2 {chan push, invalid channel} -setup {
+    proc foo {} {}
+} -returnCodes error -body {
+    chan push {} foo
+} -cleanup {
+    rename foo {}
+} -result {can not find channel named ""}
+test iortrans-2.3 {chan push, bad handler, not a list} -body {
+    chan push [tempchan] "foo \{"
+} -returnCodes error -cleanup {
+    tempdone
+} -result {unmatched open brace in list}
+test iortrans-2.4 {chan push, bad handler, not a command} -body {
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+} -result {invalid command name "foo"}
+test iortrans-2.5 {chan push, initialize failed, bad signature} -body {
+    proc foo {} {}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -result {wrong # args: should be "foo"}
+test iortrans-2.6 {chan push, initialize failed, bad signature} -body {
+    proc foo {} {}
+    chan push [tempchan] ::foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -result {wrong # args: should be "::foo"}
+test iortrans-2.7 {chan push, initialize failed, bad result, not a list} -body {
+    proc foo {args} {return "\{"}
+    catch {chan push [tempchan] foo}
+    return $::errorInfo
+} -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {chan handler "foo initialize" returned non-list: *}
+test iortrans-2.8 {chan push, initialize failed, bad result, not a list} -body {
+    proc foo {args} {return \{\{\}}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {chan handler "foo initialize" returned non-list: *}
+test iortrans-2.9 {chan push, initialize failed, bad result, empty list} -body {
+    proc foo {args} {}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {*all required methods*}
+test iortrans-2.10 {chan push, initialize failed, bad result, bogus method name} -body {
+    proc foo {args} {return 1}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {*bad method "1": must be *}
+test iortrans-2.11 {chan push, initialize failed, bad result, bogus method name} -body {
+    proc foo {args} {return {a b c}}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {*bad method "c": must be *}
+test iortrans-2.12 {chan push, initialize failed, bad result, required methods missing} -body {
+    # Required: initialize, and finalize.
+    proc foo {args} {return {initialize}}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {*all required methods*}
+test iortrans-2.13 {chan push, initialize failed, bad result, illegal method name} -body {
+    proc foo {args} {return {initialize finalize BOGUS}}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {*returned bad method "BOGUS": must be clear, drain, finalize, flush, initialize, limit?, read, or write}
+test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler mismatch} -body {
+    proc foo {args} {return {initialize finalize}}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {*makes the channel inaccessible}
+# iortrans-2.15 event/watch methods elimimated, removed these tests.
+# iortrans-2.16
+test iortrans-2.17 {chan push, initialize failed, bad result, drain/read mismatch} -body {
+    proc foo {args} {return {initialize finalize drain write}}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {*supports "drain" but not "read"}
+test iortrans-2.18 {chan push, initialize failed, bad result, flush/write mismatch} -body {
+    proc foo {args} {return {initialize finalize flush read}}
+    chan push [tempchan] foo
+} -returnCodes error -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {*supports "flush" but not "write"}
+test iortrans-2.19 {chan push, initialize ok, creates channel} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	global res
+	lappend res $args
+	if {[lindex $args 0] ne "initialize"} {return}
+	return {initialize finalize drain flush read write}
+    }
+    lappend res [file channel rt*]
+    lappend res [chan push [tempchan] foo]
+    lappend res [close [lindex $res end]]
+    lappend res [file channel rt*]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{} {initialize rt* {read write}} file* {drain rt*} {flush rt*} {finalize rt*} {} {}}
+test iortrans-2.20 {chan push, init failure -> no channel, no finalize} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	global res
+	lappend res $args
+	return
+    }
+    lappend res [file channel rt*]
+    lappend res [catch {chan push [tempchan] foo} msg] $msg
+    lappend res [file channel rt*]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{} {initialize rt* {read write}} 1 {*all required methods*} {}}
+
+# --- --- --- --------- --------- ---------
+# method finalize (via close)
+
+# General note: file channels rt* finds the transform channel, however the
+# name reported will be that of the underlying base driver, fileXX here.  This
+# actually allows us to see if the whole channel is gone, or only the
+# transformation, but not the base.
+
+test iortrans-3.1 {chan finalize, handler destruction has no effect on channel} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    rename foo {}
+    lappend res [file channels file*]
+    lappend res [file channels rt*]
+    lappend res [catch {close $c} msg] $msg
+    lappend res [file channels file*]
+    lappend res [file channels rt*]
+} -cleanup {
+    tempdone
+} -result {{initialize rt* {read write}} file* file* {} 1 {invalid command name "foo"} {} {}}
+test iortrans-3.2 {chan finalize, for close} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    close $c
+    # Close deleted the channel.
+    lappend res [file channels rt*]
+    # Channel destruction does not kill handler command!
+    lappend res [info command foo]
+} -cleanup {
+    rename foo {}
+    tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
+test iortrans-3.3 {chan finalize, for close, error, close error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -code error 5
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res [catch {close $c} msg] $msg
+    # Channel is gone despite error.
+    lappend res [file channels rt*]
+} -cleanup {
+    rename foo {}
+    tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
+test iortrans-3.4 {chan finalize, for close, error, close error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	error FOO
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res [catch {close $c} msg] $msg $::errorInfo
+} -cleanup {
+    rename foo {}
+    tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO {FOO
+*"close $c"}}
+test iortrans-3.5 {chan finalize, for close, arbitrary result, ignored} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return SOMETHING
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res [catch {close $c} msg] $msg
+} -cleanup {
+    rename foo {}
+    tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
+test iortrans-3.6 {chan finalize, for close, break, close error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -code 3
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res [catch {close $c} msg] $msg
+} -cleanup {
+    rename foo {}
+    tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans-3.7 {chan finalize, for close, continue, close error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -code 4
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res [catch {close $c} msg] $msg
+} -cleanup {
+    rename foo {}
+    tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans-3.8 {chan finalize, for close, custom code, close error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -code 777 BANG
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res [catch {close $c} msg] $msg
+} -cleanup {
+    rename foo {}
+    tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans-3.9 {chan finalize, for close, ignore level, close error} -setup {
+    set res {}
+} -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -level 5 -code 777 BANG
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res [catch {close $c} msg opt] $msg
+    noteOpts $opt
+} -match glob -cleanup {
+    rename foo {}
+    tempdone
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}
+
+# --- === *** ###########################
+# method read (via read)
+
+test iortrans-4.1 {chan read, transform call and return} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return snarf
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [read $c 10]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} snarf}
+test iortrans-4.2 {chan read, for non-readable channel} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args MUST_NOT_HAPPEN
+    }
+    set c [chan push [tempchan w] foo]
+    lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {1 {channel "file*" wasn't opened for reading}}
+test iortrans-4.3 {chan read, error return} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code error BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} 1 BOOM!}
+test iortrans-4.4 {chan read, break return is error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code break BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans-4.5 {chan read, continue return is error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code continue BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans-4.6 {chan read, custom return is error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code 777 BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {read $c 2} msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans-4.7 {chan read, level is squashed} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -level 55 -code 777 BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {read $c 2} msg opt] $msg
+    noteOpts $opt
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
+test iortrans-4.8 {chan read, read, bug 2921116} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {fd args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    lappend res [read $c]
+    #lappend res [gets $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} {}}
+test iortrans-4.8.1 {chan read, bug 721ec69271} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {fd args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    chan configure $c -buffersize 2
+    lappend res [read $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* te} {read rt* st} {read rt* { d}} {read rt* at} {read rt* {a
+}} {}}
+test iortrans-4.8.2 {chan read, bug 721ec69271} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {fd args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+	return x
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    chan configure $c -buffersize 1
+    lappend res [read $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* t} {read rt* e} {read rt* s} {read rt* t} {read rt* { }} {read rt* d} {read rt* a} {read rt* t} {read rt* a} {read rt* {
+}} {}}
+test iortrans-4.9 {chan read, gets, bug 2921116} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {fd args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    lappend res [gets $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} {}}
+
+# --- === *** ###########################
+# method write (via puts)
+
+test iortrans-5.1 {chan write, regular write} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return transformresult
+    }
+    set c [chan push [tempchan] foo]
+    puts -nonewline $c snarf
+    flush $c
+    close $c
+    lappend res [tempview]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarf} transformresult}
+test iortrans-5.2 {chan write, no write is ok, no change to file} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return
+    }
+    set c [chan push [tempchan] foo]
+    puts -nonewline $c snarfsnarfsnarf
+    flush $c
+    close $c
+    lappend res [tempview];	# This has to show the original data, as nothing was written
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} {test data}}
+test iortrans-5.3 {chan write, failed write} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code error FAIL!
+    }
+    set c [chan push [tempchan] foo]
+    puts -nonewline $c snarfsnarfsnarf
+    lappend res [catch {flush $c} msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
+test iortrans-5.4 {chan write, non-writable channel} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args MUST_NOT_HAPPEN
+	return
+    }
+    set c [chan push [tempchan r] foo]
+    lappend res [catch {
+	puts -nonewline $c snarfsnarfsnarf
+	flush $c
+    } msg] $msg
+} -cleanup {
+    close $c
+    tempdone
+    rename foo {}
+} -result {1 {channel "file*" wasn't opened for writing}}
+test iortrans-5.5 {chan write, failed write, error return} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code error BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {
+	puts -nonewline $c snarfsnarfsnarf
+	flush $c
+    } msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans-5.6 {chan write, failed write, error return} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	error BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[catch {
+	puts -nonewline $c snarfsnarfsnarf
+	flush $c
+    } msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans-5.7 {chan write, failed write, break return is error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code break BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {
+	puts -nonewline $c snarfsnarfsnarf
+	flush $c
+    } msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans-5.8 {chan write, failed write, continue return is error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code continue BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {
+	puts -nonewline $c snarfsnarfsnarf
+	flush $c
+    } msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans-5.9 {chan write, failed write, custom return is error} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code 777 BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {
+	puts -nonewline $c snarfsnarfsnarf
+	flush $c
+    } msg] $msg
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans-5.10 {chan write, failed write, level is ignored} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -level 55 -code 777 BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [catch {
+	puts -nonewline $c snarfsnarfsnarf
+	flush $c
+    } msg opt] $msg
+    noteOpts $opt
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}}
+test iortrans-5.11 {chan write, bug 2921116} -match glob -setup {
+    set res {}
+    set level 0
+} -body {
+    proc foo {fd args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	# pop - invokes flush - invokes 'foo write' - infinite recursion - stop it
+	global level
+	if {$level} {
+	    return
+	}
+	incr level
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    lappend res [puts -nonewline $c abcdef]
+    lappend res [flush $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{} {write rt* abcdef} {write rt* abcdef} {}}
+
+# --- === *** ###########################
+# method limit?, drain (via read)
+
+test iortrans-6.1 {chan read, read limits} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize limit?
+	handle.finalize
+	lappend ::res $args
+	handle.read
+	return 6
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [read $c 10]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata
+}} {limit? rt*} @@}
+test iortrans-6.2 {chan read, read transform drain on eof} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize drain
+	handle.finalize
+	lappend ::res $args
+	handle.read
+	handle.drain
+	return
+    }
+    set c [chan push [tempchan] foo]
+    lappend res [read $c]
+    lappend res [close $c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} {drain rt*} @<> {}}
+
+# --- === *** ###########################
+# method clear (via puts, seek)
+
+test iortrans-7.1 {chan write, write clears read buffers} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize clear
+	handle.finalize
+	lappend ::res $args
+	handle.clear
+	return transformresult
+    }
+    set c [chan push [tempchan] foo]
+    puts -nonewline $c snarf
+    flush $c
+    return $res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{clear rt*} {write rt* snarf}}
+test iortrans-7.2 {seek clears read buffers} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize clear
+	handle.finalize
+	lappend ::res $args
+	return
+    }
+    set c [chan push [tempchan] foo]
+    seek $c 2
+    return $res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{clear rt*}}
+test iortrans-7.3 {clear, any result is ignored} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize clear
+	handle.finalize
+	lappend ::res $args
+	return -code error "X"
+    }
+    set c [chan push [tempchan] foo]
+    seek $c 2
+    return $res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{clear rt*}}
+test iortrans-7.4 {chan clear, bug 2921116} -match glob -setup {
+    set res {}
+} -body {
+    proc foo {fd args} {
+	handle.initialize clear
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    seek $c 2
+    return $res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{clear rt*}}
+
+# --- === *** ###########################
+# method flush (via seek, close)
+
+test iortrans-8.1 {seek flushes write buffers, ignores data} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize flush
+	handle.finalize
+	lappend ::res $args
+	return X
+    }
+    set c [chan push [tempchan] foo]
+    # Flush, no writing
+    seek $c 2
+    # The close flushes again, this modifies the file!
+    lappend res |
+    lappend res [close $c] | [tempview]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{flush rt*} | {flush rt*} {} | {teXt data}}
+test iortrans-8.2 {close flushes write buffers, writes data} -setup {
+    set res {}
+} -match glob -body {
+    proc foo {args} {
+	handle.initialize flush
+	lappend ::res $args
+	handle.finalize
+	return .flushed.
+    }
+    set c [chan push [tempchan] foo]
+    close $c
+    lappend res [tempview]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{flush rt*} {finalize rt*} .flushed.}
+test iortrans-8.3 {chan flush, bug 2921116} -match glob -setup {
+    set res {}
+} -body {
+    proc foo {fd args} {
+	handle.initialize flush
+	handle.finalize
+	lappend ::res $args
+	# Kill and recreate transform while it is operating
+	chan pop $fd
+	chan push $fd [list foo $fd]
+    }
+    set c [chan push [set c [tempchan]] [list foo $c]]
+    seek $c 2
+    set res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{flush rt*}}
+
+# --- === *** ###########################
+# method watch - removed from TIP (rev 1.12+)
+
+# --- === *** ###########################
+# method event - removed from TIP (rev 1.12+)
+
+# --- === *** ###########################
+# 'Pull the rug' tests. Create channel in a interpreter A, move to other
+# interpreter B, destroy the origin interpreter (A) before or during access
+# from B. Must not crash, must return proper errors.
+test iortrans-11.0 {origin interpreter of moved transform gone} -setup {
+    set ida [interp create];	#puts <<$ida>>
+    set idb [interp create];	#puts <<$idb>>
+    # Magic to get the test* commands in the slaves
+    load {} Tcltest $ida
+    load {} Tcltest $idb
+} -constraints {testchannel} -match glob -body {
+    # Set up channel and transform in interpreter
+    interp eval $ida $helperscript
+    interp eval $ida [list ::variable tempchan [tempchan]]
+    interp transfer {} $::tempchan $ida
+    set chan [interp eval $ida {
+	variable tempchan
+	proc foo {args} {
+	    handle.initialize clear drain flush limit? read write
+	    handle.finalize
+	    lappend ::res $args
+	    return
+	}
+	set chan [chan push $tempchan foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+    # Move channel to 2nd interpreter, transform goes with it.
+    interp eval $ida [list testchannel cut $chan]
+    interp eval $idb [list testchannel splice $chan]
+    # Kill origin interpreter, then access channel from 2nd interpreter.
+    interp delete $ida
+    set res {}
+    lappend res \
+	[catch {interp eval $idb [list puts $chan shoo]} msg] $msg \
+	[catch {interp eval $idb [list tell $chan]} msg] $msg \
+	[catch {interp eval $idb [list seek $chan 1]} msg] $msg \
+	[catch {interp eval $idb [list gets $chan]} msg] $msg \
+	[catch {interp eval $idb [list close $chan]} msg] $msg
+    #lappend res [interp eval $ida {set res}]
+    # actions: clear|write|clear|write|clear|flush|limit?|drain|flush
+    # The 'tell' is ok, as it passed through the transform to the base channel
+    # without invoking the transform handler.
+} -cleanup {
+    tempdone
+} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
+test iortrans-11.1 {origin interpreter of moved transform destroyed during access} -setup {
+    set ida [interp create];	#puts <<$ida>>
+    set idb [interp create];	#puts <<$idb>>
+    # Magic to get the test* commands in the slaves
+    load {} Tcltest $ida
+    load {} Tcltest $idb
+} -constraints {testchannel impossible} -match glob -body {
+    # Set up channel in thread
+    set chan [interp eval $ida $helperscript]
+    set chan [interp eval $ida {
+	proc foo {args} {
+	    handle.initialize clear drain flush limit? read write
+	    handle.finalize
+	    lappend ::res $args
+	    # Destroy interpreter during channel access.  Actually not
+	    # possible for an interp to destroy itself.
+	    interp delete {}
+	    return}
+	set chan [chan push [tempchan] foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+    # Move channel to 2nd thread, transform goes with it.
+    interp eval $ida [list testchannel cut $chan]
+    interp eval $idb [list testchannel splice $chan]
+    # Run access from interpreter B, this will give us a synchronous response.
+    interp eval $idb [list set chan $chan]
+    interp eval $idb [list set mid $tcltest::mainThread]
+    set res [interp eval $idb {
+	# Wait a bit, give the main thread the time to start its event loop to
+	# wait for the response from B
+	after 50
+	catch { puts $chan shoo } res
+	set res
+    }]
+} -cleanup {
+    tempdone
+} -result {Owner lost}
+test iortrans-11.2 {delete interp of reflected transform} -setup {
+    interp create slave
+    # Magic to get the test* commands into the slave
+    load {} Tcltest slave
+} -constraints {testchannel} -body {
+    # Get base channel into the slave
+    set c [tempchan]
+    testchannel cut $c
+    interp eval slave [list testchannel splice $c]
+    interp eval slave [list set c $c]
+    slave eval {
+	proc no-op args {}
+	proc driver {c sub args} {
+	    return {initialize finalize read write}
+	}
+	set t [chan push $c [list driver $c]]
+	chan event $c readable no-op
+    }
+    interp delete slave
+} -cleanup {
+    tempdone
+} -result {}
+
+# ### ### ### ######### ######### #########
+## Same tests as above, but exercising the code forwarding and receiving
+## driver operations to the originator thread.
+
+# ### ### ### ######### ######### #########
+## Testing the reflected channel (Thread forwarding).
+#
+## The id numbers refer to the original test without thread forwarding, and
+## gaps due to tests not applicable to forwarding are left to keep this
+## association.
+
+# ### ### ### ######### ######### #########
+## Helper command. Runs a script in a separate thread and returns the result.
+## A channel is transfered into the thread as well, and a list of configuation
+## variables
+
+proc inthread {chan script args} {
+    # Test thread.
+    set tid [thread::create -preserved]
+    thread::send $tid {load {} Tcltest}
+
+    # Init thread configuration.
+    # - Listed variables
+    # - Id of main thread
+    # - A number of helper commands
+
+    foreach v $args {
+	upvar 1 $v x
+	thread::send $tid [list set $v $x]
+    }
+    thread::send $tid [list set mid [thread::id]]
+    thread::send $tid {
+	proc notes {} {
+	    return $::notes
+	}
+	proc noteOpts opts {
+	    lappend ::notes [dict merge {
+		-code !?! -level !?! -errorcode !?! -errorline !?!
+		-errorinfo !?! -errorstack !?!
+	    } $opts]
+	}
+    }
+    thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*)
+
+    # Transfer channel (cut/splice aka detach/attach)
+
+    testchannel cut $chan
+    thread::send $tid [list testchannel splice $chan]
+
+    # Run test script, also run local event loop!  The local event loop waits
+    # for the result to come back.  It is also necessary for the execution of
+    # forwarded channel operations.
+
+    set ::tres ""
+    thread::send -async $tid {	
+	after 50
+	catch {s} res;	# This runs the script, 's' was defined at (*)
+	thread::send -async $mid [list set ::tres $res]
+    }
+    vwait ::tres
+    # Remove test thread, and return the captured result.
+
+    thread::release $tid
+    return $::tres
+}
+
+# ### ### ### ######### ######### #########
+
+test iortrans.tf-3.2 {chan finalize, for close} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return {}
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res [inthread $c {
+	close $c
+	# Close the deleted the channel.
+	file channels rt*
+    } c]
+    # Channel destruction does not kill handler command!
+    lappend res [info command foo]
+} -cleanup {
+    rename foo {}
+} -result {{initialize rt* {read write}} file* {finalize rt*} {} foo}
+test iortrans.tf-3.3 {chan finalize, for close, error, close error} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -code error 5
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {close $c} msg] $msg
+	# Channel is gone despite error.
+	lappend notes [file channels rt*]
+	notes
+    } c]
+} -cleanup {
+    rename foo {}
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 5 {}}
+test iortrans.tf-3.4 {chan finalize, for close, error, close errror} -setup {
+    set res {}
+} -constraints {testchannel thread} -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	error FOO
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {close $c} msg] $msg
+	notes
+    } c]
+} -match glob -cleanup {
+    rename foo {}
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 FOO}
+test iortrans.tf-3.5 {chan finalize, for close, arbitrary result} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return SOMETHING
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {close $c} msg] $msg
+	notes
+    } c]
+} -cleanup {
+    rename foo {}
+} -result {{initialize rt* {read write}} file* {finalize rt*} 0 {}}
+test iortrans.tf-3.6 {chan finalize, for close, break, close error} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -code 3
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {close $c} msg] $msg
+	notes
+    } c]
+} -cleanup {
+    rename foo {}
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans.tf-3.7 {chan finalize, for close, continue, close error} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -code 4
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {close $c} msg] $msg
+	notes
+    } c]
+} -cleanup {
+    rename foo {}
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans.tf-3.8 {chan finalize, for close, custom code, close error} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -code 777 BANG
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {close $c} msg] $msg
+	notes
+    } c]
+} -cleanup {
+    rename foo {}
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code*}
+test iortrans.tf-3.9 {chan finalize, for close, ignore level, close error} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	lappend ::res $args
+	handle.initialize
+	return -level 5 -code 777 BANG
+    }
+    lappend res [set c [chan push [tempchan] foo]]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {close $c} msg opt] $msg
+	noteOpts $opt
+	notes
+    } c]
+} -cleanup {
+    rename foo {}
+} -result {{initialize rt* {read write}} file* {finalize rt*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}}
+
+# --- === *** ###########################
+# method read
+
+test iortrans.tf-4.1 {chan read, transform call and return} -setup {
+    set res {}
+} -constraints {testchannel thread} -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return snarf
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [read $c 10]
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {{read rt* {test data
+}} snarf}
+test iortrans.tf-4.2 {chan read, for non-readable channel} -setup {
+    set res {}
+} -constraints {testchannel thread} -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args MUST_NOT_HAPPEN
+    }
+    set c [chan push [tempchan w] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {[read $c 2]} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {1 {channel "file*" wasn't opened for reading}}
+test iortrans.tf-4.3 {chan read, error return} -setup {
+    set res {}
+} -constraints {testchannel thread} -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code error BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {read $c 2} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {{read rt* {test data
+}} 1 BOOM!}
+test iortrans.tf-4.4 {chan read, break return is error} -setup {
+    set res {}
+} -constraints {testchannel thread} -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code break BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {read $c 2} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans.tf-4.5 {chan read, continue return is error} -setup {
+    set res {}
+} -constraints {testchannel thread} -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code continue BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {read $c 2} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans.tf-4.6 {chan read, custom return is error} -setup {
+    set res {}
+} -constraints {testchannel thread} -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code 777 BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {read $c 2} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {{read rt* {test data
+}} 1 *bad code*}
+test iortrans.tf-4.7 {chan read, level is squashed} -setup {
+    set res {}
+} -constraints {testchannel thread} -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -level 55 -code 777 BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {read $c 2} msg opt] $msg
+	noteOpts $opt
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {{read rt* {test data
+}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}}
+
+# --- === *** ###########################
+# method write
+
+test iortrans.tf-5.1 {chan write, regular write} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return transformresult
+    }
+    set c [chan push [tempchan] foo]
+    inthread $c {
+	puts -nonewline $c snarf
+	flush $c
+	close $c
+    } c
+    lappend res [tempview]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarf} transformresult}
+test iortrans.tf-5.2 {chan write, no write is ok, no change to file} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return
+    }
+    set c [chan push [tempchan] foo]
+    inthread $c {
+	puts -nonewline $c snarfsnarfsnarf
+	flush $c
+	close $c
+    } c
+    lappend res [tempview];	# This has to show the original data, as nothing was written
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} {test data}}
+test iortrans.tf-5.3 {chan write, failed write} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code error FAIL!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	puts -nonewline $c snarfsnarfsnarf
+	lappend notes [catch {flush $c} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 FAIL!}
+test iortrans.tf-5.4 {chan write, non-writable channel} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args MUST_NOT_HAPPEN
+	return
+    }
+    set c [chan push [tempchan r] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {
+	    puts -nonewline $c snarfsnarfsnarf
+	    flush $c
+	} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {1 {channel "file*" wasn't opened for writing}}
+test iortrans.tf-5.5 {chan write, failed write, error return} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code error BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {
+	    puts -nonewline $c snarfsnarfsnarf
+	    flush $c
+	} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans.tf-5.6 {chan write, failed write, error return} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	error BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {
+	    puts -nonewline $c snarfsnarfsnarf
+	    flush $c
+	} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 BOOM!}
+test iortrans.tf-5.7 {chan write, failed write, break return is error} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code break BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {
+	    puts -nonewline $c snarfsnarfsnarf
+	    flush $c
+	} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans.tf-5.8 {chan write, failed write, continue return is error} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code continue BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {
+	    puts -nonewline $c snarfsnarfsnarf
+	    flush $c
+	} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans.tf-5.9 {chan write, failed write, custom return is error} -setup {
+    set res {}
+} -constraints {testchannel thread} -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -code 777 BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {
+	    puts -nonewline $c snarfsnarfsnarf
+	    flush $c
+	} msg] $msg
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -match glob -result {{write rt* snarfsnarfsnarf} 1 *bad code*}
+test iortrans.tf-5.10 {chan write, failed write, level is ignored} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize
+	handle.finalize
+	lappend ::res $args
+	return -level 55 -code 777 BOOM!
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [catch {
+	    puts -nonewline $c snarfsnarfsnarf
+	    flush $c
+	} msg opt] $msg
+	noteOpts $opt
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{write rt* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline * -errorinfo *bad code*subcommand "write"*}}
+
+# --- === *** ###########################
+# method limit?, drain (via read)
+
+test iortrans.tf-6.1 {chan read, read limits} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize limit?
+	handle.finalize
+	lappend ::res $args
+	handle.read
+	return 6
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [read $c 10]
+	close $c
+	notes
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{limit? rt*} {read rt* {test d}} {limit? rt*} {read rt* {ata
+}} {limit? rt*} @@}
+test iortrans.tf-6.2 {chan read, read transform drain on eof} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize drain
+	handle.finalize
+	lappend ::res $args
+	handle.read
+	handle.drain
+	return
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	lappend notes [read $c]
+	lappend notes [close $c]
+    } c]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{read rt* {test data
+}} {drain rt*} @<> {}}
+
+# --- === *** ###########################
+# method clear (via puts, seek)
+
+test iortrans.tf-7.1 {chan write, write clears read buffers} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize clear
+	handle.finalize
+	lappend ::res $args
+	handle.clear
+	return transformresult
+    }
+    set c [chan push [tempchan] foo]
+    inthread $c {
+	puts -nonewline $c snarf
+	flush $c
+	close $c
+    } c
+    return $res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{clear rt*} {write rt* snarf}}
+test iortrans.tf-7.2 {seek clears read buffers} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize clear
+	handle.finalize
+	lappend ::res $args
+	return
+    }
+    set c [chan push [tempchan] foo]
+    inthread $c {
+	seek $c 2
+	close $c
+    } c
+    return $res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{clear rt*}}
+test iortrans.tf-7.3 {clear, any result is ignored} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize clear
+	handle.finalize
+	lappend ::res $args
+	return -code error "X"
+    }
+    set c [chan push [tempchan] foo]
+    inthread $c {
+	seek $c 2
+	close $c
+    } c
+    return $res
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{clear rt*}}
+
+# --- === *** ###########################
+# method flush (via seek, close)
+
+test iortrans.tf-8.1 {seek flushes write buffers, ignores data} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize flush
+	handle.finalize
+	lappend ::res $args
+	return X
+    }
+    set c [chan push [tempchan] foo]
+    lappend res {*}[inthread $c {
+	# Flush, no writing
+	seek $c 2
+	# The close flushes again, this modifies the file!
+	lappend notes | [close $c] |
+	# NOTE: The flush generated by the close is recorded immediately, the
+	# other note's here are defered until after the thread is done. This
+	# changes the order of the result a bit from the non-threaded case
+	# (The first | moves one to the right). This is an artifact of the
+	# 'inthread' framework, not of the transformation itself.
+	notes
+    } c]
+    lappend res [tempview]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{flush rt*} {flush rt*} | {} | {teXt data}}
+test iortrans.tf-8.2 {close flushes write buffers, writes data} -setup {
+    set res {}
+} -constraints {testchannel thread} -match glob -body {
+    proc foo {args} {
+	handle.initialize flush
+	lappend ::res $args
+	handle.finalize
+	return .flushed.
+    }
+    set c [chan push [tempchan] foo]
+    inthread $c {
+	close $c
+    } c
+    lappend res [tempview]
+} -cleanup {
+    tempdone
+    rename foo {}
+} -result {{flush rt*} {finalize rt*} .flushed.}
+
+# --- === *** ###########################
+# method watch - removed from TIP (rev 1.12+)
+
+# --- === *** ###########################
+# method event - removed from TIP (rev 1.12+)
+
+# --- === *** ###########################
+# 'Pull the rug' tests. Create channel in a thread A, move to other thread B,
+# destroy the origin thread (A) before or during access from B. Must not
+# crash, must return proper errors.
+
+test iortrans.tf-11.0 {origin thread of moved transform gone} -setup {
+    #puts <<$tcltest::mainThread>>main
+    set tida [thread::create -preserved];	#puts <<$tida>>
+    thread::send $tida {load {} Tcltest}
+    set tidb [thread::create -preserved];	#puts <<$tida>>
+    thread::send $tidb {load {} Tcltest}
+} -constraints {testchannel thread} -match glob -body {
+    # Set up channel in thread
+    thread::send $tida $helperscript
+    thread::send $tidb $helperscript
+    set chan [thread::send $tida {
+	proc foo {args} {
+	    handle.initialize clear drain flush limit? read write
+	    handle.finalize
+	    lappend ::res $args
+	    return
+	}
+	set chan [chan push [tempchan] foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd thread, transform goes with it.
+    thread::send $tida [list testchannel cut $chan]
+    thread::send $tidb [list testchannel splice $chan]
+
+    # Kill origin thread, then access channel from 2nd thread.
+    thread::release -wait $tida
+
+    set res {}
+    lappend res [catch {thread::send $tidb [list puts $chan shoo]} msg] $msg
+    lappend res [catch {thread::send $tidb [list tell $chan]} msg] $msg
+    lappend res [catch {thread::send $tidb [list seek $chan 1]} msg] $msg
+    lappend res [catch {thread::send $tidb [list gets $chan]} msg] $msg
+    lappend res [catch {thread::send $tidb [list close $chan]} msg] $msg
+    # The 'tell' is ok, as it passed through the transform to the base
+    # channel without invoking the transform handler.
+} -cleanup {
+    thread::send $tidb tempdone
+    thread::release $tidb
+} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
+
+testConstraint notValgrind [expr {![testConstraint valgrind]}]
+
+test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -setup {
+    #puts <<$tcltest::mainThread>>main
+    set tida [thread::create -preserved];	#puts <<$tida>>
+    thread::send $tida {load {} Tcltest}
+    set tidb [thread::create -preserved];	#puts <<$tidb>>
+    thread::send $tidb {load {} Tcltest}
+} -constraints {testchannel thread notValgrind} -match glob -body {
+    # Set up channel in thread
+    thread::send $tida $helperscript
+    thread::send $tidb $helperscript
+    set chan [thread::send $tida {
+	proc foo {args} {
+	    handle.initialize clear drain flush limit? read write
+	    handle.finalize
+	    lappend ::res $args
+	    # destroy thread during channel access
+	    thread::exit
+	}
+	set chan [chan push [tempchan] foo]
+	fconfigure $chan -buffering none
+	set chan
+    }]
+
+    # Move channel to 2nd thread, transform goes with it.
+    thread::send $tida [list testchannel cut $chan]
+    thread::send $tidb [list testchannel splice $chan]
+
+    # Run access from thread B, wait for response from A (A is not using event
+    # loop at this point, so the event pile up in the queue.
+    thread::send $tidb [list set chan $chan]
+    thread::send $tidb [list set mid [thread::id]]
+    thread::send -async $tidb {
+	# Wait a bit, give the main thread the time to start its event loop to
+	# wait for the response from B
+	after 50
+	catch { puts $chan shoo } res
+	catch { close $chan }
+	thread::send -async $mid [list set ::res $res]
+    }
+    vwait ::res
+    set res
+} -cleanup {
+    thread::send $tidb tempdone
+    thread::release $tidb
+} -result {Owner lost}
+
+# ### ### ### ######### ######### #########
+
+cleanupTests
+return
diff --git a/tests/ioUtil.test b/tests/ioUtil.test
deleted file mode 100644
index 1671572..0000000
--- a/tests/ioUtil.test
+++ /dev/null
@@ -1,310 +0,0 @@
-# This file (ioUtil.test) tests the hookable TclStat(), TclAccess(),
-# and Tcl_OpenFileChannel, routines in the file generic/tclIOUtils.c.
-# Sourcing this file into Tcl runs the tests and generates output for
-# errors. No output means no errors were found. 
-# 
-# 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. 
-# 
-# RCS: @(#) $Id: ioUtil.test,v 1.15 2003/11/14 20:44:46 dgp Exp $
- 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
-    namespace import -force ::tcltest::*
-}
-
-::tcltest::testConstraint testopenfilechannelproc \
-	[llength [info commands testopenfilechannelproc]]
-::tcltest::testConstraint testaccessproc \
-	[llength [info commands testaccessproc]]
-::tcltest::testConstraint teststatproc \
-	[llength [info commands teststatproc]]
-
-set unsetScript {
-    catch {unset testStat1(size)}
-    catch {unset testStat2(size)}
-    catch {unset testStat3(size)}
-}
-
-test ioUtil-1.1 {TclStat: Check that none of the test procs are there.} {} {
-    catch {file stat testStat1%.fil testStat1} err1
-    catch {file stat testStat2%.fil testStat2} err2
-    catch {file stat testStat3%.fil testStat3} err3
-    list $err1 $err2 $err3
-} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} {could not read "testStat3%.fil": no such file or directory}}
-
-test ioUtil-1.2 {TclStatInsertProc: Insert the 3 test TclStat_ procedures.} {teststatproc} {
-    catch {teststatproc insert TclpStat} err1
-    teststatproc insert TestStatProc1
-    teststatproc insert TestStatProc2
-    teststatproc insert TestStatProc3
-    set err1
-} {bad arg "insert": must be TestStatProc1, TestStatProc2, or TestStatProc3}
-
-test ioUtil-1.3 {TclStat: Use "file stat ?" to invoke each procedure.} {teststatproc} {
-    file stat testStat2%.fil testStat2
-    file stat testStat1%.fil testStat1
-    file stat testStat3%.fil testStat3
-
-    list $testStat2(size) $testStat1(size) $testStat3(size)
-} {2345 1234 3456}
-
-eval $unsetScript
-
-test ioUtil-1.4 {TclStatDeleteProc: "TclpStat" function should not be deletable.} {teststatproc} {
-    catch {teststatproc delete TclpStat} err2
-    set err2
-} {"TclpStat": could not be deleteed}
-
-test ioUtil-1.5 {TclStatDeleteProc: Delete the 2nd TclStat procedure.} {teststatproc} {
-    # Delete the 2nd procedure and test that it longer exists but that
-    #   the others do actually return a result.
-
-    teststatproc delete TestStatProc2
-    file stat testStat1%.fil testStat1
-    catch {file stat testStat2%.fil testStat2} err3
-    file stat testStat3%.fil testStat3
-
-    list $testStat1(size) $err3 $testStat3(size)
-} {1234 {could not read "testStat2%.fil": no such file or directory} 3456}
-
-eval $unsetScript
-
-test ioUtil-1.6 {TclStatDeleteProc: Delete the 1st TclStat procedure.} {teststatproc} {
-    # Next delete the 1st procedure and test that only the 3rd procedure
-    #   is the only one that exists.
-
-    teststatproc delete TestStatProc1
-    catch {file stat testStat1%.fil testStat1} err4
-    catch {file stat testStat2%.fil testStat2} err5
-    file stat testStat3%.fil testStat3
-
-    list $err4 $err5 $testStat3(size)
-} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} 3456}
-
-eval $unsetScript
-
-test ioUtil-1.7 {TclStatDeleteProc: Delete the 3rd procedure & verify all are gone.} {teststatproc} {
-    # Finally delete the 3rd procedure and check that none of the
-    #   procedures exist.
-
-    teststatproc delete TestStatProc3
-    catch {file stat testStat1%.fil testStat1} err6
-    catch {file stat testStat2%.fil testStat2} err7
-    catch {file stat testStat3%.fil testStat3} err8
-
-    list $err6 $err7 $err8
-} {{could not read "testStat1%.fil": no such file or directory} {could not read "testStat2%.fil": no such file or directory} {could not read "testStat3%.fil": no such file or directory}}
-
-eval $unsetScript
-
-test ioUtil-1.8 {TclStatDeleteProc: Verify that all procs have been deleted.} {teststatproc} {
-    # Attempt to delete all the Stat procs. again to ensure they no longer
-    #   exist and an error is returned.
-
-    catch {teststatproc delete TestStatProc1} err9
-    catch {teststatproc delete TestStatProc2} err10
-    catch {teststatproc delete TestStatProc3} err11
-
-    list $err9 $err10 $err11
-} {{"TestStatProc1": could not be deleteed} {"TestStatProc2": could not be deleteed} {"TestStatProc3": could not be deleteed}}
-
-eval $unsetScript
-
-test ioUtil-1.9 {TclAccess: Check that none of the test procs are there.} {
-    catch {file exists testAccess1%.fil} err1
-    catch {file exists testAccess2%.fil} err2
-    catch {file exists testAccess3%.fil} err3
-    list $err1 $err2 $err3
-} {0 0 0}
-
-test ioUtil-1.10 {TclAccessInsertProc: Insert the 3 test TclAccess_ procedures.} {testaccessproc} {
-    catch {testaccessproc insert TclpAccess} err1
-    testaccessproc insert TestAccessProc1
-    testaccessproc insert TestAccessProc2
-    testaccessproc insert TestAccessProc3
-    set err1
-} {bad arg "insert": must be TestAccessProc1, TestAccessProc2, or TestAccessProc3}
-
-test ioUtil-2.3 {TclAccess: Use "file access ?" to invoke each procedure.} {testaccessproc} {
-    list [file exists testAccess2%.fil] \
-	    [file exists testAccess1%.fil] \
-	    [file exists testAccess3%.fil]
-} {1 1 1}
-
-test ioUtil-2.4 {TclAccessDeleteProc: "TclpAccess" function should not be deletable.} {testaccessproc} {
-    catch {testaccessproc delete TclpAccess} err2
-    set err2
-} {"TclpAccess": could not be deleteed}
-
-test ioUtil-2.5 {TclAccessDeleteProc: Delete the 2nd TclAccess procedure.} {testaccessproc} {
-    # Delete the 2nd procedure and test that it longer exists but that
-    # the others do actually return a result.
-
-    testaccessproc delete TestAccessProc2
-    set res1 [file exists testAccess1%.fil]
-    catch {file exists testAccess2%.fil} err3
-    set res2 [file exists testAccess3%.fil]
-
-    list $res1 $err3 $res2
-} {1 0 1}
-
-test ioUtil-2.6 {TclAccessDeleteProc: Delete the 1st TclAccess procedure.} {testaccessproc} {
-    # Next delete the 1st procedure and test that only the 3rd procedure
-    #   is the only one that exists.
-
-    testaccessproc delete TestAccessProc1
-    catch {file exists testAccess1%.fil} err4
-    catch {file exists testAccess2%.fil} err5
-    set res3 [file exists testAccess3%.fil]
-
-    list $err4 $err5 $res3
-} {0 0 1}
-
-test ioUtil-2.7 {TclAccessDeleteProc: Delete the 3rd procedure & verify all are gone.} {testaccessproc} {
-    # Finally delete the 3rd procedure and check that none of the
-    #   procedures exist.
-
-    testaccessproc delete TestAccessProc3
-    catch {file exists testAccess1%.fil} err6
-    catch {file exists testAccess2%.fil} err7
-    catch {file exists testAccess3%.fil} err8
-
-    list $err6 $err7 $err8
-} {0 0 0}
-
-test ioUtil-2.8 {TclAccessDeleteProc: Verify that all procs have been deleted.} {testaccessproc} {
-    # Attempt to delete all the Access procs. again to ensure they no longer
-    #   exist and an error is returned.
-
-    catch {testaccessproc delete TestAccessProc1} err9
-    catch {testaccessproc delete TestAccessProc2} err10
-    catch {testaccessproc delete TestAccessProc3} err11
-
-    list $err9 $err10 $err11
-} {{"TestAccessProc1": could not be deleteed} {"TestAccessProc2": could not be deleteed} {"TestAccessProc3": could not be deleteed}}
-
-# Some of the following tests require a writable current directory
-set oldpwd [pwd]
-cd [temporaryDirectory]
-
-test ioUtil-3.1 {TclOpenFileChannel: Check that none of the test procs are there.} {testopenfilechannelproc} {
-    catch {file delete -force {expand}[glob *testOpenFileChannel*]}
-    catch {file exists testOpenFileChannel1%.fil} err1
-    catch {file exists testOpenFileChannel2%.fil} err2
-    catch {file exists testOpenFileChannel3%.fil} err3
-    catch {file exists __testOpenFileChannel1%__.fil} err4
-    catch {file exists __testOpenFileChannel2%__.fil} err5
-    catch {file exists __testOpenFileChannel3%__.fil} err6
-    list $err1 $err2 $err3 $err4 $err5 $err6
-} {0 0 0 0 0 0}
-
-test ioUtil-3.2 {TclOpenFileChannelInsertProc: Insert the 3 test TclOpenFileChannel_ procedures.} {testopenfilechannelproc} {
-    catch {testopenfilechannelproc insert TclpOpenFileChannel} err1
-    testopenfilechannelproc insert TestOpenFileChannelProc1
-    testopenfilechannelproc insert TestOpenFileChannelProc2
-    testopenfilechannelproc insert TestOpenFileChannelProc3
-    set err1
-} {bad arg "insert": must be TestOpenFileChannelProc1, TestOpenFileChannelProc2, or TestOpenFileChannelProc3}
-
-test ioUtil-3.3 {TclOpenFileChannel: Use "file openfilechannel ?" to invoke each procedure.} {testopenfilechannelproc} {
-    close [open __testOpenFileChannel1%__.fil w]
-    close [open __testOpenFileChannel2%__.fil w]
-    close [open __testOpenFileChannel3%__.fil w]
-
-    catch {
-	close [open testOpenFileChannel1%.fil r]
-	close [open testOpenFileChannel2%.fil r]
-	close [open testOpenFileChannel3%.fil r]
-    } err
-
-    file delete __testOpenFileChannel1%__.fil
-    file delete __testOpenFileChannel2%__.fil
-    file delete __testOpenFileChannel3%__.fil
-
-    set err
-} {}
-
-test ioUtil-3.4 {TclOpenFileChannelDeleteProc: "TclpOpenFileChannel" function should not be deletable.} {testopenfilechannelproc} {
-    catch {testopenfilechannelproc delete TclpOpenFileChannel} err2
-    set err2
-} {"TclpOpenFileChannel": could not be deleteed}
-
-test ioUtil-3.5 {TclOpenFileChannelDeleteProc: Delete the 2nd TclOpenFileChannel procedure.} {testopenfilechannelproc} {
-    # Delete the 2nd procedure and test that it longer exists but that
-    #   the others do actually return a result.
-
-    testopenfilechannelproc delete TestOpenFileChannelProc2
-
-    close [open __testOpenFileChannel1%__.fil w]
-    close [open __testOpenFileChannel3%__.fil w]
-
-    catch {
-	close [open testOpenFileChannel1%.fil r]
-	catch {close [open testOpenFileChannel2%.fil r]} msg1
-	close [open testOpenFileChannel3%.fil r]
-    } err3
-
-    file delete __testOpenFileChannel1%__.fil
-    file delete __testOpenFileChannel3%__.fil
-
-    list $err3 $msg1
-} {{} {couldn't open "testOpenFileChannel2%.fil": no such file or directory}}
-
-test ioUtil-3.6 {TclOpenFileChannelDeleteProc: Delete the 1st TclOpenFileChannel procedure.} {testopenfilechannelproc} {
-    # Next delete the 1st procedure and test that only the 3rd procedure
-    #   is the only one that exists.
-
-    testopenfilechannelproc delete TestOpenFileChannelProc1
-
-    close [open __testOpenFileChannel3%__.fil w]
-
-    catch {
-	catch {close [open testOpenFileChannel1%.fil r]} msg2
-	catch {close [open testOpenFileChannel2%.fil r]} msg3
-	close [open testOpenFileChannel3%.fil r]
-    } err4
-
-    file delete __testOpenFileChannel3%__.fil
-
-    list $err4 $msg2 $msg3
-} [list {} \
-	{couldn't open "testOpenFileChannel1%.fil": no such file or directory}\
-	{couldn't open "testOpenFileChannel2%.fil": no such file or directory}]
-
-test ioUtil-3.7 {TclOpenFileChannelDeleteProc: Delete the 3rd procedure & verify all are gone.} {testopenfilechannelproc} {
-    # Finally delete the 3rd procedure and check that none of the
-    #   procedures exist.
-
-    testopenfilechannelproc delete TestOpenFileChannelProc3
-    catch {
-	catch {close [open testOpenFileChannel1%.fil r]} msg4
-	catch {close [open testOpenFileChannel2%.fil r]} msg5
-	catch {close [open testOpenFileChannel3%.fil r]} msg6
-    } err5
-
-    list $err5 $msg4 $msg5 $msg6
-} [list 1 \
-	{couldn't open "testOpenFileChannel1%.fil": no such file or directory}\
-	{couldn't open "testOpenFileChannel2%.fil": no such file or directory}\
-	{couldn't open "testOpenFileChannel3%.fil": no such file or directory}]
-
-test ioUtil-3.8 {TclOpenFileChannelDeleteProc: Verify that all procs have been deleted.} {testopenfilechannelproc} {
-
-    # Attempt to delete all the OpenFileChannel procs. again to ensure they no
-    # longer exist and an error is returned.
-
-    catch {testopenfilechannelproc delete TestOpenFileChannelProc1} err9
-    catch {testopenfilechannelproc delete TestOpenFileChannelProc2} err10
-    catch {testopenfilechannelproc delete TestOpenFileChannelProc3} err11
-
-    list $err9 $err10 $err11
-} {{"TestOpenFileChannelProc1": could not be deleteed} {"TestOpenFileChannelProc2": could not be deleteed} {"TestOpenFileChannelProc3": could not be deleteed}}
-
-cd $oldpwd
-
-# cleanup
-::tcltest::cleanupTests
-return
diff --git a/tests/iogt.test b/tests/iogt.test
index 9e09270..ded8bb9 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -3,28 +3,25 @@
 #
 # This file contains a collection of tests for Giot
 #
-# 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.
 # 
 # Copyright (c) 2000 Ajuba Solutions.
 # Copyright (c) 2000 Andreas Kupries.
 # All rights reserved.
-# 
-# RCS: @(#) $Id: iogt.test,v 1.13 2005/05/10 18:35:22 kennykb Exp $
 
 if {[catch {package require tcltest 2.1}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2.1 required."
     return
 }
-namespace eval ::tcl::test::iogt {
 
-    namespace import ::tcltest::cleanupTests
-    namespace import ::tcltest::makeFile
-    namespace import ::tcltest::removeFile
-    namespace import ::tcltest::test
-    namespace import ::tcltest::testConstraint
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+namespace eval ::tcl::test::iogt {
+    namespace import ::tcltest::*
 
-    testConstraint testchannel [llength [info commands testchannel]]
+testConstraint testchannel [llength [info commands testchannel]]
 
 set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=
 } dummy]
@@ -43,41 +40,38 @@ set path(__echo_srv__.tcl) [makeFile {
 #                     delay between blocks
 #                     blocksize ...
 
-set port   [lindex $argv 0]
+set port [lindex $argv 0]
 set fdelay [lindex $argv 1]
 set idelay [lindex $argv 2]
 set bsizes [lrange $argv 3 end]
-set c      0
+set c 0
 
 proc newconn {sock rhost rport} {
     variable fdelay
     variable c
-    incr   c
-    variable c$c
+    incr c
+    namespace upvar [namespace current] c$c conn
 
     #puts stdout "C $sock $rhost $rport / $fdelay" ; flush stdout
 
-    upvar 0 c$c conn
     set conn(after) {}
     set conn(state) 0
-    set conn(size)  0
-    set conn(data)  ""
+    set conn(size) 0
+    set conn(data) ""
     set conn(delay) $fdelay
 
-    fileevent  $sock readable [list echoGet $c $sock]
+    fileevent $sock readable [list echoGet $c $sock]
     fconfigure $sock -translation binary -buffering none -blocking 0
 }
 
 proc echoGet {c sock} {
     variable fdelay
-    variable c$c
-    upvar 0 c$c conn
+    namespace upvar [namespace current] c$c conn
 
     if {[eof $sock]} {
 	# one-shot echo
 	exit
     }
-
     append conn(data) [read $sock]
 
     #puts stdout "G $c $sock $conn(data) <<$conn(data)>>" ; flush stdout
@@ -91,8 +85,7 @@ proc echoPut {c sock} {
     variable idelay
     variable fdelay
     variable bsizes
-    variable c$c
-    upvar 0 c$c conn
+    namespace upvar [namespace current] c$c conn
 
     if {[string length $conn(data)] == 0} {
 	#puts stdout "C $c $sock" ; flush stdout
@@ -103,9 +96,7 @@ proc echoPut {c sock} {
 	return
     }
 
-
     set conn(delay) $idelay
-
     set n [lindex $bsizes $conn(size)]
 
     #puts stdout "P $c $sock $n >>" ; flush stdout
@@ -114,7 +105,6 @@ proc echoPut {c sock} {
     #parray conn
     #puts n=<$n>
 
-
     if {[string length $conn(data)] >= $n} {
 	puts -nonewline $sock [string range $conn(data) 0 $n]
 	set conn(data) [string range $conn(data) [incr n] end]
@@ -131,44 +121,37 @@ proc echoPut {c sock} {
 #fileevent stdin readable {exit ;#cut}
 
 # main
-socket -server newconn $port
+socket -server newconn -myaddr 127.0.0.1 $port
 vwait forever
 } __echo_srv__.tcl]
 
-
 ########################################################################
 
 proc fevent {fdelay idelay blocks script data} {
-    # start and initialize an echo server, prepare data
-    # transmission, then hand over to the test script.
-    # this has to start real transmission via 'flush'.
-    # The server is stopped after completion of the test.
+    # Start and initialize an echo server, prepare data transmission, then
+    # hand over to the test script.  This has to start real transmission via
+    # 'flush'.  The server is stopped after completion of the test.
 
-    # fixed port, not so good. lets hope for the best, for now.
-    set port 4000
+    upvar 1 sock sk
 
-    exec tclsh __echo_srv__.tcl \
-	    $port $fdelay $idelay {expand}$blocks >@stdout &
+    # Fixed port, not so good. Lets hope for the best, for now.
+    set port 4000
 
+    exec tclsh __echo_srv__.tcl $port $fdelay $idelay {*}$blocks >@stdout &
     after 500
 
-    #puts stdout "> $port" ; flush stdout
-
-    set         sk [socket localhost $port]
-    fconfigure $sk           \
-	    -blocking   0    \
-	    -buffering  full \
-	    -buffersize [expr {10+[llength $data]}]
+    #puts stdout "> $port"; flush stdout
 
+    set sk [socket localhost $port]
+    fconfigure $sk -blocking 0 -buffering full \
+	-buffersize [expr {10+[llength $data]}]
     puts -nonewline $sk $data
 
     # The channel is prepared to go off.
 
-    #puts stdout ">>>>>" ; flush stdout
-
-    uplevel #0 set sock $sk
-    set res [uplevel #0 $script]
+    #puts stdout ">>>>>"; flush stdout
 
+    set res [uplevel 1 $script]
     catch {close $sk}
     return $res
 }
@@ -178,18 +161,15 @@ proc fevent {fdelay idelay blocks script data} {
 
 proc id {op data} {
     switch -- $op {
-	create/write -
-	create/read  -
-	delete/write -
-	delete/read  -
-	clear_read   {;#ignore}
-	flush/write -
-	flush/read  -
-	write       -
-	read        {
+	create/write - create/read - delete/write - delete/read - clear_read {
+	    #ignore
+	}
+	flush/write - flush/read - write - read {
 	    return $data
 	}
-	query/maxRead {return -1}
+	query/maxRead {
+	    return -1
+	}
     }
 }
 
@@ -198,43 +178,34 @@ proc id_optrail {var op data} {
     upvar 0 $var trail
 
     lappend trail $op
-
     switch -- $op {
-	create/write	-	create/read	-
-	delete/write	-	delete/read	-
-	flush/read	-
-	clear/read	{ #ignore }
-	flush/write	-
-	write		-
-	read		{
+	create/write - create/read - delete/write - delete/read -
+	flush/read - clear/read {
+	    #ignore
+	}
+	flush/write - write - read {
 	    return $data
 	}
-	query/maxRead	{
+	query/maxRead {
 	    return -1
 	}
-	default		{
+	default {
 	    lappend trail "error $op"
 	    error $op
 	}
     }
 }
 
-
 proc id_fulltrail {var op data} {
-    variable $var
-    upvar 0 $var trail
+    namespace upvar [namespace current] $var trail
 
     #puts stdout ">> $var $op $data" ; flush stdout
 
     switch -- $op {
-	create/write -	create/read  -
-	delete/write -	delete/read  -
-	clear_read   {
+	create/write - create/read - delete/write - delete/read - clear_read {
 	    set res *ignored*
 	}
-	flush/write -	flush/read  -
-	write       -
-	read        {
+	flush/write - flush/read - write - read {
 	    set res $data
 	}
 	query/maxRead {
@@ -249,19 +220,40 @@ proc id_fulltrail {var op data} {
     return $res
 }
 
+proc id_torture {chan op data} {
+    switch -- $op {
+	create/write -
+	create/read  -
+	delete/write -
+	delete/read  -
+	clear_read   {;#ignore}
+	flush/write -
+	flush/read  {}
+	write       -
+	read        {
+	    testchannel unstack $chan
+	    testchannel transform $chan \
+		-command [namespace code [list id_torture $chan]]
+	    return $data
+	}
+	query/maxRead {return -1}
+    }
+}
+
 proc counter {var op data} {
-    variable $var
-    upvar 0 $var n
+    namespace upvar [namespace current] $var n
 
     switch -- $op {
-	create/write -	create/read  -
-	delete/write -	delete/read  -
-	clear_read   {;#ignore}
-	flush/write  -	flush/read   {return {}}
+	create/write - create/read - delete/write - delete/read - clear_read {
+	    #ignore
+	}
+	flush/write - flush/read {
+	    return {}
+	}
 	write {
 	    return $data
 	}
-	read  {
+	read {
 	    if {$n > 0} {
 		incr n -[string length $data]
 		if {$n < 0} {
@@ -276,25 +268,20 @@ proc counter {var op data} {
     }
 }
 
-
 proc counter_audit {var vtrail op data} {
-    variable $var
-    variable $vtrail
-    upvar 0 $var n $vtrail trail
+    namespace upvar [namespace current] $var n $vtrail trail
 
     switch -- $op {
-	create/write -	create/read  -
-	delete/write -	delete/read  -
-	clear_read   {
+	create/write - create/read - delete/write - delete/read - clear_read {
 	    set res {}
 	}
-	flush/write  -	flush/read   {
+	flush/write - flush/read {
 	    set res {}
 	}
 	write {
 	    set res $data
 	}
-	read  {
+	read {
 	    if {$n > 0} {
 		incr n -[string length $data]
 		if {$n < 0} {
@@ -312,36 +299,28 @@ proc counter_audit {var vtrail op data} {
     return $res
 }
 
-
 proc rblocks {var vtrail n op data} {
-    variable $var
-    variable $vtrail
-    upvar 0 $var buf $vtrail trail
+    namespace upvar [namespace current] $var n $vtrail trail
 
     set res {}
 
     switch -- $op {
-	create/write -	create/read  -
-	delete/write -	delete/read  -
-	clear_read   {
+	create/write - create/read - delete/write - delete/read - clear_read {
 	    set buf {}
 	}
 	flush/write {
 	}
-	flush/read  {
+	flush/read {
 	    set res $buf
 	    set buf {}
 	}
-	write       {
+	write {
 	    set data
 	}
-	read        {
+	read {
 	    append buf $data
-
 	    set b [expr {$n * ([string length $buf] / $n)}]
-
 	    append op " $n [string length $buf] :- $b"
-
 	    set res [string range $buf 0 [incr b -1]]
 	    set buf [string range $buf [incr b] end]
 	    #return $res
@@ -355,36 +334,33 @@ proc rblocks {var vtrail n op data} {
     return $res
 }
 
-
 # --------------------------------------------------------------
 # ... and convenience procedures to stack them
 
 proc identity {-attach channel} {
     testchannel transform $channel -command [namespace code id]
 }
-
 proc audit_ops {var -attach channel} {
     testchannel transform $channel -command [namespace code [list id_optrail $var]]
 }
-
 proc audit_flow {var -attach channel} {
     testchannel transform $channel -command [namespace code [list id_fulltrail $var]]
 }
 
+proc torture {-attach channel} {
+    testchannel transform $channel -command [namespace code [list id_torture $channel]]
+}
+
 proc stopafter {var n -attach channel} {
-    variable $var
-    upvar 0 $var vn
+    namespace upvar [namespace current] $var vn
     set vn $n
     testchannel transform $channel -command [namespace code [list counter $var]]
 }
-
 proc stopafter_audit {var trail n -attach channel} {
-    variable $var
-    upvar 0 $var vn
+    namespace upvar [namespace current] $var vn
     set vn $n
     testchannel transform $channel -command [namespace code [list counter_audit $var $trail]]
 }
-
 proc rblocks_t {var trail n -attach channel} {
     testchannel transform $channel -command [namespace code [list rblocks $var $trail $n]]
 }
@@ -394,36 +370,31 @@ proc rblocks_t {var trail n -attach channel} {
 
 proc array_sget {v} {
     upvar $v a
-
     set res [list]
     foreach n [lsort [array names a]] {
 	lappend res $n $a($n)
     }
     set res
 }
-
 proc asort {alist} {
     # sort a list of key/value pairs by key, removes duplicates too.
-
-    array set  a $alist
+    array set a $alist
     array_sget a
 }
-
+
 ########################################################################
 
 test iogt-1.1 {stack/unstack} testchannel {
     set fh [open $path(dummy) r]
     identity -attach $fh
     testchannel unstack $fh
-    close   $fh
+    close $fh
 } {}
-
 test iogt-1.2 {stack/close} testchannel {
     set fh [open $path(dummy) r]
     identity -attach $fh
-    close   $fh
+    close $fh
 } {}
-
 test iogt-1.3 {stack/unstack, configuration, options} testchannel {
     set fh [open $path(dummy) r]
     set ca [asort [fconfigure $fh]]
@@ -432,79 +403,53 @@ test iogt-1.3 {stack/unstack, configuration, options} testchannel {
     testchannel unstack $fh
     set cc [asort [fconfigure $fh]]
     close $fh
-
-    # With this system none of the buffering, translation and
-    # encoding option may change their values with channels
-    # stacked upon each other or not.
-
+    # With this system none of the buffering, translation and encoding option
+    # may change their values with channels stacked upon each other or not.
     # cb == ca == cc
-
     list [string equal $ca $cb] [string equal $cb $cc] [string equal $ca $cc]
 } {1 1 1}
-
-test iogt-1.4 {stack/unstack, configuration} testchannel {
+test iogt-1.4 {stack/unstack, configuration} -setup {
     set fh [open $path(dummy) r]
+} -constraints testchannel -body {
     set ca [asort [fconfigure $fh]]
     identity -attach $fh
-    fconfigure $fh \
-	    -buffering   line \
-	    -translation cr   \
-	    -encoding    shiftjis
+    fconfigure $fh -buffering line -translation cr -encoding shiftjis
     testchannel unstack $fh
     set cc [asort [fconfigure $fh]]
-
-    set res [list \
-	    [string equal $ca $cc]   \
-	    [fconfigure $fh -buffering]  \
-	    [fconfigure $fh -translation] \
-	    [fconfigure $fh -encoding]    \
-	    ]
-
+    list [string equal $ca $cc] [fconfigure $fh -buffering] \
+	[fconfigure $fh -translation] [fconfigure $fh -encoding]
+} -cleanup {
     close $fh
-    set res
-} {0 line cr shiftjis}
+} -result {0 line cr shiftjis}
 
-test iogt-2.0 {basic I/O going through transform} testchannel {
-    set fin  [open $path(dummy)    r]
+test iogt-2.0 {basic I/O going through transform} -setup {
+    set fin [open $path(dummy) r]
     set fout [open $path(dummyout) w]
-
+} -constraints testchannel -body {
     identity -attach $fin
     identity -attach $fout
-
     fcopy $fin $fout
-
     close $fin
     close $fout
-
-    set fin  [open $path(dummy)    r]
+    set fin [open $path(dummy) r]
     set fout [open $path(dummyout) r]
-
-    set res     [string equal [set in [read $fin]] [set out [read $fout]]]
-    lappend res [string length $in] [string length $out]
-
+    list [string equal [set in [read $fin]] [set out [read $fout]]] \
+	[string length $in] [string length $out]
+} -cleanup {
     close $fin
     close $fout
-
-    set res
-} {1 71 71}
-
-
+} -result {1 71 71}
 test iogt-2.1 {basic I/O, operation trail} {testchannel unix} {
-    set fin  [open $path(dummy)    r]
+    set fin [open $path(dummy) r]
     set fout [open $path(dummyout) w]
-
-    set ain [list] ; set aout [list]
-    audit_ops ain  -attach $fin
+    set ain [list]; set aout [list]
+    audit_ops ain -attach $fin
     audit_ops aout -attach $fout
-
-    fconfigure $fin  -buffersize 10
+    fconfigure $fin -buffersize 10
     fconfigure $fout -buffersize 10
-
     fcopy $fin $fout
-
     close $fin
     close $fout
-
     set res "[join $ain \n]\n--------\n[join $aout \n]"
 } {create/read
 query/maxRead
@@ -538,23 +483,17 @@ write
 write
 flush/write
 delete/write}
-
 test iogt-2.2 {basic I/O, data trail} {testchannel unix} {
-    set fin  [open $path(dummy)    r]
+    set fin [open $path(dummy) r]
     set fout [open $path(dummyout) w]
-
-    set ain [list] ; set aout [list]
-    audit_flow ain  -attach $fin
+    set ain [list]; set aout [list]
+    audit_flow ain -attach $fin
     audit_flow aout -attach $fout
-
-    fconfigure $fin  -buffersize 10
+    fconfigure $fin -buffersize 10
     fconfigure $fout -buffersize 10
-
     fcopy $fin $fout
-
     close $fin
     close $fout
-
     set res "[join $ain \n]\n--------\n[join $aout \n]"
 } {create/read {} *ignored*
 query/maxRead {} -1
@@ -592,24 +531,17 @@ write {
 }
 flush/write {} {}
 delete/write {} *ignored*}
-
-
 test iogt-2.3 {basic I/O, mixed trail} {testchannel unix} {
-    set fin  [open $path(dummy)    r]
+    set fin [open $path(dummy) r]
     set fout [open $path(dummyout) w]
-
     set trail [list]
     audit_flow trail -attach $fin
     audit_flow trail -attach $fout
-
-    fconfigure $fin  -buffersize 20
+    fconfigure $fin -buffersize 20
     fconfigure $fout -buffersize 10
-
     fcopy $fin $fout
-
     close $fin
     close $fout
-
     join $trail \n
 } {create/read {} *ignored*
 create/write {} *ignored*
@@ -639,110 +571,90 @@ delete/read {} *ignored*
 flush/write {} {}
 delete/write {} *ignored*}
 
+test iogt-2.4 {basic I/O, mixed trail} {testchannel} {
+    set fh [open $path(dummy) r]
+    torture -attach $fh
+    chan configure $fh -buffersize 2
+    set x [read $fh]
+    testchannel unstack $fh
+    close   $fh
+    set x
+} {}
 
-test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
-	{testchannel unknownFailure} {
-    # This test to check the validity of aquired Tcl_Channel references is
-    # not possible because even a backgrounded fcopy will immediately start
-    # to copy data, without waiting for the event loop. This is done only in
-    # case of an underflow on the read size!. So stacking transforms after the
+test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
+    proc DoneCopy {n {err {}}} {
+	variable copy 1
+    }
+} -constraints {testchannel hangs} -body {
+    # This test to check the validity of aquired Tcl_Channel references is not
+    # possible because even a backgrounded fcopy will immediately start to
+    # copy data, without waiting for the event loop. This is done only in case
+    # of an underflow on the read size!. So stacking transforms after the
     # fcopy will miss information, or are not used at all.
     #
     # I was able to circumvent this by using the echo.tcl server with a big
     # delay, causing the fcopy to underflow immediately.
-
-    proc DoneCopy {n {err {}}} {
-	variable copy ; set copy 1
-    }
-
-    set fin  [open $path(dummy) r]
-
+    set fin [open $path(dummy) r]
     fevent 1000 500 {20 20 20 10 1 1} {
 	close $fin
-
-	set          fout [open dummyout w]
-
-	flush $sock ; # now, or fcopy will error us out
-	# But the 1 second delay should be enough to
-	# initialize everything else here.
-
+	set fout [open dummyout w]
+	flush $sock;	# now, or fcopy will error us out
+	# But the 1 second delay should be enough to initialize everything
+	# else here.
 	fcopy $sock $fout -command [namespace code DoneCopy]
-
-	# transform after fcopy got its handles !
-	# They should be still valid for fcopy.
-
+	# Transform after fcopy got its handles!  They should be still valid
+	# for fcopy.
 	set trail [list]
 	audit_ops trail -attach $fout
-
 	vwait [namespace which -variable copy]
-    } [read $fin] ; # {}
-
+    } [read $fin];	# {}
     close $fout
-
-    rename DoneCopy {}
-
     # Check result of copy.
-
-    set fin  [open $path(dummy)    r]
+    set fin [open $path(dummy) r]
     set fout [open $path(dummyout) r]
-
     set res [string equal [read $fin] [read $fout]]
-
     close $fin
     close $fout
-
     list $res $trail
-} {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
-
+} -cleanup {
+    rename DoneCopy {}
+} -result {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
 
-test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
-    set fin  [open $path(dummy) r]
+test iogt-4.0 {fileevent readable, after transform} -setup {
+    set fin [open $path(dummy) r]
     set data [read $fin]
     close $fin
-
     set trail [list]
-    set got   [list]
-
+    set got [list]
     proc Done {args} {
-	variable stop
-	set    stop 1
+	variable stop 1
     }
-
-    proc Get {sock} {
-	variable trail
-	variable got
-	if {[eof $sock]} {
-	    Done
-	    lappend trail "xxxxxxxxxxxxx"
-	    close $sock
-	    return
-	}
-	lappend trail "vvvvvvvvvvvvv"
-	lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
-	lappend trail "============="
-	#puts stdout $__ ; flush stdout
-	#read $sock
-    }
-
+} -constraints {testchannel hangs} -body {
     fevent 1000 500 {20 20 20 10 1} {
-	audit_flow trail   -attach $sock
-	rblocks_t  rbuf trail 23 -attach $sock
-
-	fileevent $sock readable [list Get $sock]
-
-	flush $sock ; # now, or fcopy will error us out
-	# But the 1 second delay should be enough to
-	# initialize everything else here.
-
+	audit_flow trail -attach $sock
+	rblocks_t rbuf trail 23 -attach $sock
+	fileevent $sock readable [namespace code {
+	    if {[eof $sock]} {
+		Done
+		lappend trail "xxxxxxxxxxxxx"
+		close $sock
+	    } else {
+		lappend trail "vvvvvvvvvvvvv"
+		lappend trail "\tgot: [lappend got "\[\[[read $sock]\]\]"]"
+		lappend trail "============="
+		#puts stdout $__; flush stdout
+		#read $sock
+	    }
+	}]
+	flush $sock;		# Now, or fcopy will error us out
+	# But the 1 second delay should be enough to initialize everything
+	# else here.
 	vwait [namespace which -variable stop]
     } $data
-
-
-    rename Done {}
-    rename Get {}
-
     join [list [join $got \n] ~~~~~~~~ [join $trail \n]] \n
-} {[[]]
+} -cleanup {
+    rename Done {}
+} -result {[[]]
 [[abcdefghijklmnopqrstuvw]]
 [[xyz0123456789,./?><;'\|]]
 [[]]
@@ -823,35 +735,27 @@ rblock | delete/write {} {} | {}
 rblock | delete/read {} {} | {}
 flush/write {} {}
 delete/write {} *ignored*
-delete/read {} *ignored*}  ; # catch unescaped quote "
-
+delete/read {} *ignored*};	# catch unescaped quote "
 
-test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
-    set fin  [open $path(dummy)    r]
+test iogt-5.0 {EOF simulation} -setup {
+    set fin [open $path(dummy) r]
     set fout [open $path(dummyout) w]
-
     set trail [list]
-
+} -constraints {testchannel unknownFailure} -result {
     audit_flow trail -attach $fin
-    stopafter_audit d trail 20 -attach   $fin
+    stopafter_audit d trail 20 -attach $fin
     audit_flow trail -attach $fout
-
-    fconfigure $fin  -buffersize 20
+    fconfigure $fin -buffersize 20
     fconfigure $fout -buffersize 10
-
-    fcopy   $fin $fout
+    fcopy $fin $fout
     testchannel unstack $fin
-
     # now copy the rest in the channel
     lappend trail {**after unstack**}
-
     fcopy $fin $fout
-
     close $fin
     close $fout
-
     join $trail \n
-} {create/read {} *ignored*
+} -result {create/read {} *ignored*
 counter:create/read {} {}
 create/write {} *ignored*
 counter:query/maxRead {} 20
@@ -882,66 +786,51 @@ delete/read {} *ignored*
 flush/write {} {}
 delete/write {} *ignored*}
 
-
-
-
-
 proc constX {op data} {
     # replace anything coming in with a same-length string of x'es.
     switch -- $op {
-	create/write -	create/read  -
-	delete/write -	delete/read  -
-	clear_read   {;#ignore}
-	flush/write -	flush/read  -
-	write       -
-	read        {
+	create/write - create/read - delete/write - delete/read - clear_read {
+	    #ignore
+	}
+	flush/write - flush/read - write - read {
 	    return [string repeat x [string length $data]]
 	}
-	query/maxRead {return -1}
+	query/maxRead {
+	    return -1
+	}
     }
 }
-
 proc constx {-attach channel} {
     testchannel transform $channel -command [namespace code constX]
 }
 
-test iogt-6.0 {Push back} testchannel {
+test iogt-6.0 {Push back} -constraints testchannel -body {
     set f [open $path(dummy) r]
-
     # contents of dummy = "abcdefghi..."
-    read $f 3 ; # skip behind "abc"
-
+    read $f 3;		# skip behind "abc"
     constx -attach $f
-
-    # expect to get "xxx" from the transform because
-    # of unread "def" input to transform which returns "xxx".
+    # expect to get "xxx" from the transform because of unread "def" input to
+    # transform which returns "xxx".
     #
-    # Actually the IO layer pre-read the whole file and will
-    # read "def" directly from the buffer without bothering
-    # to consult the newly stacked transformation. This is
-    # wrong.
-
-    set res [read $f 3]
+    # Actually the IO layer pre-read the whole file and will read "def"
+    # directly from the buffer without bothering to consult the newly stacked
+    # transformation. This is wrong.
+    read $f 3
+} -cleanup {
     close $f
-    set res
-} {xxx}
-
-test iogt-6.1 {Push back and up} {testchannel knownBug} {
+} -result {xxx}
+test iogt-6.1 {Push back and up} -constraints {testchannel knownBug} -body {
     set f [open $path(dummy) r]
-
     # contents of dummy = "abcdefghi..."
-    read $f 3 ; # skip behind "abc"
-
+    read $f 3;		# skip behind "abc"
     constx -attach $f
     set res [read $f 3]
-
     testchannel unstack $f
     append res [read $f 3]
+} -cleanup {
     close $f
-    set res
-} {xxxghi}
-
-
+} -result {xxxghi}
+
 # cleanup
 foreach file [list dummy dummyout __echo_srv__.tcl] {
     removeFile $file
diff --git a/tests/join.test b/tests/join.test
index 562c3e0..4abe233 100644
--- a/tests/join.test
+++ b/tests/join.test
@@ -10,14 +10,12 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: join.test,v 1.6 2004/05/19 10:51:06 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-
+
 test join-1.1 {basic join commands} {
     join {a b c} xyz
 } axyzbxyzc
@@ -33,22 +31,25 @@ test join-1.4 {basic join commands} {
 
 test join-2.1 {join errors} {
     list [catch join msg] $msg $errorCode
-} {1 {wrong # args: should be "join list ?joinString?"} NONE}
+} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
 test join-2.2 {join errors} {
     list [catch {join a b c} msg] $msg $errorCode
-} {1 {wrong # args: should be "join list ?joinString?"} NONE}
+} {1 {wrong # args: should be "join list ?joinString?"} {TCL WRONGARGS}}
 test join-2.3 {join errors} {
     list [catch {join "a \{ c" 111} msg] $msg $errorCode
-} {1 {unmatched open brace in list} NONE}
+} {1 {unmatched open brace in list} {TCL VALUE LIST BRACE}}
 
 test join-3.1 {joinString is binary ok} {
   string length [join {a b c} a\0b]
 } 9
-
 test join-3.2 {join is binary ok} {
   string length [join "a\0b a\0b a\0b"]
 } 11
-
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/lindex.test b/tests/lindex.test
index 7fcc24a..b86e2e0 100644
--- a/tests/lindex.test
+++ b/tests/lindex.test
@@ -11,14 +11,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: lindex.test,v 1.13 2005/05/10 18:35:22 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2.2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 set minus -
 testConstraint testevalex [llength [info commands testevalex]]
 
@@ -26,7 +27,7 @@ testConstraint testevalex [llength [info commands testevalex]]
 
 test lindex-1.1 {wrong # args} testevalex {
     list [catch {testevalex lindex} result] $result
-} "1 {wrong # args: should be \"lindex list ?index...?\"}"
+} "1 {wrong # args: should be \"lindex list ?index ...?\"}"
 
 # Indices that are lists or convertible to lists
 
@@ -34,18 +35,15 @@ test lindex-2.1 {empty index list} testevalex {
     set x {}
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {{a b c} {a b c}}
-
 test lindex-2.2 {singleton index list} testevalex {
     set x { 1 }
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {b b}
-
 test lindex-2.3 {multiple indices in list} testevalex {
     set x {1 2}
     list [testevalex {lindex {{a b c} {d e f}} $x}] \
 	[testevalex {lindex {{a b c} {d e f}} $x}]
 } {f f}
-
 test lindex-2.4 {malformed index list} testevalex {
     set x \{
     list [catch { testevalex {lindex {a b c} $x} } result] $result
@@ -57,32 +55,26 @@ test lindex-3.1 {integer -1} testevalex {
     set x ${minus}1
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {{} {}}
-
 test lindex-3.2 {integer 0} testevalex {
     set x [string range 00 0 0]
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {a a}
-
 test lindex-3.3 {integer 2} testevalex {
     set x [string range 22 0 0]
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {c c}
-
 test lindex-3.4 {integer 3} testevalex {
     set x [string range 33 0 0]
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {{} {}}
-
-test lindex-3.5 {bad octal} testevalex {
-    set x 08
+test lindex-3.5 {bad octal} -constraints testevalex -body {
+    set x 0o8
     list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
-test lindex-3.6 {bad octal} testevalex {
-    set x -09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-3.6 {bad octal} -constraints testevalex -body {
+    set x -0o9
     list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
+} -match glob -result {1 {*invalid octal number*}}
 test lindex-3.7 {indexes don't shimmer wide ints} {
     set x [expr {(wide(1)<<31) - 2}]
     list $x [lindex {1 2 3} $x] [incr x] [incr x]
@@ -94,47 +86,38 @@ test lindex-4.1 {index = end} testevalex {
     set x end
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {c c}
-
 test lindex-4.2 {index = end--1} testevalex {
     set x end--1
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {{} {}}
-
 test lindex-4.3 {index = end-0} testevalex {
     set x end-0
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {c c}
-
 test lindex-4.4 {index = end-2} testevalex {
     set x end-2
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {a a}
-
 test lindex-4.5 {index = end-3} testevalex {
     set x end-3
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {{} {}}
-
-test lindex-4.6 {bad octal} testevalex {
-    set x end-08
+test lindex-4.6 {bad octal} -constraints testevalex -body {
+    set x end-0o8
     list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
-test lindex-4.7 {bad octal} testevalex {
-    set x end--09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-4.7 {bad octal} -constraints testevalex -body {
+    set x end--0o9
     list [catch { testevalex {lindex {a b c} $x} } result] $result
-} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}}
-
+} -match glob -result {1 {*invalid octal number*}}
 test lindex-4.8 {bad integer, not octal} testevalex {
     set x end-0a2
     list [catch { testevalex {lindex {a b c} $x} } result] $result
 } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
 test lindex-4.9 {obsolete test} testevalex {
     set x end
     list [testevalex {lindex {a b c} $x}] [testevalex {lindex {a b c} $x}]
 } {c c}
-
 test lindex-4.10 {incomplete end-} testevalex {
     set x end-
     list [catch { testevalex {lindex {a b c} $x} } result] $result
@@ -143,14 +126,13 @@ test lindex-4.10 {incomplete end-} testevalex {
 test lindex-5.1 {bad second index} testevalex {
     list [catch { testevalex {lindex {a b c} 0 0a2} } result] $result
 } {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
 test lindex-5.2 {good second index} testevalex {
     testevalex {lindex {{a b c} {d e f} {g h i}} 1 2}
 } f
-
 test lindex-5.3 {three indices} testevalex {
     testevalex {lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1}
 } f
+
 test lindex-6.1 {error conditions in parsing list} testevalex {
     list [catch {testevalex {lindex "a \{" 2}} msg] $msg
 } {1 {unmatched open brace in list}}
@@ -178,7 +160,6 @@ test lindex-8.1 {data reuse} testevalex {
     set x 0
     testevalex {lindex $x $x}
 } {0}
-
 test lindex-8.2 {data reuse} testevalex {
     set a 0
     testevalex {lindex $a $a $a}
@@ -187,22 +168,18 @@ test lindex-8.3 {data reuse} testevalex {
     set a 1
     testevalex {lindex $a $a $a}
 } {}
-
 test lindex-8.4 {data reuse} testevalex {
     set x [list 0 0]
     testevalex {lindex $x $x}
 } {0}
-
 test lindex-8.5 {data reuse} testevalex {
     set x 0
     testevalex {lindex $x [list $x $x]}
 } {0}
-
 test lindex-8.6 {data reuse} testevalex {
     set x [list 1 1]
     testevalex {lindex $x $x}
 } {}
-
 test lindex-8.7 {data reuse} testevalex {
     set x 1
     testevalex {lindex $x [list $x $x]}
@@ -214,7 +191,14 @@ test lindex-8.7 {data reuse} testevalex {
 
 test lindex-9.1 {wrong # args} {
     list [catch {lindex} result] $result
-} "1 {wrong # args: should be \"lindex list ?index...?\"}"
+} "1 {wrong # args: should be \"lindex list ?index ...?\"}"
+test lindex-9.2 {ensure that compilation works in the right order} {
+    proc foo {} {
+	rename foo {}
+	lindex 1 0
+    }
+    foo
+} 1
 
 # Indices that are lists or convertible to lists
 
@@ -225,7 +209,6 @@ test lindex-10.1 {empty index list} {
     } result
     set result
 } {{a b c} {a b c}}
-
 test lindex-10.2 {singleton index list} {
     set x { 1 }
     catch {
@@ -233,7 +216,6 @@ test lindex-10.2 {singleton index list} {
     } result
     set result
 } {b b}
-
 test lindex-10.3 {multiple indices in list} {
     set x {1 2}
     catch {
@@ -241,7 +223,6 @@ test lindex-10.3 {multiple indices in list} {
     } result
     set result
 } {f f}
-
 test lindex-10.4 {malformed index list} {
     set x \{
     list [catch { lindex {a b c} $x } result] $result
@@ -256,7 +237,6 @@ test lindex-11.1 {integer -1} {
     } result
     set result
 } {{} {}}
-
 test lindex-11.2 {integer 0} {
     set x [string range 00 0 0]
     catch {
@@ -264,7 +244,6 @@ test lindex-11.2 {integer 0} {
     } result
     set result
 } {a a}
-
 test lindex-11.3 {integer 2} {
     set x [string range 22 0 0]
     catch {
@@ -272,7 +251,6 @@ test lindex-11.3 {integer 2} {
     } result
     set result
 } {c c}
-
 test lindex-11.4 {integer 3} {
     set x [string range 33 0 0]
     catch {
@@ -280,16 +258,14 @@ test lindex-11.4 {integer 3} {
     } result
     set result
 } {{} {}}
-
-test lindex-11.5 {bad octal} {
-    set x 08
+test lindex-11.5 {bad octal} -body {
+    set x 0o8
     list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
-test lindex-11.6 {bad octal} {
-    set x -09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-11.6 {bad octal} -body {
+    set x -0o9
     list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "-09": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
+} -match glob -result {1 {*invalid octal number*}}
 
 # Indices relative to end
 
@@ -300,7 +276,6 @@ test lindex-12.1 {index = end} {
     } result
     set result
 } {c c}
-
 test lindex-12.2 {index = end--1} {
     set x end--1
     catch {
@@ -308,7 +283,6 @@ test lindex-12.2 {index = end--1} {
     } result
     set result
 } {{} {}}
-
 test lindex-12.3 {index = end-0} {
     set x end-0
     catch {
@@ -316,7 +290,6 @@ test lindex-12.3 {index = end-0} {
     } result
     set result
 } {c c}
-
 test lindex-12.4 {index = end-2} {
     set x end-2
     catch {
@@ -324,7 +297,6 @@ test lindex-12.4 {index = end-2} {
     } result
     set result
 } {a a}
-
 test lindex-12.5 {index = end-3} {
     set x end-3
     catch {
@@ -332,22 +304,18 @@ test lindex-12.5 {index = end-3} {
     } result
     set result
 } {{} {}}
-
-test lindex-12.6 {bad octal} {
-    set x end-08
+test lindex-12.6 {bad octal} -body {
+    set x end-0o8
     list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "end-08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-
-test lindex-12.7 {bad octal} {
-    set x end--09
+} -match glob -result {1 {*invalid octal number*}}
+test lindex-12.7 {bad octal} -body {
+    set x end--0o9
     list [catch { lindex {a b c} $x } result] $result
-} {1 {bad index "end--09": must be integer?[+-]integer? or end?[+-]integer?}}
-
+} -match glob -result {1 {*invalid octal number*}}
 test lindex-12.8 {bad integer, not octal} {
     set x end-0a2
     list [catch { lindex {a b c} $x } result] $result
 } {1 {bad index "end-0a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
 test lindex-12.9 {obsolete test} {
     set x end
     catch {
@@ -355,7 +323,6 @@ test lindex-12.9 {obsolete test} {
     } result
     set result
 } {c c}
-
 test lindex-12.10 {incomplete end-} {
     set x end-
     list [catch { lindex {a b c} $x } result] $result
@@ -364,14 +331,12 @@ test lindex-12.10 {incomplete end-} {
 test lindex-13.1 {bad second index} {
     list [catch { lindex {a b c} 0 0a2 } result] $result
 } {1 {bad index "0a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
 test lindex-13.2 {good second index} {
     catch {
 	lindex {{a b c} {d e f} {g h i}} 1 2
     } result
     set result
 } f
-
 test lindex-13.3 {three indices} {
     catch {
 	lindex {{{a b} {c d}} {{e f} {g h}}} 1 0 1
@@ -421,7 +386,6 @@ test lindex-16.1 {data reuse} {
     } result
     set result
 } {0}
-
 test lindex-16.2 {data reuse} {
     set a 0
     catch {
@@ -436,7 +400,6 @@ test lindex-16.3 {data reuse} {
     } result
     set result
 } {}
-
 test lindex-16.4 {data reuse} {
     set x [list 0 0]
     catch {
@@ -444,7 +407,6 @@ test lindex-16.4 {data reuse} {
     } result
     set result
 } {0}
-
 test lindex-16.5 {data reuse} {
     set x 0
     catch {
@@ -452,7 +414,6 @@ test lindex-16.5 {data reuse} {
     } result
     set result
 } {0}
-
 test lindex-16.6 {data reuse} {
     set x [list 1 1]
     catch {
@@ -460,7 +421,6 @@ test lindex-16.6 {data reuse} {
     } result
     set result
 } {}
-
 test lindex-16.7 {data reuse} {
     set x 1
     catch {
@@ -469,8 +429,30 @@ test lindex-16.7 {data reuse} {
     set result
 } {}
 
+test lindex-17.0 {Bug 1718580} {*}{
+    -body {
+        lindex {} end foo
+    } 
+    -match glob
+    -result {bad index "foo"*}
+    -returnCodes 1
+}
+
+test lindex-17.1 {Bug 1718580} {*}{
+    -body {
+        lindex a end foo
+    } 
+    -match glob
+    -result {bad index "foo"*}
+    -returnCodes 1
+}
+
 catch { unset minus }
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/link.test b/tests/link.test
index 765f4b9..00e490c 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -1,223 +1,264 @@
 # Commands covered:  none
 #
-# This file contains a collection of tests for Tcl_LinkVar and related
-# library procedures.  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 Tcl_LinkVar and related library
+# procedures. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
 #
 # Copyright (c) 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.
-#
-# RCS: @(#) $Id: link.test,v 1.7 2002/06/22 04:19:47 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-::tcltest::testConstraint testlink \
-        [expr {[info commands testlink] != {}}]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testlink [llength [info commands testlink]]
 
 foreach i {int real bool string} {
-    catch {unset $i}
+    unset -nocomplain $i
 }
-test link-1.1 {reading C variables from Tcl} {testlink} {
+
+test link-1.1 {reading C variables from Tcl} -constraints {testlink} -setup {
     testlink delete
-    testlink set 43 1.23 4 - 12341234
-    testlink create 1 1 1 1 1
+} -body {
+    testlink set 43 1.23 4 - 12341234 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list $int $real $bool $string $wide
-} {43 1.23 1 NULL 12341234}
-test link-1.2 {reading C variables from Tcl} {testlink} {
+} -result {43 1.23 1 NULL 12341234}
+test link-1.2 {reading C variables from Tcl} -constraints {testlink} -setup {
     testlink delete
-    testlink create 1 1 1 1 1
-    testlink set -3 2 0 "A long string with spaces"  43214321
+} -body {
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    testlink set -3 2 0 "A long string with spaces"  43214321 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     list $int $real $bool $string $wide $int $real $bool $string $wide
-} {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
+} -result {-3 2.0 0 {A long string with spaces} 43214321 -3 2.0 0 {A long string with spaces} 43214321}
 
-test link-2.1 {writing C variables from Tcl} {testlink} {
+test link-2.1 {writing C variables from Tcl} -constraints {testlink} -setup {
     testlink delete
-    testlink set 43 1.21 4 - 56785678
-    testlink create 1 1 1 1 1
-    set int "00721"
+} -body {
+    testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    set int "0o0721"
     set real -10.5
     set bool true
     set string abcdef
     set wide 135135
-    concat [testlink get] $int $real $bool $string $wide
-} {465 -10.5 1 abcdef 135135 00721 -10.5 true abcdef 135135}
-test link-2.2 {writing bad values into variables} {testlink} {
+    set char 79
+    set uchar 161
+    set short 8000
+    set ushort 40000
+    set uint 0xc001babe
+    set long 34543
+    set ulong 567890
+    set float 1.0987654321
+    set uwide 357357357357
+    concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
+} -result {465 -10.5 1 abcdef 135135 79 161 8000 40000 -1073628482 34543 567890 1.0987653732299805 357357357357 | 0o0721 -10.5 true abcdef 135135 79 161 8000 40000 0xc001babe 34543 567890 1.0987654321 357357357357}
+test link-2.2 {writing bad values into variables} -setup {
     testlink delete
-    testlink set 43 1.23 4 - 56785678
-    testlink create 1 1 1 1 1
+} -constraints {testlink} -body {
+    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list [catch {set int 09a} msg] $msg $int
-} {1 {can't set "int": variable must have integer value} 43}
-test link-2.3 {writing bad values into variables} {testlink} {
+} -result {1 {can't set "int": variable must have integer value} 43}
+test link-2.3 {writing bad values into variables} -setup {
     testlink delete
-    testlink set 43 1.23 4 - 56785678
-    testlink create 1 1 1 1 1
+} -constraints {testlink} -body {
+    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list [catch {set real 1.x3} msg] $msg $real
-} {1 {can't set "real": variable must have real value} 1.23}
-test link-2.4 {writing bad values into variables} {testlink} {
+} -result {1 {can't set "real": variable must have real value} 1.23}
+test link-2.4 {writing bad values into variables} -setup {
     testlink delete
-    testlink set 43 1.23 4 - 56785678
-    testlink create 1 1 1 1 1
+} -constraints {testlink} -body {
+    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list [catch {set bool gorp} msg] $msg $bool
-} {1 {can't set "bool": variable must have boolean value} 1}
-test link-2.5 {writing bad values into variables} {testlink} {
+} -result {1 {can't set "bool": variable must have boolean value} 1}
+test link-2.5 {writing bad values into variables} -setup {
     testlink delete
-    testlink set 43 1.23 4 - 56785678
-    testlink create 1 1 1 1 1
+} -constraints {testlink} -body {
+    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     list [catch {set wide gorp} msg] $msg $bool
-} {1 {can't set "wide": variable must have integer value} 1}
+} -result {1 {can't set "wide": variable must have integer value} 1}
 
-test link-3.1 {read-only variables} {testlink} {
+test link-3.1 {read-only variables} -constraints {testlink} -setup {
     testlink delete
-    testlink set 43 1.23 4 - 56785678
-    testlink create 0 1 1 0 0
+} -body {
+    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 0 1 1 0 0 0 0 0 0 0 0 0 0 0
     list [catch {set int 4} msg] $msg $int \
 	[catch {set real 10.6} msg] $msg $real \
 	[catch {set bool no} msg] $msg $bool \
 	[catch {set string "new value"} msg] $msg $string \
 	[catch {set wide 12341234} msg] $msg $wide
-} {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678}
-test link-3.2 {read-only variables} {testlink} {
+} -result {1 {can't set "int": linked variable is read-only} 43 0 10.6 10.6 0 no no 1 {can't set "string": linked variable is read-only} NULL 1 {can't set "wide": linked variable is read-only} 56785678}
+test link-3.2 {read-only variables} -constraints {testlink} -setup {
     testlink delete
-    testlink set 43 1.23 4 - 56785678
-    testlink create 1 0 0 1 1
+} -body {
+    testlink set 43 1.23 4 - 56785678 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 1 0 0 1 1 0 0 0 0 0 0 0 0 0
     list [catch {set int 4} msg] $msg $int \
 	[catch {set real 10.6} msg] $msg $real \
 	[catch {set bool no} msg] $msg $bool \
 	[catch {set string "new value"} msg] $msg $string\
 	[catch {set wide 12341234} msg] $msg $wide
-} {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}
+} -result {0 4 4 1 {can't set "real": linked variable is read-only} 1.23 1 {can't set "bool": linked variable is read-only} 1 0 {new value} {new value} 0 12341234 12341234}
 
-test link-4.1 {unsetting linked variables} {testlink} {
+test link-4.1 {unsetting linked variables} -constraints {testlink} -setup {
     testlink delete
-    testlink set -6 -2.5 0 stringValue 13579
-    testlink create 1 1 1 1 1
+} -body {
+    testlink set -6 -2.5 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     unset int real bool string wide
     list [catch {set int} msg] $msg [catch {set real} msg] $msg \
 	    [catch {set bool} msg] $msg [catch {set string} msg] $msg \
 	    [catch {set wide} msg] $msg
-} {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
-test link-4.2 {unsetting linked variables} {testlink} {
+} -result {0 -6 0 -2.5 0 0 0 stringValue 0 13579}
+test link-4.2 {unsetting linked variables} -constraints {testlink} -setup {
     testlink delete
-    testlink set -6 -2.1 0 stringValue 97531
-    testlink create 1 1 1 1 1
+} -body {
+    testlink set -6 -2.1 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     unset int real bool string wide
     set int 102
     set real 16
     set bool true
     set string newValue
     set wide 333555
-    testlink get
-} {102 16.0 1 newValue 333555}
+    lrange [testlink get] 0 4
+} -result {102 16.0 1 newValue 333555}
 
-test link-5.1 {unlinking variables} {testlink} {
+test link-5.1 {unlinking variables} -constraints {testlink} -setup {
     testlink delete
-    testlink set -6 -2.25 0 stringValue 13579
+} -body {
+    testlink set -6 -2.25 0 stringValue 13579 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink delete
     set int xx1
     set real qrst
     set bool bogus
     set string 12345
     set wide 875421
+    set char skjdf
+    set uchar dslfjk
+    set short slkf
+    set ushort skrh
+    set uint sfdkfkh
+    set long srkjh
+    set ulong sjkg
+    set float dskjfbjfd
+    set uwide isdfsngs
     testlink get
-} {-6 -2.25 0 stringValue 13579}
-test link-5.2 {unlinking variables} {testlink} {
+} -result {-6 -2.25 0 stringValue 13579 64 250 30000 60000 -1091585346 12321 32123 3.25 1231231234}
+test link-5.2 {unlinking variables} -constraints {testlink} -setup {
     testlink delete
-    testlink set -6 -2.25 0 stringValue 97531
-    testlink create 1 1 1 1 1
+} -body {
+    testlink set -6 -2.25 0 stringValue 97531 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
     testlink delete
-    testlink set 25 14.7 7 - 999999
-    list $int $real $bool $string $wide
-} {-6 -2.25 0 stringValue 97531}
+    testlink set 25 14.7 7 - 999999 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
+    list $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
+} -result {-6 -2.25 0 stringValue 97531 64 250 30000 60000 3203381950 12321 32123 3.25 1231231234}
 
-test link-6.1 {errors in setting up link} {testlink} {
+test link-6.1 {errors in setting up link} -setup {
     testlink delete
-    catch {unset int}
+    unset -nocomplain int
+} -constraints {testlink} -body {
     set int(44) 1
-    list [catch {testlink create 1 1 1 1 1} msg] $msg
-} {1 {can't set "int": variable is array}}
-catch {unset int}
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+} -cleanup {
+    unset -nocomplain int
+} -returnCodes error -result {can't set "int": variable is array}
 
-test link-7.1 {access to linked variables via upvar} {testlink} {
+test link-7.1 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar int y
 	unset y
     }
-    testlink delete
-    testlink create 1 0 0 0 0
-    testlink set 14 {} {} {} {}
+    testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
+    testlink set 14 {} {} {} {} {} {} {} {} {} {} {} {} {}
     x
     list [catch {set int} msg] $msg
-} {0 14}
-test link-7.2 {access to linked variables via upvar} {testlink} {
+} -result {0 14}
+test link-7.2 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar int y
 	return [set y]
     }
-    testlink delete
-    testlink create 1 0 0 0 0
-    testlink set 0 {} {} {} {}
+    testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
+    testlink set 0 {} {} {} {} {} {} {} {} {} {} {} {} {}
     set int
-    testlink set 23 {} {} {} {}
+    testlink set 23 {} {} {} {} {} {} {} {} {} {} {} {} {}
     x
     list [x] $int
-} {23 23}
-test link-7.3 {access to linked variables via upvar} {testlink} {
+} -result {23 23}
+test link-7.3 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar int y
 	set y 44
     }
-    testlink delete
-    testlink create 0 0 0 0 0
-    testlink set 11 {} {} {} {}
+    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+    testlink set 11 {} {} {} {} {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $int
-} {1 {can't set "y": linked variable is read-only} 11}
-test link-7.4 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": linked variable is read-only} 11}
+test link-7.4 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar int y
 	set y abc
     }
-    testlink delete
-    testlink create 1 1 1 1 1
-    testlink set -4 {} {} {} {}
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    testlink set -4 {} {} {} {} {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $int
-} {1 {can't set "y": variable must have integer value} -4}
-test link-7.5 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": variable must have integer value} -4}
+test link-7.5 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar real y
 	set y abc
     }
-    testlink delete
-    testlink create 1 1 1 1 1
-    testlink set -4 16.75 {} {} {}
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    testlink set -4 16.75 {} {} {} {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $real
-} {1 {can't set "y": variable must have real value} 16.75}
-test link-7.6 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": variable must have real value} 16.75}
+test link-7.6 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar bool y
 	set y abc
     }
-    testlink delete
-    testlink create 1 1 1 1 1
-    testlink set -4 16.3 1 {} {}
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    testlink set -4 16.3 1 {} {} {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $bool
-} {1 {can't set "y": variable must have boolean value} 1}
-test link-7.7 {access to linked variables via upvar} {testlink} {
+} -result {1 {can't set "y": variable must have boolean value} 1}
+test link-7.7 {access to linked variables via upvar} -setup {
+    testlink delete
+} -constraints {testlink} -body {
     proc x {} {
 	upvar wide y
 	set y abc
     }
-    testlink delete
-    testlink create 1 1 1 1 1
-    testlink set -4 16.3 1 {} 778899
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    testlink set -4 16.3 1 {} 778899 {} {} {} {} {} {} {} {} {}
     list [catch x msg] $msg $wide
-} {1 {can't set "y": variable must have integer value} 778899}
+} -result {1 {can't set "y": variable must have integer value} 778899}
 
 test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
     proc x args {
@@ -225,12 +266,12 @@ test link-8.1 {Tcl_UpdateLinkedVar procedure} {testlink} {
 	lappend x $args $int $real $bool $string $wide
     }
     set x {}
-    testlink create 1 1 1 1 1
-    testlink set 14 -2.0 0 xyzzy 995511
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     trace var int w x
-    testlink update 32 4.0 3 abcd 113355
+    testlink update 32 4.0 3 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
     trace vdelete int w x
-    set x
+    return $x
 } {{int {} w} 32 -2.0 0 xyzzy 995511}
 test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
     proc x args {
@@ -238,25 +279,32 @@ test link-8.2 {Tcl_UpdateLinkedVar procedure} {testlink} {
 	lappend x $args $int $real $bool $string $wide
     }
     set x {}
-    testlink create 1 1 1 1 1
-    testlink set 14 -2.0 0 xyzzy 995511
+    testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+    testlink set 14 -2.0 0 xyzzy 995511 64 250 30000 60000 0xbeefbabe 12321 32123 3.25 1231231234
     testlink delete
     trace var int w x
-    testlink update 32 4.0 6 abcd 113355
+    testlink update 32 4.0 6 abcd 113355 65 251 30001 60001 0xbabebeef 12322 32124 3.125 12312312340
     trace vdelete int w x
-    set x
+    return $x
 } {}
 test link-8.3 {Tcl_UpdateLinkedVar procedure, read-only variable} {testlink} {
-    testlink create 0 0 0 0 0
-    list [catch {testlink update 47 {} {} {} {}} msg] $msg $int
+    testlink create 0 0 0 0 0 0 0 0 0 0 0 0 0 0
+    list [catch {
+	testlink update 47 {} {} {} {} {} {} {} {} {} {} {} {} {}
+    } msg] $msg $int
 } {0 {} 47}
-
-catch {testlink set 0 0 0 - 0}
+
+catch {testlink set 0 0 0 - 0 0 0 0 0 0 0 0 0 0}
 catch {testlink delete}
 foreach i {int real bool string wide} {
-    catch {unset $i}
+    unset -nocomplain $i
 }
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/linsert.test b/tests/linsert.test
index 3419c74..4939e5c 100644
--- a/tests/linsert.test
+++ b/tests/linsert.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: linsert.test,v 1.10 2005/05/10 18:35:22 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -84,16 +82,22 @@ test linsert-1.20 {linsert command, use of end-int index} {
 
 test linsert-2.1 {linsert errors} {
     list [catch linsert msg] $msg
-} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
+} {1 {wrong # args: should be "linsert list index ?element ...?"}}
 test linsert-2.2 {linsert errors} {
     list [catch {linsert a b} msg] $msg
-} {1 {wrong # args: should be "linsert list index element ?element ...?"}}
+} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
 test linsert-2.3 {linsert errors} {
     list [catch {linsert a 12x 2} msg] $msg
 } {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
 test linsert-2.4 {linsert errors} {
     list [catch {linsert \{ 12 2} msg] $msg
 } {1 {unmatched open brace in list}}
+test linsert-2.5 {syntax (TIP 323)} {
+    linsert {a b c} 0
+} [list a b c]
+test linsert-2.6 {syntax (TIP 323)} {
+    linsert "a\nb\nc" 0
+} [list a b c]
 
 test linsert-3.1 {linsert won't modify shared argument objects} {
     proc p {} {
diff --git a/tests/list.test b/tests/list.test
index 01dc060..dff5d50 100644
--- a/tests/list.test
+++ b/tests/list.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: list.test,v 1.7 2003/07/24 16:05:24 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -46,6 +44,26 @@ test list-1.23 {basic tests} {list \{} "\\{"
 test list-1.24 {basic tests} {list} {}
 test list-1.25 {basic tests} {list # #} {{#} #}
 test list-1.26 {basic tests} {list #\{ #\{} {\#\{ #\{}
+test list-1.27 {basic null treatment} {
+    set l [list "" "\0" "\0\0"]
+    set e "{} \0 \0\0"
+    string equal $l $e
+} 1
+test list-1.28 {basic null treatment} {
+    set result "\0a\0b"
+    list $result [string length $result]
+} "\0a\0b 4"
+test list-1.29 {basic null treatment} {
+    set result "\0a\0b"
+    set srep "$result 4"
+    set lrep [list $result [string length $result]]
+    string equal $srep $lrep
+} 1
+test list-1.30 {basic null treatment} {
+    set l [list "\0abc" "xyz"]
+    set e "\0abc xyz"
+    string equal $l $e
+} 1
 
 # For the next round of tests create a list and then pick it apart
 # with "index" to make sure that we get back exactly what went in.
@@ -107,6 +125,10 @@ test list-3.1 {SetListFromAny and lrange/concat results} {
     slowsort {fred julie alex carol bill annie}
 } {alex annie bill carol fred julie}
 
+test list-4.1 {Bug 3173086} {
+    string is list "{[list \\\\\}]}"
+} 1
+
 # cleanup
 ::tcltest::cleanupTests
 return
diff --git a/tests/listObj.test b/tests/listObj.test
index a3c9f20..d7fb46c 100644
--- a/tests/listObj.test
+++ b/tests/listObj.test
@@ -10,14 +10,17 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: listObj.test,v 1.8 2005/07/27 18:12:43 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testobj [llength [info commands testobj]]
+
 catch {unset x}
 test listobj-1.1 {Tcl_GetListObjType} emptyTest {
     # Test removed; tested an internal detail
@@ -175,6 +178,32 @@ test listobj-9.1 {UpdateStringOfList} {
     string length [list foo\x00help]
 } 8
 
+test listobj-10.1 {Bug [2971669]} {*}{
+    -constraints testobj
+    -setup {
+	testobj freeallvars
+    }
+    -body {
+	set result {}
+	lappend result \
+	    [testlistobj set 1 a b c d e] \
+	    [testlistobj replace 1 0x7fffffff 0x7fffffff f] \
+	    [testlistobj get 1]
+    }
+    -cleanup {
+	testobj freeallvars
+    }
+    -result {{a b c d e} {} {a b c d e f}}
+}
+
+test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
+    testobj bug3598580
+} 123
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/llength.test b/tests/llength.test
index 1f272f7..169c7ca 100644
--- a/tests/llength.test
+++ b/tests/llength.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: llength.test,v 1.6 2004/05/19 12:23:58 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
diff --git a/tests/lmap.test b/tests/lmap.test
new file mode 100644
index 0000000..08035d9
--- /dev/null
+++ b/tests/lmap.test
@@ -0,0 +1,471 @@
+# Commands covered:  lmap, continue, break
+#
+# 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-1997 Sun Microsystems, Inc.
+# Copyright (c) 2011 Trevor Davel
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# RCS: @(#) $Id: $
+
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+}
+
+unset -nocomplain a b i x
+
+# ----- Non-compiled operation -----------------------------------------------
+
+# Basic "lmap" operation (non-compiled)
+test lmap-1.1 {basic lmap tests} {
+    set a {}
+    lmap i {a b c d} {
+	set a [concat $a $i]
+    }
+} {a {a b} {a b c} {a b c d}}
+test lmap-1.2 {basic lmap tests} {
+    lmap i {a b {{c d} e} {123 {{x}}}} {
+	set i
+    }
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-1.2a {basic lmap tests} {
+    lmap i {a b {{c d} e} {123 {{x}}}} {
+	return -level 0 $i
+    }
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-1.4 {basic lmap tests} -returnCodes error -body {
+    lmap
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.6 {basic lmap tests} -returnCodes error -body {
+    lmap i
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.8 {basic lmap tests} -returnCodes error -body {
+    lmap i j
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.10 {basic lmap tests} -returnCodes error -body {
+    lmap i j k l
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-1.11 {basic lmap tests} {
+    lmap i {} {
+	set i
+    }
+} {}
+test lmap-1.12 {basic lmap tests} {
+    lmap i {} {
+	return -level 0 x
+    }
+} {}
+test lmap-1.13 {lmap errors} -returnCodes error -body {
+    lmap {{a}{b}} {1 2 3} {}
+} -result {list element in braces followed by "{b}" instead of space}
+test lmap-1.14 {lmap errors} -returnCodes error -body {
+    lmap a {{1 2}3} {}
+} -result {list element in braces followed by "3" instead of space}
+unset -nocomplain a
+test lmap-1.15 {lmap errors} -setup {
+    unset -nocomplain a
+} -body {
+    set a(0) 44
+    list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
+} -result {1 {can't set "a": variable is array} {can't set "a": variable is array
+    (setting lmap loop variable "a")
+    invoked from within
+"lmap a {1 2 3} {}"}}
+test lmap-1.16 {lmap errors} -returnCodes error -body {
+    lmap {} {} {}
+} -result {lmap varlist is empty}
+unset -nocomplain a
+
+# Parallel "lmap" operation (non-compiled)
+test lmap-2.1 {parallel lmap tests} {
+    lmap {a b} {1 2 3 4} {
+	list $b $a
+    }
+} {{2 1} {4 3}}
+test lmap-2.2 {parallel lmap tests} {
+    lmap {a b} {1 2 3 4 5} {
+	list $b $a
+    }
+} {{2 1} {4 3} {{} 5}}
+test lmap-2.3 {parallel lmap tests} {
+    lmap a {1 2 3} b {4 5 6} {
+	list $b $a
+    }
+} {{4 1} {5 2} {6 3}}
+test lmap-2.4 {parallel lmap tests} {
+    lmap a {1 2 3} b {4 5 6 7 8} {
+	list $b $a
+    }
+} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
+test lmap-2.5 {parallel lmap tests} {
+    lmap {a b} {a b A B aa bb} c {c C cc CC} {
+	list $a $b $c
+    }
+} {{a b c} {A B C} {aa bb cc} {{} {} CC}}
+test lmap-2.6 {parallel lmap tests} {
+    lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
+	list $a$b$c$d$e
+    }
+} {11111 22222 33333}
+test lmap-2.7 {parallel lmap tests} {
+    lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+	set x $a$b$c$d$e
+    }
+} {{1111 2} 222 33 4}
+test lmap-2.8 {parallel lmap tests} {
+    lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+	join [list $a $b $c $d $e] .
+    }
+} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.}
+test lmap-2.9 {lmap only sets vars if repeating loop} {
+    namespace eval ::lmap_test {
+	set rgb {65535 0 0}
+	lmap {r g b} [set rgb] {}
+	set ::x "r=$r, g=$g, b=$b"
+    }
+    namespace delete ::lmap_test
+    set x
+} {r=65535, g=0, b=0}
+test lmap-2.10 {lmap only supports local scalar variables} -setup {
+    unset -nocomplain a
+} -body {
+    lmap {a(3)} {1 2 3 4} {set {a(3)}}
+} -result {1 2 3 4}
+unset -nocomplain a
+
+# "lmap" with "continue" and "break" (non-compiled)
+test lmap-3.1 {continue tests} {
+    lmap i {a b c d} {
+	if {[string compare $i "b"] == 0} continue
+	set i
+    }
+} {a c d}
+test lmap-3.2 {continue tests} {
+    set x 0
+    list [lmap i {a b c d} {
+    	incr x
+    	if {[string compare $i "b"] != 0} continue
+    	set i
+    }] $x
+} {b 4}
+test lmap-3.3 {break tests} {
+    set x 0
+    list [lmap i {a b c d} {
+	incr x
+    	if {[string compare $i "c"] == 0} break
+    	set i
+    }] $x
+} {{a b} 3}
+# Check for bug similar to #406709
+test lmap-3.4 {break tests} {
+    set a 1
+    lmap b b {list [concat a; break]; incr a}
+    incr a
+} {2}
+
+# ----- Compiled operation ---------------------------------------------------
+
+# Basic "lmap" operation (compiled)
+test lmap-4.1 {basic lmap tests} {
+    apply {{} {
+	set a {}
+	lmap i {a b c d} {
+	    set a [concat $a $i]
+	}
+    }}
+} {a {a b} {a b c} {a b c d}}
+test lmap-4.2 {basic lmap tests} {
+    apply {{} {
+	lmap i {a b {{c d} e} {123 {{x}}}} {
+	    set i
+	}
+    }}
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-4.2a {basic lmap tests} {
+    apply {{} {
+	lmap i {a b {{c d} e} {123 {{x}}}} {
+	    return -level 0 $i
+	}
+    }}
+} {a b {{c d} e} {123 {{x}}}}
+test lmap-4.4 {basic lmap tests} -returnCodes error -body {
+    apply {{} { lmap }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.6 {basic lmap tests} -returnCodes error -body {
+    apply {{} { lmap i }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.8 {basic lmap tests} -returnCodes error -body {
+    apply {{} { lmap i j }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.10 {basic lmap tests} -returnCodes error -body {
+    apply {{} { lmap i j k l }}
+} -result {wrong # args: should be "lmap varList list ?varList list ...? command"}
+test lmap-4.11 {basic lmap tests} {
+    apply {{} { lmap i {} { set i } }}
+} {}
+test lmap-4.12 {basic lmap tests} {
+    apply {{} { lmap i {} { return -level 0 x } }}
+} {}
+test lmap-4.13 {lmap errors} -returnCodes error -body {
+    apply {{} { lmap {{a}{b}} {1 2 3} {} }}
+} -result {list element in braces followed by "{b}" instead of space}
+test lmap-4.14 {lmap errors} -returnCodes error -body {
+    apply {{} { lmap a {{1 2}3} {} }}
+} -result {list element in braces followed by "3" instead of space}
+unset -nocomplain a
+test lmap-4.15 {lmap errors} {
+    apply {{} { 
+	set a(0) 44
+	list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo 
+    }} 
+} {1 {can't set "a": variable is array} {can't set "a": variable is array
+    while executing
+"lmap a {1 2 3} {}"}}
+test lmap-4.16 {lmap errors} -returnCodes error -body {
+    apply {{} {
+	lmap {} {} {}
+    }}
+} -result {lmap varlist is empty}
+unset -nocomplain a
+
+# Parallel "lmap" operation (compiled)
+test lmap-5.1 {parallel lmap tests} {
+    apply {{} {
+	lmap {a b} {1 2 3 4} {
+	    list $b $a
+	}
+    }}
+} {{2 1} {4 3}}
+test lmap-5.2 {parallel lmap tests} {
+    apply {{} {
+	lmap {a b} {1 2 3 4 5} {
+	    list $b $a
+	}
+    }}
+} {{2 1} {4 3} {{} 5}}
+test lmap-5.3 {parallel lmap tests} {
+    apply {{} {
+	lmap a {1 2 3} b {4 5 6} {
+	    list $b $a
+	}
+    }}
+} {{4 1} {5 2} {6 3}}
+test lmap-5.4 {parallel lmap tests} {
+    apply {{} {
+	lmap a {1 2 3} b {4 5 6 7 8} {
+	    list $b $a
+	}
+    }}
+} {{4 1} {5 2} {6 3} {7 {}} {8 {}}}
+test lmap-5.5 {parallel lmap tests} {
+    apply {{} {
+	lmap {a b} {a b A B aa bb} c {c C cc CC} {
+	    list $a $b $c
+	}
+    }}
+} {{a b c} {A B C} {aa bb cc} {{} {} CC}}
+test lmap-5.6 {parallel lmap tests} {
+    apply {{} {
+	lmap a {1 2 3} b {1 2 3} c {1 2 3} d {1 2 3} e {1 2 3} {
+	    list $a$b$c$d$e
+	}
+    }}
+} {11111 22222 33333}
+test lmap-5.7 {parallel lmap tests} {
+    apply {{} {
+	lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+	    set x $a$b$c$d$e
+	}
+    }}
+} {{1111 2} 222 33 4}
+test lmap-5.8 {parallel lmap tests} {
+    apply {{} {
+	lmap a {} b {1 2 3} c {1 2} d {1 2 3 4} e {{1 2}} {
+	    join [list $a $b $c $d $e] .
+	}
+    }}
+} {{.1.1.1.1 2} .2.2.2. .3..3. ...4.}
+test lmap-5.9 {lmap only sets vars if repeating loop} {
+    apply {{} {
+        set rgb {65535 0 0}
+        lmap {r g b} [set rgb] {}
+        return "r=$r, g=$g, b=$b"
+    }}
+} {r=65535, g=0, b=0}
+test lmap-5.10 {lmap only supports local scalar variables} {
+    apply {{} {
+        lmap {a(3)} {1 2 3 4} {set {a(3)}}
+    }}
+} {1 2 3 4}
+
+# "lmap" with "continue" and "break" (compiled)
+test lmap-6.1 {continue tests} {
+    apply {{} {
+	lmap i {a b c d} {
+	    if {[string compare $i "b"] == 0} continue
+	    set i
+	}
+    }}
+} {a c d}
+test lmap-6.2 {continue tests} {
+    apply {{} {
+	list [lmap i {a b c d} {
+	    incr x
+	    if {[string compare $i "b"] != 0} continue
+	    set i
+	}] $x
+    }}
+} {b 4}
+test lmap-6.3 {break tests} {
+    apply {{} {
+	list [lmap i {a b c d} {
+	    incr x
+	    if {[string compare $i "c"] == 0} break
+	    set i
+	}] $x
+    }}
+} {{a b} 3}
+# Check for bug similar to #406709
+test lmap-6.4 {break tests} {
+    apply {{} {
+	set a 1
+	lmap b b {list [concat a; break]; incr a}
+	incr a
+    }}
+} {2}
+
+# ----- Special cases and bugs -----------------------------------------------
+test lmap-7.1 {compiled lmap backward jump works correctly} -setup {
+    unset -nocomplain x
+} -body {
+    array set x {0 zero 1 one 2 two 3 three}
+    lsort [apply {{arrayName} {
+        upvar 1 $arrayName a
+        lmap member [array names a] {
+            list $member [set a($member)]
+        }
+    }} x]
+} -result [lsort {{0 zero} {1 one} {2 two} {3 three}}]
+test lmap-7.2 {noncompiled lmap and shared variable or value list objects that are converted to another type} -setup {
+    unset -nocomplain x
+} -body {
+    lmap {12.0} {a b c} {
+        set x 12.0
+        set x [expr $x + 1]
+    }
+} -result {13.0 13.0 13.0}
+# Test for incorrect "double evaluation" semantics
+test lmap-7.3 {delayed substitution of body} {
+    apply {{} {
+       set a 0
+       lmap a [list 1 2 3] "
+           set x $a
+       "
+       return $x
+    }}
+} {0}
+# Related to "foreach" test for [Bug 1189274]; crash on failure
+test lmap-7.4 {empty list handling} {
+    proc crash {} {
+	rename crash {}
+	set a "x y z"
+	set b ""
+	lmap aa $a bb $b { set x "aa = $aa bb = $bb" }
+    }
+    crash
+} {{aa = x bb = } {aa = y bb = } {aa = z bb = }}
+# Related to [Bug 1671138]; infinite loop with empty var list in bytecompiled
+# version.
+test lmap-7.5 {compiled empty var list} -returnCodes error -body {
+    proc foo {} {
+	lmap {} x {
+	    error "reached body"
+	}
+    }
+    foo
+} -cleanup {
+    catch {rename foo ""}
+} -result {lmap varlist is empty}
+test lmap-7.6 {lmap: related to "foreach" [Bug 1671087]} -setup {
+    proc demo {} {
+	set vals {1 2 3 4}
+	trace add variable x write {string length $vals ;# }
+	lmap {x y} $vals {format $y}
+    }
+} -body {
+    demo
+} -cleanup {
+    rename demo {}
+} -result {2 4}
+# Huge lists must not overflow the bytecode interpreter (development bug)
+test lmap-7.7 {huge list non-compiled} -setup {
+    unset -nocomplain a b x
+} -body {
+    set x [lmap a [lrepeat 1000000 x] { set b y$a }]
+    list $b [llength $x] [string length $x]
+} -result {yx 1000000 2999999}
+test lmap-7.8 {huge list compiled} -setup {
+    unset -nocomplain a b x
+} -body {
+    set x [apply {{times} {
+	global b
+	lmap a [lrepeat $times x] { set b Y$a }
+    }} 1000000]
+    list $b [llength $x] [string length $x]
+} -result {Yx 1000000 2999999}
+test lmap-7.9 {error then dereference loop var (dev bug)} {
+    catch { lmap a 0 b {1 2 3} { error x } }
+    set a
+} 0
+test lmap-7.9a {error then dereference loop var (dev bug)} {
+    catch { lmap a 0 b {1 2 3} { incr a $b; error x } }
+    set a
+} 1
+
+# ----- Coroutines -----------------------------------------------------------
+test lmap-8.1 {lmap non-compiled with coroutines} -body {
+    coroutine coro apply {{} {
+	set values [yield [info coroutine]]
+	eval lmap i [list $values] {{ yield $i }}
+    }} ;# returns 'coro'
+    coro {a b c d e f} ;# -> a
+    coro 1 ;# -> b
+    coro 2 ;# -> c
+    coro 3 ;# -> d
+    coro 4 ;# -> e
+    coro 5 ;# -> f
+    list [coro 6] [info commands coro]
+} -cleanup {
+    catch {rename coro ""}
+} -result {{1 2 3 4 5 6} {}}
+test lmap-8.2 {lmap compiled with coroutines} -body {
+    coroutine coro apply {{} {
+	set values [yield [info coroutine]]
+	lmap i $values { yield $i }
+    }} ;# returns 'coro'
+    coro {a b c d e f} ;# -> a
+    coro 1 ;# -> b
+    coro 2 ;# -> c
+    coro 3 ;# -> d
+    coro 4 ;# -> e
+    coro 5 ;# -> f
+    list [coro 6] [info commands coro]
+} -cleanup {
+    catch {rename coro ""}
+} -result {{1 2 3 4 5 6} {}}
+
+# cleanup
+unset -nocomplain a x
+catch {rename foo {}}
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/load.test b/tests/load.test
index d1bdc04..9536271 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -9,73 +9,85 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: load.test,v 1.14 2005/07/28 18:42:32 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 # Figure out what extension is used for shared libraries on this
 # platform.
-
+if {![info exists ext]} {
+    set ext [info sharedlibextension]
+}
 # Tests require the existence of one of the DLLs in the dltest directory.
-set ext [info sharedlibextension]
 set testDir [file join [file dirname [info nameofexecutable]] dltest]
 set x [file join $testDir pkga$ext]
 set dll "[file tail $x]Required"
-::tcltest::testConstraint $dll [file readable $x]
+testConstraint $dll [file readable $x]
 
 # Tests also require that this DLL has not already been loaded.
 set loaded "[file tail $x]Loaded"
 set alreadyLoaded [info loaded]
-::tcltest::testConstraint $loaded \
-	[expr {![string match *pkga* $alreadyLoaded]}]
+testConstraint $loaded [expr {![string match *pkga* $alreadyLoaded]}]
 
 set alreadyTotalLoaded [info loaded]
 
 # Certain tests require the 'teststaticpkg' command from tcltest
 
-::tcltest::testConstraint teststaticpkg \
-    [string compare {} [info commands teststaticpkg]]
+testConstraint teststaticpkg [llength [info commands teststaticpkg]]
 
+# Test load-10.1 requires the 'testsimplefilesystem' command from tcltest
 
+testConstraint testsimplefilesystem \
+	[llength [info commands testsimplefilesystem]]
+
 test load-1.1 {basic errors} {} {
     list [catch {load} msg] $msg
-} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}"
+} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
 test load-1.2 {basic errors} {} {
     list [catch {load a b c d} msg] $msg
-} "1 {wrong \# args: should be \"load fileName ?packageName? ?interp?\"}"
+} "1 {wrong \# args: should be \"load ?-global? ?-lazy? ?--? fileName ?packageName? ?interp?\"}"
 test load-1.3 {basic errors} {} {
     list [catch {load a b foobar} msg] $msg
 } {1 {could not find interpreter "foobar"}}
 test load-1.4 {basic errors} {} {
-    list [catch {load {}} msg] $msg
+    list [catch {load -global {}} msg] $msg
 } {1 {must specify either file name or package name}}
 test load-1.5 {basic errors} {} {
-    list [catch {load {} {}} msg] $msg
+    list [catch {load -lazy {} {}} msg] $msg
 } {1 {must specify either file name or package name}}
 test load-1.6 {basic errors} {} {
     list [catch {load {} Unknown} msg] $msg
 } {1 {package "Unknown" isn't loaded statically}}
+test load-1.7 {basic errors} {} {
+    list [catch {load -abc foo} msg] $msg
+} "1 {bad option \"-abc\": must be -global, -lazy, or --}"
+test load-1.8 {basic errors} {} {
+    list [catch {load -global} msg] $msg
+} "1 {couldn't figure out package name for -global}"
 
 test load-2.1 {basic loading, with guess for package name} \
 	[list $dll $loaded] {
-    load [file join $testDir pkga$ext]
-    list [pkga_eq abc def] [info commands pkga_*]
+    load -global [file join $testDir pkga$ext]
+    list [pkga_eq abc def] [lsort [info commands pkga_*]]
 } {0 {pkga_eq pkga_quote}}
 interp create -safe child
 test load-2.2 {loading into a safe interpreter, with package name conversion} \
 	[list $dll $loaded] {
-    load [file join $testDir pkgb$ext] pKgB child
+    load -lazy [file join $testDir pkgb$ext] pKgB child
     list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
 	    [catch {pkgb_sub 12 10} msg2] $msg2
 } {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
 test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
 -body {
-    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg
-} -match glob -result {1 {*couldn't find procedure Foo_Init}}
+    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
+} -match glob \
+    -result [list 1 {cannot find symbol "Foo_Init"*} \
+		 {TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
 test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
     list [catch {load [file join $testDir pkga$ext] {} child} msg] $msg
 } {1 {can't use package in a safe interpreter: no Pkga_SafeInit procedure}}
@@ -83,7 +95,7 @@ test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
 test load-3.1 {error in _Init procedure, same interpreter} \
 	[list $dll $loaded] {
     list [catch {load [file join $testDir pkge$ext] pkge} msg] \
-	    $msg $errorInfo $errorCode
+	    $msg $::errorInfo $::errorCode
 } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
     while executing
 "open non_existent"
@@ -95,10 +107,10 @@ test load-3.2 {error in _Init procedure, slave interpreter} \
 	[list $dll $loaded] {
     catch {interp delete x}
     interp create x
-    set errorCode foo
-    set errorInfo bar
+    set ::errorCode foo
+    set ::errorInfo bar
     set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
-	    $msg $errorInfo $errorCode]
+	    $msg $::errorInfo $::errorCode]
     interp delete x
     set result
 } {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
@@ -120,7 +132,7 @@ test load-5.1 {file name not specified and no static package: pick default} \
 	[list $dll $loaded] {
     catch {interp delete x}
     interp create x
-    load [file join $testDir pkga$ext] pkga
+    load -global [file join $testDir pkga$ext] pkga
     load {} pkga x
     set result [info loaded x]
     interp delete x
@@ -176,7 +188,7 @@ test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded]
 test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] {
     load [file join $testDir pkgb$ext] pkgb
     list [info loaded {}] [lsort [info commands pkgb_*]]
-} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_sub pkgb_unsafe}]
+} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_demo pkgb_sub pkgb_unsafe}]
 interp delete child
 
 test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \
@@ -194,10 +206,27 @@ test load-9.1 {Tcl_StaticPackage, load already-loaded package into another inter
 	    [child1 eval { info loaded {} }] \
 	    [child2 eval { info loaded {} }]
     } \
-    -result {{{{} Loadninepointone} {{} Tcltest}} {{{} Loadninepointone} {{} Tcltest}}} \
+    -match glob -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}} \
     -cleanup { interp delete child1 ; interp delete child2 }
 
-    
+test load-10.1 {load from vfs} \
+    -constraints [list $dll $loaded testsimplefilesystem] \
+    -setup {set dir [pwd]; cd $testDir; testsimplefilesystem 1} \
+    -body {list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg} \
+    -result {0 {}} \
+    -cleanup {testsimplefilesystem 0; cd $dir; unset dir}
+
+test load-11.1 {Load TclOO extension using Stubs (Bug [f51efe99a7])} \
+	[list $dll $loaded] {
+    load [file join $testDir pkgooa$ext]
+    list [pkgooa_stubsok] [lsort [info commands pkgooa_*]]
+} {1 pkgooa_stubsok}
+
 # cleanup
+unset ext
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/lrange.test b/tests/lrange.test
index 29eafb9..17a757e 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -10,14 +10,12 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: lrange.test,v 1.9 2005/05/10 18:35:22 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-
+
 test lrange-1.1 {range of list elements} {
     lrange {a b c d} 1 2
 } {b c}
@@ -63,6 +61,7 @@ test lrange-1.14 {range of list elements} {
 test lrange-1.15 {range of list elements} {
     concat \"[lrange {a b \{\   	} 0 2]"
 } {"a b \{\ "}
+# emacs highlighting bug workaround --> "
 test lrange-1.16 {list element quoting} {
     lrange {[append a .b]} 0 end    
 } {{[append} a .b\]}
@@ -86,6 +85,16 @@ test lrange-2.6 {error conditions} {
     list [catch {lrange "a b c \{ d e" 1 4} msg] $msg
 } {1 {unmatched open brace in list}}
 
+test lrange-3.1 {Bug 3588366: end-offsets before start} {
+    apply {l {
+	lrange $l 0 end-5
+    }} {1 2 3 4 5}
+} {}
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/lrepeat.test b/tests/lrepeat.test
index f6888b1..788bb9b 100644
--- a/tests/lrepeat.test
+++ b/tests/lrepeat.test
@@ -8,8 +8,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: lrepeat.test,v 1.2 2003/10/06 14:32:22 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -22,14 +20,13 @@ test lrepeat-1.1 {error cases} {
 	lrepeat
     }
     -returnCodes 1
-    -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
+    -result {wrong # args: should be "lrepeat count ?value ...?"}
 }
-test lrepeat-1.2 {error cases} {
+test lrepeat-1.2 {Accept zero elements(TIP 323)} {
     -body {
 	lrepeat 1
     }
-    -returnCodes 1
-    -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
+    -result {}
 }
 test lrepeat-1.3 {error cases} {
     -body {
@@ -43,14 +40,13 @@ test lrepeat-1.4 {error cases} {
 	lrepeat -3 1
     }
     -returnCodes 1
-    -result {must have a count of at least 1} 
+    -result {bad count "-3": must be integer >= 0} 
 }
-test lrepeat-1.5 {error cases} {
+test lrepeat-1.5 {Accept zero repetitions (TIP 323)} {
     -body {
 	lrepeat 0
     }
-    -returnCodes 1
-    -result {wrong # args: should be "lrepeat positiveCount value ?value ...?"}
+    -result {}
 }
 test lrepeat-1.6 {error cases} {
     -body {
@@ -59,6 +55,15 @@ test lrepeat-1.6 {error cases} {
     -returnCodes 1
     -result {expected integer but got "3.5"} 
 }
+test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
+    -body {
+	lrepeat 0 a b c
+    }
+    -result {}
+}
+test lrepeat-1.8 {Do not build enormous lists - Bug 2130992} -body {
+     lrepeat 0x10000000 a b c d e f g h
+} -returnCodes error -match glob -result *
 
 ## Okay
 test lrepeat-2.1 {normal cases} {
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 6ea1f75..5f675bc 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: lreplace.test,v 1.9 2005/05/10 18:35:22 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -104,10 +102,10 @@ test lreplace-1.26 {lreplace command} {
 
 test lreplace-2.1 {lreplace errors} {
     list [catch lreplace msg] $msg
-} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
+} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
 test lreplace-2.2 {lreplace errors} {
     list [catch {lreplace a b} msg] $msg
-} {1 {wrong # args: should be "lreplace list first last ?element element ...?"}}
+} {1 {wrong # args: should be "lreplace list first last ?element ...?"}}
 test lreplace-2.3 {lreplace errors} {
     list [catch {lreplace x a 10} msg] $msg
 } {1 {bad index "a": must be integer?[+-]integer? or end?[+-]integer?}}
diff --git a/tests/lsearch.test b/tests/lsearch.test
index 0155bdd..f36e987 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.test
@@ -1,23 +1,21 @@
 # Commands covered:  lsearch
 #
-# 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.
-#
-# RCS: @(#) $Id: lsearch.test,v 1.16 2005/06/01 11:00:35 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
-
+
 set x {abcd bbcd 123 234 345}
 test lsearch-1.1 {lsearch command} {
     lsearch $x 123
@@ -47,9 +45,9 @@ test lsearch-2.4 {search modes} {
 test lsearch-2.5 {search modes} {
     lsearch -exact {foo bar cat} bar
 } 1
-test lsearch-2.6 {search modes} {
-    list [catch {lsearch -regexp {xyz bbcc *bc*} *bc*} msg] $msg
-} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
+test lsearch-2.6 {search modes} -returnCodes error -body {
+    lsearch -regexp {xyz bbcc *bc*} *bc*
+} -result {couldn't compile regular expression pattern: quantifier operand invalid}
 test lsearch-2.7 {search modes} {
     lsearch -regexp {b.x ^bc xy bcx} ^bc
 } 3
@@ -59,9 +57,9 @@ test lsearch-2.8 {search modes} {
 test lsearch-2.9 {search modes} {
     lsearch -glob {b.x ^bc xy bcx} ^bc
 } 1
-test lsearch-2.10 {search modes} {
-    list [catch {lsearch -glib {b.x bx xy bcx} b.x} msg] $msg
-} {1 {bad option "-glib": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
+test lsearch-2.10 {search modes} -returnCodes error -body {
+    lsearch -glib {b.x bx xy bcx} b.x
+} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
 test lsearch-2.11 {search modes with -nocase} {
     lsearch -exact -nocase {a b c A B C} A
 } 0
@@ -81,27 +79,27 @@ test lsearch-2.16 {search modes without -nocase} {
     lsearch -regexp {a b c A B C} ^A\$
 } 3
 
-test lsearch-3.1 {lsearch errors} {
-    list [catch lsearch msg] $msg
-} {1 {wrong # args: should be "lsearch ?options? list pattern"}}
-test lsearch-3.2 {lsearch errors} {
-    list [catch {lsearch a} msg] $msg
-} {1 {wrong # args: should be "lsearch ?options? list pattern"}}
-test lsearch-3.3 {lsearch errors} {
-    list [catch {lsearch a b c} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
-test lsearch-3.4 {lsearch errors} {
-    list [catch {lsearch a b c d} msg] $msg
-} {1 {bad option "a": must be -all, -ascii, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}}
-test lsearch-3.5 {lsearch errors} {
-    list [catch {lsearch "\{" b} msg] $msg
-} {1 {unmatched open brace in list}}
-test lsearch-3.6 {lsearch errors} {
-    list [catch {lsearch -index a b} msg] $msg
-} {1 {"-index" option must be followed by list index}}
-test lsearch-3.7 {lsearch errors} {
-    list [catch {lsearch -subindices -exact a b} msg] $msg
-} {1 {-subindices cannot be used without -index option}}
+test lsearch-3.1 {lsearch errors} -returnCodes error -body {
+    lsearch
+} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
+test lsearch-3.2 {lsearch errors} -returnCodes error -body {
+    lsearch a
+} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
+test lsearch-3.3 {lsearch errors} -returnCodes error -body {
+    lsearch a b c
+} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
+test lsearch-3.4 {lsearch errors} -returnCodes error -body {
+    lsearch a b c d
+} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
+test lsearch-3.5 {lsearch errors} -returnCodes error -body {
+    lsearch "\{" b
+} -result {unmatched open brace in list}
+test lsearch-3.6 {lsearch errors} -returnCodes error -body {
+    lsearch -index a b
+} -result {"-index" option must be followed by list index}
+test lsearch-3.7 {lsearch errors} -returnCodes error -body {
+    lsearch -subindices -exact a b
+} -result {-subindices cannot be used without -index option}
 
 test lsearch-4.1 {binary data} {
     lsearch -exact [list foo one\000two bar] bar
@@ -300,12 +298,12 @@ test lsearch-10.2 {offset searching} {
 test lsearch-10.3 {offset searching} {
     lsearch -start end-4 {a b c a b c} a
 } 3
-test lsearch-10.4 {offset searching} {
-    list [catch {lsearch -start foobar {a b c a b c} a} msg] $msg
-} {1 {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}}
-test lsearch-10.5 {offset searching} {
-    list [catch {lsearch -start 1 2} msg] $msg
-} {1 {missing starting index}}
+test lsearch-10.4 {offset searching} -returnCodes error -body {
+    lsearch -start foobar {a b c a b c} a
+} -result {bad index "foobar": must be integer?[+-]integer? or end?[+-]integer?}
+test lsearch-10.5 {offset searching} -returnCodes error -body {
+    lsearch -start 1 2
+} -result {missing starting index}
 test lsearch-10.6 {binary search with offset} {
     set res {}
     for {set i 0} {$i < 100} {incr i} {
@@ -317,6 +315,18 @@ test lsearch-10.7 {offset searching with an empty list} {
     # Stop bug #694232 from reocurring
     lsearch -start 0 {} x
 } -1
+test lsearch-10.8 {offset searching past the end of the list} {
+    # Stop [Bug 1374778] from reoccurring
+    lsearch -start 10 {a b c} c
+} -1
+test lsearch-10.9 {offset searching past the end of the list} {
+    # Stop [Bug 1374778] from reoccurring
+    lsearch -start 10 -all {a b c} c
+} {}
+test lsearch-10.10 {offset searching past the end of the list} {
+    # Stop [Bug 1374778] from reoccurring
+    lsearch -start 10 -inline {a b c} c
+} {}
 
 test lsearch-11.1 {negated searches} {
     lsearch -not {a a a b a a a} a
@@ -382,6 +392,10 @@ test lsearch-16.1 {lsearch -regexp shared object} {
     set str a
     lsearch -regexp $str $str
 } 0
+# Bug 1366683
+test lsearch-16.2 {lsearch -regexp allows internal backrefs} {
+    lsearch -regexp {a aa b} {(.)\1}
+} 1
 
 test lsearch-17.1 {lsearch -index option, basic functionality} {
     lsearch -index 1 {{a c} {a b} {a a}} a
@@ -437,16 +451,65 @@ test lsearch-19.5 {lsearch -sunindices option} {
     lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
 } {{0 0 0} {1 0 0}}
 
-test lsearch-20.1 {lsearch -index option, index larger than sublists} {
-    list [catch {lsearch -index 2 {{a c} {a b} {a a}} a} msg] $msg
-} {1 {element 2 missing from sublist "a c"}}
-test lsearch-20.2 {lsearch -index option, malformed index} {
-    list [catch {lsearch -index foo {{a c} {a b} {a a}} a} msg] $msg
-} {1 {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}}
-test lsearch-20.3 {lsearch -index option, malformed index} {
-    list [catch {lsearch -index \{ {{a c} {a b} {a a}} a} msg] $msg
-} {1 {unmatched open brace in list}}
+test lsearch-20.1 {lsearch -index option, index larger than sublists} -body {
+    lsearch -index 2 {{a c} {a b} {a a}} a
+} -returnCodes error -result {element 2 missing from sublist "a c"}
+test lsearch-20.2 {lsearch -index option, malformed index} -body {
+    lsearch -index foo {{a c} {a b} {a a}} a
+} -returnCodes error -result {bad index "foo": must be integer?[+-]integer? or end?[+-]integer?}
+test lsearch-20.3 {lsearch -index option, malformed index} -body {
+    lsearch -index \{ {{a c} {a b} {a a}} a
+} -returnCodes error -result {unmatched open brace in list}
+
+test lsearch-21.1 {lsearch shimmering crash} {
+    set x 0
+    lsearch -exact -integer $x $x
+} 0
+test lsearch-21.2 {lsearch shimmering crash} {
+    set x 0.5
+    lsearch -exact -real $x $x
+} 0
 
+test lsearch-22.1 {lsearch -bisect} -setup {
+    set res {}
+} -body {
+    foreach i {0 1 5 6 7 8 15 16} {
+	lappend res [lsearch -bisect -integer {1 4 5 7 9 15} $i]
+    }
+    return $res
+} -result {-1 0 2 2 3 3 5 5}
+test lsearch-22.2 {lsearch -bisect, last of equals} -setup {
+    set res {}
+} -body {
+    foreach i {0 1 2 3} {
+	lappend res [lsearch -bisect -integer {0 0 1 1 1 2 2 2 3 3 3} $i]
+    }
+    return $res
+} -result {1 4 7 10}
+test lsearch-22.3 {lsearch -bisect decreasing order} -setup {
+    set res {}
+} -body {
+    foreach i {0 1 5 6 7 8 15 16} {
+	lappend res [lsearch -bisect -integer -decreasing {15 9 7 5 4 1} $i]
+    }
+    return $res
+} -result {5 5 3 2 2 1 0 -1}
+test lsearch-22.4 {lsearch -bisect, last of equals, decreasing} -setup {
+    set res {}
+} -body {
+    foreach i {0 1 2 3} {
+	lappend res [lsearch -bisect -integer -decreasing \
+		{3 3 3 2 2 2 1 1 1 0 0} $i]
+    }
+    return $res
+} -result {10 8 5 2}
+test lsearch-22.5 {lsearch -bisect, all equal} {
+    lsearch -bisect -integer {5 5 5 5} 5
+} {3}
+test lsearch-22.6 {lsearch -sorted, all equal} {
+    lsearch -sorted -integer {5 5 5 5} 5
+} {0}
+
 # cleanup
 catch {unset res}
 catch {unset increasingIntegers}
@@ -459,3 +522,7 @@ catch {unset increasingDictionary}
 catch {unset decreasingDictionary}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/lset.test b/tests/lset.test
index 00facb2..1c1300b 100644
--- a/tests/lset.test
+++ b/tests/lset.test
@@ -10,14 +10,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 proc failTrace {name1 name2 op} {
     error "trace failed"
 }
@@ -31,12 +32,10 @@ trace add variable noWrite write failTrace
 
 test lset-1.1 {lset, not compiled, arg count} testevalex {
     list [catch {testevalex lset} msg] $msg
-} "1 {wrong \# args: should be \"lset listVar index ?index...? value\"}"
-
+} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
 test lset-1.2 {lset, not compiled, no such var} testevalex {
     list [catch {testevalex {lset noSuchVar 0 {}}} msg] $msg
 } "1 {can't read \"noSuchVar\": no such variable}"
-
 test lset-1.3 {lset, not compiled, var not readable} testevalex {
     list [catch {testevalex {lset noRead 0 {}}} msg] $msg
 } "1 {can't read \"noRead\": trace failed}"
@@ -45,7 +44,6 @@ test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} testevalex
     set x {0 1 2}
     list [testevalex {lset x 0 3}] $x
 } {{3 1 2} {3 1 2}}
-
 test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} testevalex {
     set x {0 1 2}
     list [catch {
@@ -57,30 +55,25 @@ test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex {
     set x {0 1 2}
     list [testevalex {lset x 0 $x}] $x
 } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
-
 test lset-3.2 {lset, not compiled, 3 args, data duplicated} testevalex {
     set x {0 1}
     set y $x
     list [testevalex {lset x 0 2}] $x $y
 } {{2 1} {2 1} {0 1}}
-
 test lset-3.3 {lset, not compiled, 3 args, data duplicated} testevalex {
     set x {0 1}
     set y $x
     list [testevalex {lset x 0 $x}] $x $y
 } {{{0 1} 1} {{0 1} 1} {0 1}}
-
 test lset-3.4 {lset, not compiled, 3 args, data duplicated} testevalex {
     set x {0 1 2}
     list [testevalex {lset x [list 0] $x}] $x
 } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
-
 test lset-3.5 {lset, not compiled, 3 args, data duplicated} testevalex {
     set x {0 1}
     set y $x
     list [testevalex {lset x [list 0] 2}] $x $y
 } {{2 1} {2 1} {0 1}}
-
 test lset-3.6 {lset, not compiled, 3 args, data duplicated} testevalex {
     set x {0 1}
     set y $x
@@ -93,77 +86,78 @@ test lset-4.1 {lset, not compiled, 3 args, not a list} testevalex {
 	testevalex {lset a [list 0] y}
     } msg] $msg
 } {1 {unmatched open brace in list}}
-
 test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a [list 2a2] w}
     } msg] $msg
 } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
 test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a [list -1] w}
     } msg] $msg
 } {1 {list index out of range}}
-
 test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
-	testevalex {lset a [list 3] w}
+	testevalex {lset a [list 4] w}
     } msg] $msg
 } {1 {list index out of range}}
-
-test lset-4.5 {lset, not compiled, 3 args, index out of range} testevalex {
+test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
-	testevalex {lset a [list end--1] w}
+	testevalex {lset a [list end--2] w}
+    } msg] $msg
+} {1 {list index out of range}}
+test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex {
+    set a {x y z}
+    list [catch {
+	testevalex {lset a [list end+2] w}
     } msg] $msg
 } {1 {list index out of range}}
-
 test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a [list end-3] w}
     } msg] $msg
 } {1 {list index out of range}}
-
 test lset-4.7 {lset, not compiled, 3 args, not a list} testevalex {
     set a "x \{"
     list [catch {
 	testevalex {lset a 0 y}
     } msg] $msg
 } {1 {unmatched open brace in list}}
-
 test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a 2a2 w}
     } msg] $msg
 } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
 test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
 	testevalex {lset a -1 w}
     } msg] $msg
 } {1 {list index out of range}}
-
 test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
-	testevalex {lset a 3 w}
+	testevalex {lset a 4 w}
+    } msg] $msg
+} {1 {list index out of range}}
+test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex {
+    set a {x y z}
+    list [catch {
+	testevalex {lset a end--2 w}
     } msg] $msg
 } {1 {list index out of range}}
-
 test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
-	testevalex {lset a end--1 w}
+	testevalex {lset a end+2 w}
     } msg] $msg
 } {1 {list index out of range}}
-
 test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex {
     set a {x y z}
     list [catch {
@@ -176,7 +170,6 @@ test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex {
 	testevalex {lset noWrite 0 d}
     } msg] $msg $noWrite
 } {1 {can't set "noWrite": trace failed} {d b c}}
-
 test lset-5.2 {lset, not compiled, 3 args, can't set variable} testevalex {
     list [catch {
 	testevalex {lset noWrite [list 0] d}
@@ -187,47 +180,38 @@ test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a 0 a}] $a
 } {{a y z} {a y z}}
-
 test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a [list 0] a}] $a
 } {{a y z} {a y z}}
-
 test lset-6.3 {lset, not compiled, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a 2 a}] $a
 } {{x y a} {x y a}}
-
 test lset-6.4 {lset, not compiled, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a [list 2] a}] $a
 } {{x y a} {x y a}}
-
 test lset-6.5 {lset, not compiled, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a end a}] $a
 } {{x y a} {x y a}}
-
 test lset-6.6 {lset, not compiled, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a [list end] a}] $a
 } {{x y a} {x y a}}
-
 test lset-6.7 {lset, not compiled, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a end-0 a}] $a
 } {{x y a} {x y a}}
-
 test lset-6.8 {lset, not compiled, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a [list end-0] a}] $a
 } {{x y a} {x y a}}
-
 test lset-6.9 {lset, not compiled, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a end-2 a}] $a
 } {{a y z} {a y z}}
-
 test lset-6.10 {lset, not compiled, 1-d list basics} testevalex {
     set a {x y z}
     list [testevalex {lset a [list end-2] a}] $a
@@ -237,51 +221,42 @@ test lset-7.1 {lset, not compiled, data sharing} testevalex {
     set a 0
     list [testevalex {lset a $a {gag me}}] $a
 } {{{gag me}} {{gag me}}}
-
 test lset-7.2 {lset, not compiled, data sharing} testevalex {
     set a [list 0]
     list [testevalex {lset a $a {gag me}}] $a
 } {{{gag me}} {{gag me}}}
-
 test lset-7.3 {lset, not compiled, data sharing} testevalex {
     set a {x y}
     list [testevalex {lset a 0 $a}] $a
 } {{{x y} y} {{x y} y}}
-
 test lset-7.4 {lset, not compiled, data sharing} testevalex {
     set a {x y}
     list [testevalex {lset a [list 0] $a}] $a
 } {{{x y} y} {{x y} y}}
-
 test lset-7.5 {lset, not compiled, data sharing} testevalex {
     set n 0
     set a {x y}
     list [testevalex {lset a $n $n}] $a $n
 } {{0 y} {0 y} 0}
-
 test lset-7.6 {lset, not compiled, data sharing} testevalex {
     set n [list 0]
     set a {x y}
     list [testevalex {lset a $n $n}] $a $n
 } {{0 y} {0 y} 0}
-
 test lset-7.7 {lset, not compiled, data sharing} testevalex {
     set n 0
     set a [list $n $n]
     list [testevalex {lset a $n 1}] $a $n
 } {{1 0} {1 0} 0}
-
 test lset-7.8 {lset, not compiled, data sharing} testevalex {
     set n [list 0]
     set a [list $n $n]
     list [testevalex {lset a $n 1}] $a $n
 } {{1 0} {1 0} 0}
-
 test lset-7.9 {lset, not compiled, data sharing} testevalex {
     set a 0
     list [testevalex {lset a $a $a}] $a
 } {0 0}
-
 test lset-7.10 {lset, not compiled, data sharing} testevalex {
     set a [list 0]
     list [testevalex {lset a $a $a}] $a
@@ -291,57 +266,54 @@ test lset-8.1 {lset, not compiled, malformed sublist} testevalex {
     set a [list "a \{" b]
     list [catch {testevalex {lset a 0 1 c}} msg] $msg
 } {1 {unmatched open brace in list}}
-
 test lset-8.2 {lset, not compiled, malformed sublist} testevalex {
     set a [list "a \{" b]
     list [catch {testevalex {lset a {0 1} c}} msg] $msg
 } {1 {unmatched open brace in list}}
-
 test lset-8.3 {lset, not compiled, bad second index} testevalex {
     set a {{b c} {d e}}
     list [catch {testevalex {lset a 0 2a2 f}} msg] $msg
 } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
 test lset-8.4 {lset, not compiled, bad second index} testevalex {
     set a {{b c} {d e}}
     list [catch {testevalex {lset a {0 2a2} f}} msg] $msg
 } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-
 test lset-8.5 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a 2 -1 h}} msg] $msg
 } {1 {list index out of range}}
-
 test lset-8.6 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a {2 -1} h}} msg] $msg
 } {1 {list index out of range}}
-
 test lset-8.7 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a 2 2 h}} msg] $msg
+    list [catch {testevalex {lset a 2 3 h}} msg] $msg
 } {1 {list index out of range}}
-
 test lset-8.8 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a {2 2} h}} msg] $msg
+    list [catch {testevalex {lset a {2 3} h}} msg] $msg
 } {1 {list index out of range}}
-
-test lset-8.9 {lset, not compiled, second index out of range} testevalex {
+test lset-8.9a {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a 2 end--1 h}} msg] $msg
+    list [catch {testevalex {lset a 2 end--2 h}} msg] $msg
 } {1 {list index out of range}}
-
-test lset-8.10 {lset, not compiled, second index out of range} testevalex {
+test lset-8.9b {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a {2 end--1} h}} msg] $msg
+    list [catch {testevalex {lset a 2 end+2 h}} msg] $msg
+} {1 {list index out of range}}
+test lset-8.10a {lset, not compiled, second index out of range} testevalex {
+    set a {{b c} {d e} {f g}}
+    list [catch {testevalex {lset a {2 end--2} h}} msg] $msg
+} {1 {list index out of range}}
+test lset-8.10b {lset, not compiled, second index out of range} testevalex {
+    set a {{b c} {d e} {f g}}
+    list [catch {testevalex {lset a {2 end+2} h}} msg] $msg
 } {1 {list index out of range}}
-
 test lset-8.11 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a 2 end-2 h}} msg] $msg
 } {1 {list index out of range}}
-
 test lset-8.12 {lset, not compiled, second index out of range} testevalex {
     set a {{b c} {d e} {f g}}
     list [catch {testevalex {lset a {2 end-2} h}} msg] $msg
@@ -351,7 +323,6 @@ test lset-9.1 {lset, not compiled, entire variable} testevalex {
     set a x
     list [testevalex {lset a y}] $a
 } {y y}
-
 test lset-9.2 {lset, not compiled, entire variable} testevalex {
     set a x
     list [testevalex {lset a {} y}] $a
@@ -362,48 +333,45 @@ test lset-10.1 {lset, not compiled, shared data} testevalex {
     set a [list $row $row]
     list [testevalex {lset a 0 0 x}] $a
 } {{{x q} {p q}} {{x q} {p q}}}
-
 test lset-10.2 {lset, not compiled, shared data} testevalex {
     set row {p q}
     set a [list $row $row]
     list [testevalex {lset a {0 0} x}] $a
 } {{{x q} {p q}} {{x q} {p q}}}
+test lset-10.3 {lset, not compiled, shared data, [Bug 1333036]} testevalex {
+    set a [list [list p q] [list r s]]
+    set b $a
+    list [testevalex {lset b {0 0} x}] $a
+} {{{x q} {r s}} {{p q} {r s}}}
 
 test lset-11.1 {lset, not compiled, 2-d basics} testevalex {
     set a {{b c} {d e}}
     list [testevalex {lset a 0 0 f}] $a
 } {{{f c} {d e}} {{f c} {d e}}}
-
 test lset-11.2 {lset, not compiled, 2-d basics} testevalex {
     set a {{b c} {d e}}
     list [testevalex {lset a {0 0} f}] $a
 } {{{f c} {d e}} {{f c} {d e}}}
-
 test lset-11.3 {lset, not compiled, 2-d basics} testevalex {
     set a {{b c} {d e}}
     list [testevalex {lset a 0 1 f}] $a
 } {{{b f} {d e}} {{b f} {d e}}}
-
 test lset-11.4 {lset, not compiled, 2-d basics} testevalex {
     set a {{b c} {d e}}
     list [testevalex {lset a {0 1} f}] $a
 } {{{b f} {d e}} {{b f} {d e}}}
-
 test lset-11.5 {lset, not compiled, 2-d basics} testevalex {
     set a {{b c} {d e}}
     list [testevalex {lset a 1 0 f}] $a
 } {{{b c} {f e}} {{b c} {f e}}}
-
 test lset-11.6 {lset, not compiled, 2-d basics} testevalex {
     set a {{b c} {d e}}
     list [testevalex {lset a {1 0} f}] $a
 } {{{b c} {f e}} {{b c} {f e}}}
-
 test lset-11.7 {lset, not compiled, 2-d basics} testevalex {
     set a {{b c} {d e}}
     list [testevalex {lset a 1 1 f}] $a
 } {{{b c} {d f}} {{b c} {d f}}}
-
 test lset-11.8 {lset, not compiled, 2-d basics} testevalex {
     set a {{b c} {d e}}
     list [testevalex {lset a {1 1} f}] $a
@@ -423,12 +391,10 @@ test lset-13.0 {lset, not compiled, shimmering hell} testevalex {
     set a 0
     list [testevalex {lset a $a $a $a $a {gag me}}] $a
 } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
-
 test lset-13.1 {lset, not compiled, shimmering hell} testevalex {
     set a [list 0]
     list [testevalex {lset a $a $a $a $a {gag me}}] $a
 } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
-
 test lset-13.2 {lset, not compiled, shimmering hell} testevalex {
     set a [list 0 0 0 0]
     list [testevalex {lset a $a {gag me}}] $a
@@ -439,13 +405,71 @@ test lset-14.1 {lset, not compiled, list args, is string rep preserved?} testeva
     catch { testevalex {lset a {1 5} 5} }
     list $a [lindex $a 1]
 } "{ { 1 2 } { 3 4 } } { 3 4 }"
-
 test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testevalex {
     set a { { 1 2 } { 3 4 } }
     catch { testevalex {lset a 1 5 5} }
     list $a [lindex $a 1]
 } "{ { 1 2 } { 3 4 } } { 3 4 }"
 
+testConstraint testobj [llength [info commands testobj]]
+test lset-15.1 {lset: shared intrep [Bug 1677512]} -setup {
+    teststringobj set 1 {{1 2} 3}
+    testobj convert 1 list
+    testobj duplicate 1 2
+    variable x [teststringobj get 1]
+    variable y [teststringobj get 2]
+    testobj freeallvars
+    set l [list $y z]
+    unset y
+} -constraints testobj -body {
+    lset l 0 0 0 5
+    lindex $x 0 0
+} -cleanup {
+    unset -nocomplain x l
+} -result 1
+
+test lset-16.1 {lset - grow a variable} testevalex {
+    set x {}
+    testevalex {lset x 0 {test 1}}
+    testevalex {lset x 1 {test 2}}
+    set x
+} {{test 1} {test 2}}
+test lset-16.2 {lset - multiple created sublists} testevalex {
+    set x {}
+    testevalex {lset x 0 0 {test 1}}
+} {{{test 1}}}
+test lset-16.3 {lset - sublists 3 deep} testevalex {
+    set x {}
+    testevalex {lset x 0 0 0 {test 1}}
+} {{{{test 1}}}}
+test lset-16.4 {lset - append to inner list} testevalex {
+    set x {test 1}
+    testevalex {lset x 1 1 2}
+    testevalex {lset x 1 2 3}
+    testevalex {lset x 1 2 1 4}
+} {test {1 2 {3 4}}}
+
+test lset-16.5 {lset - grow a variable} testevalex {
+    set x {}
+    testevalex {lset x end+1 {test 1}}
+    testevalex {lset x end+1 {test 2}}
+    set x
+} {{test 1} {test 2}}
+test lset-16.6 {lset - multiple created sublists} testevalex {
+    set x {}
+    testevalex {lset x end+1 end+1 {test 1}}
+} {{{test 1}}}
+test lset-16.7 {lset - sublists 3 deep} testevalex {
+    set x {}
+    testevalex {lset x end+1 end+1 end+1 {test 1}}
+} {{{{test 1}}}}
+test lset-16.8 {lset - append to inner list} testevalex {
+    set x {test 1}
+    testevalex {lset x end end+1 2}
+    testevalex {lset x end end+1 3}
+    testevalex {lset x end end end+1 4}
+} {test {1 2 {3 4}}}
+
 catch {unset noRead}
 catch {unset noWrite}
 catch {rename failTrace {}}
diff --git a/tests/lsetComp.test b/tests/lsetComp.test
index 6b9264c..6846cbf 100755..100644
--- a/tests/lsetComp.test
+++ b/tests/lsetComp.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -36,7 +34,7 @@ test lsetComp-1.1 {lset, compiled, wrong \# args} {
     evalInProc {
 	lset
     }
-} "1 {wrong \# args: should be \"lset listVar index ?index...? value\"}"
+} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
 
 test lsetComp-2.1 {lset, compiled, list of args, not a simple var name} {
     evalInProc {
diff --git a/tests/macOSXFCmd.test b/tests/macOSXFCmd.test
index 2250435..071f11b 100644
--- a/tests/macOSXFCmd.test
+++ b/tests/macOSXFCmd.test
@@ -8,9 +8,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: macOSXFCmd.test,v 1.2 2004/05/19 20:15:32 dkf Exp $
-#
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -24,8 +21,7 @@ cd [temporaryDirectory]
 
 # check whether macosx file attributes are supported
 testConstraint macosxFileAttr 0
-if {$tcl_platform(platform) eq "unix" && \
-	$tcl_platform(os) eq "Darwin"} {
+if {[testConstraint unix] && $tcl_platform(os) eq "Darwin"} {
     catch {file delete -force -- foo.test}
     close [open foo.test w]
     catch {
@@ -66,15 +62,15 @@ test macOSXFCmd-1.5 {MacOSXGetFileAttribute - rsrclength} {macosxFileAttr notRoo
 
 test macOSXFCmd-2.1 {MacOSXSetFileAttribute - file not found} {macosxFileAttr notRoot} {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -creator FOOO} msg] $msg
+    list [catch {file attributes foo.test -creator FOOC} msg] $msg
 } {1 {could not read "foo.test": no such file or directory}}
 test macOSXFCmd-2.2 {MacOSXSetFileAttribute - creator} {macosxFileAttr notRoot} {
     catch {file delete -force -- foo.test}
     close [open foo.test w]
-    list [catch {file attributes foo.test -creator FOOO} msg] $msg \
+    list [catch {file attributes foo.test -creator FOOC} msg] $msg \
 	    [catch {file attributes foo.test -creator} msg] $msg \
 	    [file delete -force -- foo.test]
-} {0 {} 0 FOOO {}}
+} {0 {} 0 FOOC {}}
 test macOSXFCmd-2.3 {MacOSXSetFileAttribute - empty creator} {macosxFileAttr notRoot} {
     catch {file delete -force -- foo.test}
     close [open foo.test w]
@@ -85,10 +81,10 @@ test macOSXFCmd-2.3 {MacOSXSetFileAttribute - empty creator} {macosxFileAttr not
 test macOSXFCmd-2.4 {MacOSXSetFileAttribute - type} {macosxFileAttr notRoot} {
     catch {file delete -force -- foo.test}
     close [open foo.test w]
-    list [catch {file attributes foo.test -type FOOO} msg] $msg \
+    list [catch {file attributes foo.test -type FOOT} msg] $msg \
 	    [catch {file attributes foo.test -type} msg] $msg \
 	    [file delete -force -- foo.test]
-} {0 {} 0 FOOO {}}
+} {0 {} 0 FOOT {}}
 test macOSXFCmd-2.5 {MacOSXSetFileAttribute - empty type} {macosxFileAttr notRoot} {
     catch {file delete -force -- foo.test}
     close [open foo.test w]
@@ -107,7 +103,7 @@ test macOSXFCmd-2.7 {MacOSXSetFileAttribute - rsrclength} {macosxFileAttr notRoo
     catch {file delete -force -- foo.test}
     close [open foo.test w]
     catch {
-	set f [open foo.test/rsrc w]
+	set f [open foo.test/..namedfork/rsrc w]
 	fconfigure $f -translation lf -eofchar {}
 	puts -nonewline $f "foo"
 	close $f
@@ -123,8 +119,8 @@ test macOSXFCmd-3.1 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} {
     catch {file delete -force -- bar.test}
     close [open foo.test w]
     catch {
-	file attributes foo.test -creator FOOO -type FOOO -hidden 1
-	set f [open foo.test/rsrc w]
+	file attributes foo.test -creator FOOC -type FOOT -hidden 1
+	set f [open foo.test/..namedfork/rsrc w]
 	fconfigure $f -translation lf -eofchar {}
 	puts -nonewline $f "foo"
 	close $f
@@ -135,7 +131,49 @@ test macOSXFCmd-3.1 {MacOSXCopyFileAttributes} {macosxFileAttr notRoot} {
 	    [catch {file attributes bar.test -hidden} msg] $msg \
 	    [catch {file attributes bar.test -rsrclength} msg] $msg \
 	    [file delete -force -- foo.test bar.test]
-} {0 FOOO 0 FOOO 0 1 0 3 {}}
+} {0 FOOC 0 FOOT 0 1 0 3 {}}
+
+test macOSXFCmd-4.1 {TclMacOSXMatchType} {macosxFileAttr notRoot} {
+    file mkdir globtest
+    cd globtest
+    foreach f {bar baz foo inv inw .nv reg} {
+	catch {file delete -force -- $f.test}
+	close [open $f.test w]
+    }
+    catch {file delete -force -- dir.test}
+    file mkdir dir.test
+    catch {
+	file attributes bar.test -type FOOT
+	file attributes baz.test -creator FOOC -type FOOT
+	file attributes foo.test -creator FOOC
+	file attributes inv.test -hidden 1
+	file attributes inw.test -hidden 1 -type FOOT
+	file attributes dir.test -hidden 1
+    }
+    set res [list \
+	    [catch {glob *.test} msg] $msg \
+	    [catch {glob -types FOOT *.test} msg] $msg \
+	    [catch {glob -types {{macintosh type FOOT}} *.test} msg] $msg \
+	    [catch {glob -types FOOTT *.test} msg] $msg \
+	    [catch {glob -types {{macintosh type FOOTT}} *.test} msg] $msg \
+	    [catch {glob -types {{macintosh type {}}} *.test} msg] $msg \
+	    [catch {glob -types {{macintosh creator FOOC}} *.test} msg] $msg \
+	    [catch {glob -types {{macintosh creator FOOC} {macintosh type FOOT}} *.test} msg] $msg \
+	    [catch {glob -types hidden *.test} msg] $msg \
+	    [catch {glob -types {hidden FOOT} *.test} msg] $msg \
+	]
+    cd ..
+    file delete -force globtest
+    set res
+} [list \
+	0 {bar.test baz.test dir.test foo.test inv.test inw.test reg.test} \
+	0 {bar.test baz.test inw.test} 0 {bar.test baz.test inw.test} \
+	1 {bad argument to "-types": FOOTT} \
+	1 {expected Macintosh OS type but got "FOOTT": } \
+	0 {foo.test inv.test reg.test} 0 {baz.test foo.test} \
+	0 baz.test 0 {.nv.test dir.test inv.test inw.test} \
+	0 inw.test
+]
 
 # cleanup
 cd $oldcwd
diff --git a/tests/macOSXLoad.test b/tests/macOSXLoad.test
new file mode 100644
index 0000000..12c77e0
--- /dev/null
+++ b/tests/macOSXLoad.test
@@ -0,0 +1,33 @@
+# Commands covered:  load unload
+#
+# 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) 1995 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.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2
+    namespace import -force ::tcltest::*
+}
+set oldTSF $::tcltest::testSingleFile
+set ::tcltest::testSingleFile false
+
+if {[testConstraint unix] && $tcl_platform(os) eq "Darwin" &&
+	![string match *pkga* [info loaded]]} {
+    # On Darwin, test .bundle (un)loading in addition to .dylib
+    set ext .bundle
+    source [file join [file dirname [info script]] load.test]
+    set ext .bundle
+    source [file join [file dirname [info script]] unload.test]
+    unset -nocomplain ext
+}
+
+set ::tcltest::testSingleFile $oldTSF
+unset oldTSF
+::tcltest::cleanupTests
+return
diff --git a/tests/main.test b/tests/main.test
index 0500377..351fd4f 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -1,6 +1,4 @@
 # This file contains a collection of tests for generic/tclMain.c.
-#
-# RCS: @(#) $Id: main.test,v 1.16 2005/04/28 05:32:02 dgp Exp $
 
 if {[catch {package require tcltest 2.0.2}]} {
     puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -8,15 +6,7 @@ if {[catch {package require tcltest 2.0.2}]} {
 }
 
 namespace eval ::tcl::test::main {
-
-    namespace import ::tcltest::test
-    namespace import ::tcltest::testConstraint
-    namespace import ::tcltest::interpreter
-    namespace import ::tcltest::cleanupTests
-    namespace import ::tcltest::makeFile
-    namespace import ::tcltest::removeFile
-    namespace import ::tcltest::temporaryDirectory
-    namespace import ::tcltest::workingDirectory
+    namespace import ::tcltest::*
 
     # Is [exec] defined?
     testConstraint exec [llength [info commands exec]]
@@ -76,8 +66,6 @@ namespace eval ::tcl::test::main {
     } -result [list [interpreter] -script 0]\n
 
     test Tcl_Main-1.3 {
-	Tcl_Main: encoding of arguments: done by system encoding
-	Note the shortcoming explained in Tcl Feature Request 491789
     } -constraints {
 	stdio
     } -setup {
@@ -92,10 +80,8 @@ namespace eval ::tcl::test::main {
 	[encoding convertto [encoding system] \u00c0]]] 0]\n
 
     test Tcl_Main-1.4 {
-	Tcl_Main: encoding of arguments: done by system encoding
-	Note the shortcoming explained in Tcl Feature Request 491789
     } -constraints {
-	stdio tempNotWin
+	stdio
     } -setup {
 	makeFile {puts [list $argv0 $argv $tcl_interactive]} script
 	catch {set f [open "|[list [interpreter] script \u20ac]" r]}
@@ -108,8 +94,6 @@ namespace eval ::tcl::test::main {
 	[encoding convertto [encoding system] \u20ac]]] 0]\n
 
     test Tcl_Main-1.5 {
-	Tcl_Main: encoding of script name: system encoding loss
-	Note the shortcoming explained in Tcl Feature Request 491789
     } -constraints {
 	stdio
     } -setup {
@@ -124,10 +108,8 @@ namespace eval ::tcl::test::main {
 	[encoding convertto [encoding system] \u00c0]]] {} 0]\n
 
     test Tcl_Main-1.6 {
-	Tcl_Main: encoding of script name: system encoding loss
-	Note the shortcoming explained in Tcl Feature Request 491789
     } -constraints {
-	stdio tempNotWin
+	stdio
     } -setup {
 	makeFile {puts [list $argv0 $argv $tcl_interactive]} \u20ac
 	catch {set f [open "|[list [interpreter] \u20ac]" r]}
@@ -147,7 +129,7 @@ namespace eval ::tcl::test::main {
 	set script [makeFile {} script]
 	file delete $script
 	set f [open $script w]
-	fconfigure $f -encoding utf-8
+	chan configure $f -encoding utf-8
 	puts $f {puts [list $argv0 $argv $tcl_interactive]}
 	puts -nonewline $f {puts [string equal \u20ac }
 	puts $f "\u20ac]"
@@ -168,7 +150,7 @@ namespace eval ::tcl::test::main {
 	set script [makeFile {} script]
 	file delete $script
 	set f [open $script w]
-	fconfigure $f -encoding utf-8
+	chan configure $f -encoding utf-8
 	puts $f {puts [list $argv0 $argv $tcl_interactive]}
 	puts -nonewline $f {puts [string equal \u20ac }
 	puts $f "\u20ac]"
@@ -189,7 +171,7 @@ namespace eval ::tcl::test::main {
 	set script [makeFile {} script]
 	file delete $script
 	set f [open $script w]
-	fconfigure $f -encoding utf-8
+	chan configure $f -encoding utf-8
 	puts $f {puts [list $argv0 $argv $tcl_interactive]}
 	puts -nonewline $f {puts [string equal \u20ac }
 	puts $f "\u20ac]"
@@ -554,7 +536,7 @@ namespace eval ::tcl::test::main {
 		}
 	} rc]
     } -body {
-	exec [interpreter] << {puts "In script"} \
+	exec [interpreter] << {} \
 		-appinitprocsetrcfile $rc >& result
 	set f [open result]
 	read $f
@@ -563,7 +545,28 @@ namespace eval ::tcl::test::main {
 	file delete result
 	removeFile rc
     } -result "application-specific initialization failed:\
-	\nIn script\nExit MainLoop\nIn exit\neven 0\n"
+	\nExit MainLoop\nIn exit\neven 0\n"
+
+    test Tcl_Main-4.5 {
+        Tcl_Main: Bug 1481986
+    } -constraints {
+        exec Tcltest
+    } -setup {
+        set rc [makeFile {
+                testsetmainloop
+                after 0 {puts "Event callback"}
+        } rc]
+    } -body {
+        set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+]
+        after 1000
+        type $f {puts {Interactive output}
+            exit
+        }
+        read $f
+    } -cleanup {
+        catch {close $f}
+        removeFile rc
+    } -result "Event callback\nInteractive output\n"
 
     # Tests Tcl_Main-5.*: interactive operations
 
@@ -589,7 +592,7 @@ namespace eval ::tcl::test::main {
 	catch {set f [open "|[list [interpreter]]" w+]}
     } -body {
 	type $f {
-	    fconfigure stdin -blocking 0
+	    chan configure stdin -blocking 0
 	    puts SUCCESS
 	}
 	list [catch {gets $f} line] $line
@@ -603,20 +606,19 @@ namespace eval ::tcl::test::main {
 	exec
     } -setup {
 	catch {set f [open "|[list [interpreter]]" w+]}
-	catch {fconfigure $f -blocking 0}
+	catch {chan configure $f -blocking 0}
     } -body {
-	type $f "fconfigure stdin -eofchar \\032
+	type $f "chan configure stdin -eofchar \\032
 	    if 1 \{\n\032"
 	variable wait
-	fileevent $f readable \
+	chan event $f readable \
 		[list set [namespace which -variable wait] "child exit"]
 	set id [after 2000 [list set [namespace which -variable wait] timeout]]
 	vwait [namespace which -variable wait]
 	after cancel $id
 	set wait
     } -cleanup {
-	if {[string equal timeout $wait]
-		&& [string equal unix $::tcl_platform(platform)]} {
+	if {$wait eq "timeout" && [testConstraint unix]} {
 	    exec kill [pid $f]
 	}
 	close $f
@@ -629,18 +631,17 @@ namespace eval ::tcl::test::main {
     } -setup {
 	set cmd {makeFile "if 1 \{" script}
 	catch {set f [open "|[list [interpreter]] < [list [eval $cmd]]" r]}
-	catch {fconfigure $f -blocking 0}
+	catch {chan configure $f -blocking 0}
     } -body {
 	variable wait
-	fileevent $f readable \
+	chan event $f readable \
 		[list set [namespace which -variable wait] "child exit"]
 	set id [after 2000 [list set [namespace which -variable wait] timeout]]
 	vwait [namespace which -variable wait]
 	after cancel $id
 	set wait
     } -cleanup {
-	if {[string equal timeout $wait]
-		&& [string equal unix $::tcl_platform(platform)]} {
+	if {$wait eq "timeout" && [testConstraint unix]} {
 	    exec kill [pid $f]
 	}
 	close $f
@@ -747,7 +748,7 @@ namespace eval ::tcl::test::main {
 	exec Tcltest
     } -setup {
 	catch {set f [open "|[list [interpreter]]" w+]}
-	catch {fconfigure $f -blocking 0}
+	catch {chan configure $f -blocking 0}
     } -body {
 	type $f "testsetmainloop
 	         after 2000 testexitmainloop
@@ -808,6 +809,20 @@ namespace eval ::tcl::test::main {
 	file delete result
     } -result "Exit MainLoop\nIn exit\neven 0\n"
 
+    test Tcl_Main-5.13 {
+	Bug 1775878
+    } -constraints {
+	exec
+    } -setup {
+	catch {set f [open "|[list [interpreter]]" w+]}
+    } -body {
+	type $f "puts \\"
+	type $f return
+	list [catch {gets $f} line] $line
+    } -cleanup {
+	close $f
+    } -result [list 0 return]
+
     # Tests Tcl_Main-6.*: interactive operations with prompts
 
     test Tcl_Main-6.1 {
@@ -913,6 +928,7 @@ namespace eval ::tcl::test::main {
     } -body {
 	exec [interpreter] << {
 		proc foo\{ x {}
+		set ::auto_noexec xxx
 		set tcl_interactive 1
 		foo y} >& result
 	set f [open result]
@@ -967,7 +983,7 @@ namespace eval ::tcl::test::main {
     } -body {
 	exec [interpreter] << {
 		testsetmainloop
-		fconfigure stdin -blocking 0
+		chan configure stdin -blocking 0
 		testexitmainloop
 	} >& result
 	set f [open result]
@@ -1190,6 +1206,21 @@ namespace eval ::tcl::test::main {
 	file delete result
     } -result "1\nExit MainLoop\n"
 
+    test Tcl_Main-8.13 {
+	Bug 1775878
+    } -constraints {
+	exec Tcltest
+    } -setup {
+	catch {set f [open "|[list [interpreter]]" w+]}
+    } -body {
+	exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
+	set f [open result]
+	read $f
+    } -cleanup {
+	close $f
+	file delete result
+    } -result "pwd\nExit MainLoop\n"
+
     # Tests Tcl_Main-9.*: Prompt operations
 
     test Tcl_Main-9.1 {
diff --git a/tests/mathop.test b/tests/mathop.test
new file mode 100644
index 0000000..f122b7b
--- /dev/null
+++ b/tests/mathop.test
@@ -0,0 +1,1340 @@
+# Commands covered: ::tcl::mathop::...
+#
+# 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) 2006 Donal K. Fellows
+# Copyright (c) 2006 Peter Spjuth
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::*
+}
+
+# A namespace to test that operators are exported and that they
+# work when imported
+namespace eval ::testmathop2 {
+    namespace import ::tcl::mathop::*
+}
+
+# Helper to test math ops.
+# Test different invokation variants and see that they do the same thing.
+# Byte compiled / non byte compiled version
+# Shared / unshared arguments
+# Original / imported
+proc TestOp {op args} {
+    set results {}
+
+    # Non byte compiled version, shared args
+    if {[catch {::tcl::mathop::$op {*}$args} res]} {
+        append res " $::errorCode"
+    }
+    lappend results $res
+
+    # Non byte compiled version, unshared args
+    set cmd ::tcl::mathop::\$op
+    foreach arg $args {
+        append cmd " \[format %s [list $arg]\]"
+    }
+    if {[catch $cmd res]} {
+        append res " $::errorCode"
+    }
+    lappend results $res
+
+    # Non byte compiled imported
+    if {[catch {::testmathop2::$op {*}$args} res]} {
+        append res " $::errorCode"
+    }
+    lappend results [string map {testmathop2 tcl::mathop} $res]
+
+    # BC version
+    set argList1 {}
+    set argList2 {}
+    set argList3 {}
+    for {set t 0} {$t < [llength $args]} {incr t} {
+        lappend argList1 a$t
+        lappend argList2 \$a$t
+        lappend argList3 "\[format %s \$a$t\]"
+    }
+    # Shared args
+    proc _TestOp  $argList1 "::tcl::mathop::$op [join $argList2]"
+    # Unshared args
+    proc _TestOp2 $argList1 "::tcl::mathop::$op [join $argList3]"
+    # Imported
+    proc _TestOp3 $argList1 "::testmathop2::$op [join $argList2]"
+
+    set ::tcl_traceCompile 0  ;# Set to 2 to help with debug
+    if {[catch {_TestOp {*}$args} res]} {
+        append res " $::errorCode"
+    }
+    set ::tcl_traceCompile 0
+    lappend results $res
+
+    if {[catch {_TestOp2 {*}$args} res]} {
+        append res " $::errorCode"
+    }
+    lappend results $res
+
+    if {[catch {_TestOp3 {*}$args} res]} {
+        append res " $::errorCode"
+    }
+    lappend results [string map {testmathop2 tcl::mathop} $res]
+
+    # Check that they do the same
+    set len [llength $results]
+    for {set i 0} {$i < ($len - 1)} {incr i} {
+        set res1 [lindex $results $i]
+        set res2 [lindex $results $i+1]
+        if {$res1 ne $res2} {
+            return "$i:($res1 != $res2)"
+        }
+    }
+    return [lindex $results 0]
+}
+
+# start of tests
+
+namespace eval ::testmathop {
+    namespace path ::tcl::mathop
+    variable op ;# stop surprises!
+
+    test mathop-1.1 {compiled +} { + } 0
+    test mathop-1.2 {compiled +} { + 1 } 1
+    test mathop-1.3 {compiled +} { + 1 2 } 3
+    test mathop-1.4 {compiled +} { + 1 2 3 } 6
+    test mathop-1.5 {compiled +} { + 1.0 2 3 } 6.0
+    test mathop-1.6 {compiled +} { + 1 2 3.0 } 6.0
+    test mathop-1.7 {compiled +} { + 100000000000 2 3 } 100000000005
+    test mathop-1.8 {compiled +} { + 1 2 300000000000 } 300000000003
+    test mathop-1.9 {compiled +} { + 1000000000000000000000 2 3 } 1000000000000000000005
+    test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003
+    test mathop-1.11 {compiled +: errors} -returnCodes error -body {
+	+ x 0
+    } -result {can't use non-numeric string as operand of "+"}
+    test mathop-1.12 {compiled +: errors} -returnCodes error -body {
+	+ nan 0
+    } -result {can't use non-numeric floating-point value as operand of "+"}
+    test mathop-1.13 {compiled +: errors} -returnCodes error -body {
+	+ 0 x
+    } -result {can't use non-numeric string as operand of "+"}
+    test mathop-1.14 {compiled +: errors} -returnCodes error -body {
+	+ 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "+"}
+    test mathop-1.15 {compiled +: errors} -returnCodes error -body {
+	+ 0o8 0
+    } -result {can't use invalid octal number as operand of "+"}
+    test mathop-1.16 {compiled +: errors} -returnCodes error -body {
+	+ 0 0o8
+    } -result {can't use invalid octal number as operand of "+"}
+    test mathop-1.17 {compiled +: errors} -returnCodes error -body {
+	+ 0 [error expectedError]
+    } -result expectedError
+    test mathop-1.18 {compiled +: argument processing order} -body {
+	# Bytecode compilation known hard for 3+ arguments
+	list [catch {
+	    + [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+    set op +
+    test mathop-1.19 {interpreted +} { $op } 0
+    test mathop-1.20 {interpreted +} { $op 1 } 1
+    test mathop-1.21 {interpreted +} { $op 1 2 } 3
+    test mathop-1.22 {interpreted +} { $op 1 2 3 } 6
+    test mathop-1.23 {interpreted +} { $op 1.0 2 3 } 6.0
+    test mathop-1.24 {interpreted +} { $op 1 2 3.0 } 6.0
+    test mathop-1.25 {interpreted +} { $op 100000000000 2 3 } 100000000005
+    test mathop-1.26 {interpreted +} { $op 1 2 300000000000 } 300000000003
+    test mathop-1.27 {interpreted +} { $op 1000000000000000000000 2 3 } 1000000000000000000005
+    test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003
+    test mathop-1.29 {interpreted +: errors} -returnCodes error -body {
+	$op x 0
+    } -result {can't use non-numeric string as operand of "+"}
+    test mathop-1.30 {interpreted +: errors} -returnCodes error -body {
+	$op nan 0
+    } -result {can't use non-numeric floating-point value as operand of "+"}
+    test mathop-1.31 {interpreted +: errors} -returnCodes error -body {
+	$op 0 x
+    } -result {can't use non-numeric string as operand of "+"}
+    test mathop-1.32 {interpreted +: errors} -returnCodes error -body {
+	$op 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "+"}
+    test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
+	$op 0o8 0
+    } -result {can't use invalid octal number as operand of "+"}
+    test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
+	$op 0 0o8
+    } -result {can't use invalid octal number as operand of "+"}
+    test mathop-1.35 {interpreted +: errors} -returnCodes error -body {
+	$op 0 [error expectedError]
+    } -result expectedError
+    test mathop-1.36 {interpreted +: argument processing order} -body {
+	list [catch {
+	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+
+    test mathop-2.1 {compiled *} { * } 1
+    test mathop-2.2 {compiled *} { * 2 } 2
+    test mathop-2.3 {compiled *} { * 2 3 } 6
+    test mathop-2.4 {compiled *} { * 2 3 4 } 24
+    test mathop-2.5 {compiled *} { * 1.0 2 3 } 6.0
+    test mathop-2.6 {compiled *} { * 1 2 3.0 } 6.0
+    test mathop-2.7 {compiled *} { * 100000000000 2 3 } 600000000000
+    test mathop-2.8 {compiled *} { * 1 2 300000000000 } 600000000000
+    test mathop-2.9 {compiled *} { * 1000000000000000000000 2 3 } 6000000000000000000000
+    test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000
+    test mathop-2.11 {compiled *: errors} -returnCodes error -body {
+	* x 0
+    } -result {can't use non-numeric string as operand of "*"}
+    test mathop-2.12 {compiled *: errors} -returnCodes error -body {
+	* nan 0
+    } -result {can't use non-numeric floating-point value as operand of "*"}
+    test mathop-2.13 {compiled *: errors} -returnCodes error -body {
+	* 0 x
+    } -result {can't use non-numeric string as operand of "*"}
+    test mathop-2.14 {compiled *: errors} -returnCodes error -body {
+	* 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "*"}
+    test mathop-2.15 {compiled *: errors} -returnCodes error -body {
+	* 0o8 0
+    } -result {can't use invalid octal number as operand of "*"}
+    test mathop-2.16 {compiled *: errors} -returnCodes error -body {
+	* 0 0o8
+    } -result {can't use invalid octal number as operand of "*"}
+    test mathop-2.17 {compiled *: errors} -returnCodes error -body {
+	* 0 [error expectedError]
+    } -result expectedError
+    test mathop-2.18 {compiled *: argument processing order} -body {
+	# Bytecode compilation known hard for 3+ arguments
+	list [catch {
+	    * [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+    set op *
+    test mathop-2.19 {interpreted *} { $op } 1
+    test mathop-2.20 {interpreted *} { $op 2 } 2
+    test mathop-2.21 {interpreted *} { $op 2 3 } 6
+    test mathop-2.22 {interpreted *} { $op 2 3 4 } 24
+    test mathop-2.23 {interpreted *} { $op 1.0 2 3 } 6.0
+    test mathop-2.24 {interpreted *} { $op 1 2 3.0 } 6.0
+    test mathop-2.25 {interpreted *} { $op 100000000000 2 3 } 600000000000
+    test mathop-2.26 {interpreted *} { $op 1 2 300000000000 } 600000000000
+    test mathop-2.27 {interpreted *} { $op 1000000000000000000000 2 3 } 6000000000000000000000
+    test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000
+    test mathop-2.29 {interpreted *: errors} -returnCodes error -body {
+	$op x 0
+    } -result {can't use non-numeric string as operand of "*"}
+    test mathop-2.30 {interpreted *: errors} -returnCodes error -body {
+	$op nan 0
+    } -result {can't use non-numeric floating-point value as operand of "*"}
+    test mathop-2.31 {interpreted *: errors} -returnCodes error -body {
+	$op 0 x
+    } -result {can't use non-numeric string as operand of "*"}
+    test mathop-2.32 {interpreted *: errors} -returnCodes error -body {
+	$op 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "*"}
+    test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
+	$op 0o8 0
+    } -result {can't use invalid octal number as operand of "*"}
+    test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
+	$op 0 0o8
+    } -result {can't use invalid octal number as operand of "*"}
+    test mathop-2.35 {interpreted *: errors} -returnCodes error -body {
+	$op 0 [error expectedError]
+    } -result expectedError
+    test mathop-2.36 {interpreted *: argument processing order} -body {
+	list [catch {
+	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+
+    test mathop-3.1 {compiled !} {! 0} 1
+    test mathop-3.2 {compiled !} {! 1} 0
+    test mathop-3.3 {compiled !} {! false} 1
+    test mathop-3.4 {compiled !} {! true} 0
+    test mathop-3.5 {compiled !} {! 0.0} 1
+    test mathop-3.6 {compiled !} {! 10000000000} 0
+    test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0
+    test mathop-3.8 {compiled !: errors} -body {
+	! foobar
+    } -returnCodes error -result {can't use non-numeric string as operand of "!"}
+    test mathop-3.9 {compiled !: errors} -body {
+	! 0 0
+    } -returnCodes error -result "wrong # args: should be \"! boolean\""
+    test mathop-3.10 {compiled !: errors} -body {
+	!
+    } -returnCodes error -result "wrong # args: should be \"! boolean\""
+    set op !
+    test mathop-3.11 {interpreted !} {$op 0} 1
+    test mathop-3.12 {interpreted !} {$op 1} 0
+    test mathop-3.13 {interpreted !} {$op false} 1
+    test mathop-3.14 {interpreted !} {$op true} 0
+    test mathop-3.15 {interpreted !} {$op 0.0} 1
+    test mathop-3.16 {interpreted !} {$op 10000000000} 0
+    test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0
+    test mathop-3.18 {interpreted !: errors} -body {
+	$op foobar
+    } -returnCodes error -result {can't use non-numeric string as operand of "!"}
+    test mathop-3.19 {interpreted !: errors} -body {
+	$op 0 0
+    } -returnCodes error -result "wrong # args: should be \"! boolean\""
+    test mathop-3.20 {interpreted !: errors} -body {
+	$op
+    } -returnCodes error -result "wrong # args: should be \"! boolean\""
+    test mathop-3.21 {compiled !: error} -returnCodes error -body {
+	! NaN
+    } -result {can't use non-numeric floating-point value as operand of "!"}
+    test mathop-3.22 {interpreted !: error} -returnCodes error -body {
+	$op NaN
+    } -result {can't use non-numeric floating-point value as operand of "!"}
+
+    test mathop-4.1 {compiled ~} {~ 0} -1
+    test mathop-4.2 {compiled ~} {~ 1} -2
+    test mathop-4.3 {compiled ~} {~ 31} -32
+    test mathop-4.4 {compiled ~} {~ -127} 126
+    test mathop-4.5 {compiled ~} {~ -0} -1
+    test mathop-4.6 {compiled ~} {~ 10000000000} -10000000001
+    test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001
+    test mathop-4.8 {compiled ~: errors} -body {
+	~ foobar
+    } -returnCodes error -result {can't use non-numeric string as operand of "~"}
+    test mathop-4.9 {compiled ~: errors} -body {
+	~ 0 0
+    } -returnCodes error -result "wrong # args: should be \"~ integer\""
+    test mathop-4.10 {compiled ~: errors} -body {
+	~
+    } -returnCodes error -result "wrong # args: should be \"~ integer\""
+    test mathop-4.11 {compiled ~: errors} -returnCodes error -body {
+	~ 0.0
+    } -result {can't use floating-point value as operand of "~"}
+    test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
+	~ NaN
+    } -result {can't use non-numeric floating-point value as operand of "~"}
+    set op ~
+    test mathop-4.13 {interpreted ~} {$op 0} -1
+    test mathop-4.14 {interpreted ~} {$op 1} -2
+    test mathop-4.15 {interpreted ~} {$op 31} -32
+    test mathop-4.16 {interpreted ~} {$op -127} 126
+    test mathop-4.17 {interpreted ~} {$op -0} -1
+    test mathop-4.18 {interpreted ~} {$op 10000000000} -10000000001
+    test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001
+    test mathop-4.20 {interpreted ~: errors} -body {
+	$op foobar
+    } -returnCodes error -result {can't use non-numeric string as operand of "~"}
+    test mathop-4.21 {interpreted ~: errors} -body {
+	$op 0 0
+    } -returnCodes error -result "wrong # args: should be \"~ integer\""
+    test mathop-4.22 {interpreted ~: errors} -body {
+	$op
+    } -returnCodes error -result "wrong # args: should be \"~ integer\""
+    test mathop-4.23 {interpreted ~: errors} -returnCodes error -body {
+	$op 0.0
+    } -result {can't use floating-point value as operand of "~"}
+    test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
+	$op NaN
+    } -result {can't use non-numeric floating-point value as operand of "~"}
+
+    test mathop-5.1 {compiled eq} {eq {} a} 0
+    test mathop-5.2 {compiled eq} {eq a a} 1
+    test mathop-5.3 {compiled eq} {eq a {}} 0
+    test mathop-5.4 {compiled eq} {eq a b} 0
+    test mathop-5.5 {compiled eq} { eq } 1
+    test mathop-5.6 {compiled eq} {eq a} 1
+    test mathop-5.7 {compiled eq} {eq a a a} 1
+    test mathop-5.8 {compiled eq} {eq a a b} 0
+    test mathop-5.9 {compiled eq} -body {
+	eq a b [error foobar]
+    } -returnCodes error -result foobar
+    test mathop-5.10 {compiled eq} {eq NaN Na NaN} 0
+    set op eq
+    test mathop-5.11 {interpreted eq} {$op {} a} 0
+    test mathop-5.12 {interpreted eq} {$op a a} 1
+    test mathop-5.13 {interpreted eq} {$op a {}} 0
+    test mathop-5.14 {interpreted eq} {$op a b} 0
+    test mathop-5.15 {interpreted eq} { $op } 1
+    test mathop-5.16 {interpreted eq} {$op a} 1
+    test mathop-5.17 {interpreted eq} {$op a a a} 1
+    test mathop-5.18 {interpreted eq} {$op a a b} 0
+    test mathop-5.19 {interpreted eq} -body {
+	$op a b [error foobar]
+    } -returnCodes error -result foobar
+    test mathop-5.20 {interpreted eq} {$op NaN Na NaN} 0
+
+    variable big1      12135435435354435435342423948763867876
+    variable big2       2746237174783836746262564892918327847
+    variable wide1                             12345678912345
+    variable wide2                             87321847232215
+    variable small1                                     87345
+    variable small2                                     16753
+
+    test mathop-6.1 {compiled &} { & } -1
+    test mathop-6.2 {compiled &} { & 1 } 1
+    test mathop-6.3 {compiled &} { & 1 2 } 0
+    test mathop-6.4 {compiled &} { & 3 7 6 } 2
+    test mathop-6.5 {compiled &} -returnCodes error -body {
+	& 1.0 2 3
+    } -result {can't use floating-point value as operand of "&"}
+    test mathop-6.6 {compiled &} -returnCodes error -body {
+	& 1 2 3.0
+    } -result {can't use floating-point value as operand of "&"}
+    test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2
+    test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85
+    test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2
+    test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85
+    test mathop-6.11 {compiled &: errors} -returnCodes error -body {
+	& x 0
+    } -result {can't use non-numeric string as operand of "&"}
+    test mathop-6.12 {compiled &: errors} -returnCodes error -body {
+	& nan 0
+    } -result {can't use non-numeric floating-point value as operand of "&"}
+    test mathop-6.13 {compiled &: errors} -returnCodes error -body {
+	& 0 x
+    } -result {can't use non-numeric string as operand of "&"}
+    test mathop-6.14 {compiled &: errors} -returnCodes error -body {
+	& 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "&"}
+    test mathop-6.15 {compiled &: errors} -returnCodes error -body {
+	& 0o8 0
+    } -result {can't use invalid octal number as operand of "&"}
+    test mathop-6.16 {compiled &: errors} -returnCodes error -body {
+	& 0 0o8
+    } -result {can't use invalid octal number as operand of "&"}
+    test mathop-6.17 {compiled &: errors} -returnCodes error -body {
+	& 0 [error expectedError]
+    } -result expectedError
+    test mathop-6.18 {compiled &: argument processing order} -body {
+	# Bytecode compilation known hard for 3+ arguments
+	list [catch {
+	    & [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+    set op &
+    test mathop-6.19 {interpreted &} { $op } -1
+    test mathop-6.20 {interpreted &} { $op 1 } 1
+    test mathop-6.21 {interpreted &} { $op 1 2 } 0
+    test mathop-6.22 {interpreted &} { $op 3 7 6 } 2
+    test mathop-6.23 {interpreted &} -returnCodes error -body {
+	$op 1.0 2 3
+    } -result {can't use floating-point value as operand of "&"}
+    test mathop-6.24 {interpreted &} -returnCodes error -body {
+	$op 1 2 3.0
+    } -result {can't use floating-point value as operand of "&"}
+    test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2
+    test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85
+    test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2
+    test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85
+    test mathop-6.29 {interpreted &: errors} -returnCodes error -body {
+	$op x 0
+    } -result {can't use non-numeric string as operand of "&"}
+    test mathop-6.30 {interpreted &: errors} -returnCodes error -body {
+	$op nan 0
+    } -result {can't use non-numeric floating-point value as operand of "&"}
+    test mathop-6.31 {interpreted &: errors} -returnCodes error -body {
+	$op 0 x
+    } -result {can't use non-numeric string as operand of "&"}
+    test mathop-6.32 {interpreted &: errors} -returnCodes error -body {
+	$op 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "&"}
+    test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
+	$op 0o8 0
+    } -result {can't use invalid octal number as operand of "&"}
+    test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
+	$op 0 0o8
+    } -result {can't use invalid octal number as operand of "&"}
+    test mathop-6.35 {interpreted &: errors} -returnCodes error -body {
+	$op 0 [error expectedError]
+    } -result expectedError
+    test mathop-6.36 {interpreted &: argument processing order} -body {
+	list [catch {
+	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+    test mathop-6.37 {& and bignums} {
+	list [& $big1 $big2] [$op $big1 $big2]
+    } {712439449294653815890598856501796 712439449294653815890598856501796}
+    test mathop-6.38 {& and bignums} {
+	list [& $big1 $wide2] [$op $big1 $wide2]
+    } {78521450111684 78521450111684}
+    test mathop-6.39 {& and bignums} {
+	list [& $big1 $small2] [$op $big1 $small2]
+    } {96 96}
+    test mathop-6.40 {& and bignums} {
+	list [& $wide1 $big2] [$op $wide1 $big2]
+    } {2371422390785 2371422390785}
+    test mathop-6.41 {& and bignums} {
+	list [& $wide1 $wide2] [$op $wide1 $wide2]
+    } {12275881497169 12275881497169}
+    test mathop-6.42 {& and bignums} {
+	list [& $wide1 $small2] [$op $wide1 $small2]
+    } {16721 16721}
+    test mathop-6.43 {& and bignums} {
+	list [& $small1 $big2] [$op $small1 $big2]
+    } {33 33}
+    test mathop-6.44 {& and bignums} {
+	list [& $small1 $wide2] [$op $small1 $wide2]
+    } {87057 87057}
+    test mathop-6.45 {& and bignums} {
+	list [& $small1 $small2] [$op $small1 $small2]
+    } {16689 16689}
+
+    test mathop-7.1 {compiled |} { | } 0
+    test mathop-7.2 {compiled |} { | 1 } 1
+    test mathop-7.3 {compiled |} { | 1 2 } 3
+    test mathop-7.4 {compiled |} { | 3 7 6 } 7
+    test mathop-7.5 {compiled |} -returnCodes error -body {
+	| 1.0 2 3
+    } -result {can't use floating-point value as operand of "|"}
+    test mathop-7.6 {compiled |} -returnCodes error -body {
+	| 1 2 3.0
+    } -result {can't use floating-point value as operand of "|"}
+    test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110
+    test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503
+    test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110
+    test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503
+    test mathop-7.11 {compiled |: errors} -returnCodes error -body {
+	| x 0
+    } -result {can't use non-numeric string as operand of "|"}
+    test mathop-7.12 {compiled |: errors} -returnCodes error -body {
+	| nan 0
+    } -result {can't use non-numeric floating-point value as operand of "|"}
+    test mathop-7.13 {compiled |: errors} -returnCodes error -body {
+	| 0 x
+    } -result {can't use non-numeric string as operand of "|"}
+    test mathop-7.14 {compiled |: errors} -returnCodes error -body {
+	| 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "|"}
+    test mathop-7.15 {compiled |: errors} -returnCodes error -body {
+	| 0o8 0
+    } -result {can't use invalid octal number as operand of "|"}
+    test mathop-7.16 {compiled |: errors} -returnCodes error -body {
+	| 0 0o8
+    } -result {can't use invalid octal number as operand of "|"}
+    test mathop-7.17 {compiled |: errors} -returnCodes error -body {
+	| 0 [error expectedError]
+    } -result expectedError
+    test mathop-7.18 {compiled |: argument processing order} -body {
+	# Bytecode compilation known hard for 3+ arguments
+	list [catch {
+	    | [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+    set op |
+    test mathop-7.19 {interpreted |} { $op } 0
+    test mathop-7.20 {interpreted |} { $op 1 } 1
+    test mathop-7.21 {interpreted |} { $op 1 2 } 3
+    test mathop-7.22 {interpreted |} { $op 3 7 6 } 7
+    test mathop-7.23 {interpreted |} -returnCodes error -body {
+	$op 1.0 2 3
+    } -result {can't use floating-point value as operand of "|"}
+    test mathop-7.24 {interpreted |} -returnCodes error -body {
+	$op 1 2 3.0
+    } -result {can't use floating-point value as operand of "|"}
+    test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110
+    test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503
+    test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110
+    test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503
+    test mathop-7.29 {interpreted |: errors} -returnCodes error -body {
+	$op x 0
+    } -result {can't use non-numeric string as operand of "|"}
+    test mathop-7.30 {interpreted |: errors} -returnCodes error -body {
+	$op nan 0
+    } -result {can't use non-numeric floating-point value as operand of "|"}
+    test mathop-7.31 {interpreted |: errors} -returnCodes error -body {
+	$op 0 x
+    } -result {can't use non-numeric string as operand of "|"}
+    test mathop-7.32 {interpreted |: errors} -returnCodes error -body {
+	$op 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "|"}
+    test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
+	$op 0o8 0
+    } -result {can't use invalid octal number as operand of "|"}
+    test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
+	$op 0 0o8
+    } -result {can't use invalid octal number as operand of "|"}
+    test mathop-7.35 {interpreted |: errors} -returnCodes error -body {
+	$op 0 [error expectedError]
+    } -result expectedError
+    test mathop-7.36 {interpreted |: argument processing order} -body {
+	list [catch {
+	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+    test mathop-7.37 {| and bignums} {
+	list [| $big1 $big2] [$op $big1 $big2]
+    } {14880960170688977527789098242825693927 14880960170688977527789098242825693927}
+    test mathop-7.38 {| and bignums} {
+	list [| $big1 $wide2] [$op $big1 $wide2]
+    } {12135435435354435435342432749160988407 12135435435354435435342432749160988407}
+    test mathop-7.39 {| and bignums} {
+	list [| $big1 $small2] [$op $big1 $small2]
+    } {12135435435354435435342423948763884533 12135435435354435435342423948763884533}
+    test mathop-7.40 {| and bignums} {
+	list [| $wide1 $big2] [$op $wide1 $big2]
+    } {2746237174783836746262574867174849407 2746237174783836746262574867174849407}
+    test mathop-7.41 {| and bignums} {
+	list [| $wide1 $wide2] [$op $wide1 $wide2]
+    } {87391644647391 87391644647391}
+    test mathop-7.42 {| and bignums} {
+	list [| $wide1 $small2] [$op $wide1 $small2]
+    } {12345678912377 12345678912377}
+    test mathop-7.43 {| and bignums} {
+	list [| $small1 $big2] [$op $small1 $big2]
+    } {2746237174783836746262564892918415159 2746237174783836746262564892918415159}
+    test mathop-7.44 {| and bignums} {
+	list [| $small1 $wide2] [$op $small1 $wide2]
+    } {87321847232503 87321847232503}
+    test mathop-7.45 {| and bignums} {
+	list [| $small1 $small2] [$op $small1 $small2]
+    } {87409 87409}
+
+    test mathop-8.1 {compiled ^} { ^ } 0
+    test mathop-8.2 {compiled ^} { ^ 1 } 1
+    test mathop-8.3 {compiled ^} { ^ 1 2 } 3
+    test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2
+    test mathop-8.5 {compiled ^} -returnCodes error -body {
+	^ 1.0 2 3
+    } -result {can't use floating-point value as operand of "^"}
+    test mathop-8.6 {compiled ^} -returnCodes error -body {
+	^ 1 2 3.0
+    } -result {can't use floating-point value as operand of "^"}
+    test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110
+    test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333
+    test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110
+    test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333
+    test mathop-8.11 {compiled ^: errors} -returnCodes error -body {
+	^ x 0
+    } -result {can't use non-numeric string as operand of "^"}
+    test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
+	^ nan 0
+    } -result {can't use non-numeric floating-point value as operand of "^"}
+    test mathop-8.13 {compiled ^: errors} -returnCodes error -body {
+	^ 0 x
+    } -result {can't use non-numeric string as operand of "^"}
+    test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
+	^ 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "^"}
+    test mathop-8.15 {compiled ^: errors} -returnCodes error -body {
+	^ 0o8 0
+    } -result {can't use invalid octal number as operand of "^"}
+    test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
+	^ 0 0o8
+    } -result {can't use invalid octal number as operand of "^"}
+    test mathop-8.17 {compiled ^: errors} -returnCodes error -body {
+	^ 0 [error expectedError]
+    } -result expectedError
+    test mathop-8.18 {compiled ^: argument processing order} -body {
+	# Bytecode compilation known hard for 3+ arguments
+	list [catch {
+	    ^ [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+    set op ^
+    test mathop-8.19 {interpreted ^} { $op } 0
+    test mathop-8.20 {interpreted ^} { $op 1 } 1
+    test mathop-8.21 {interpreted ^} { $op 1 2 } 3
+    test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2
+    test mathop-8.23 {interpreted ^} -returnCodes error -body {
+	$op 1.0 2 3
+    } -result {can't use floating-point value as operand of "^"}
+    test mathop-8.24 {interpreted ^} -returnCodes error -body {
+	$op 1 2 3.0
+    } -result {can't use floating-point value as operand of "^"}
+    test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110
+    test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333
+    test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110
+    test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333
+    test mathop-8.29 {interpreted ^: errors} -returnCodes error -body {
+	$op x 0
+    } -result {can't use non-numeric string as operand of "^"}
+    test mathop-8.30 {interpreted ^: errors} -returnCodes error -body {
+	$op nan 0
+    } -result {can't use non-numeric floating-point value as operand of "^"}
+    test mathop-8.31 {interpreted ^: errors} -returnCodes error -body {
+	$op 0 x
+    } -result {can't use non-numeric string as operand of "^"}
+    test mathop-8.32 {interpreted ^: errors} -returnCodes error -body {
+	$op 0 nan
+    } -result {can't use non-numeric floating-point value as operand of "^"}
+    test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
+	$op 0o8 0
+    } -result {can't use invalid octal number as operand of "^"}
+    test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
+	$op 0 0o8
+    } -result {can't use invalid octal number as operand of "^"}
+    test mathop-8.35 {interpreted ^: errors} -returnCodes error -body {
+	$op 0 [error expectedError]
+    } -result expectedError
+    test mathop-8.36 {interpreted ^: argument processing order} -body {
+	list [catch {
+	    $op [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+	} msg] $msg $x
+    } -result {1 expected 2}
+    test mathop-8.37 {^ and bignums} {
+	list [^ $big1 $big2] [$op $big1 $big2]
+    } {14880247731239682873973207643969192131 14880247731239682873973207643969192131}
+    test mathop-8.38 {^ and bignums} {
+	list [^ $big1 $wide2] [$op $big1 $wide2]
+    } {12135435435354435435342354227710876723 12135435435354435435342354227710876723}
+    test mathop-8.39 {^ and bignums} {
+	list [^ $big1 $small2] [$op $big1 $small2]
+    } {12135435435354435435342423948763884437 12135435435354435435342423948763884437}
+    test mathop-8.40 {^ and bignums} {
+	list [^ $wide1 $big2] [$op $wide1 $big2]
+    } {2746237174783836746262572495752458622 2746237174783836746262572495752458622}
+    test mathop-8.41 {^ and bignums} {
+	list [^ $wide1 $wide2] [$op $wide1 $wide2]
+    } {75115763150222 75115763150222}
+    test mathop-8.42 {^ and bignums} {
+	list [^ $wide1 $small2] [$op $wide1 $small2]
+    } {12345678895656 12345678895656}
+    test mathop-8.43 {^ and bignums} {
+	list [^ $small1 $big2] [$op $small1 $big2]
+    } {2746237174783836746262564892918415126 2746237174783836746262564892918415126}
+    test mathop-8.44 {^ and bignums} {
+	list [^ $small1 $wide2] [$op $small1 $wide2]
+    } {87321847145446 87321847145446}
+    test mathop-8.45 {^ and bignums} {
+	list [^ $small1 $small2] [$op $small1 $small2]
+    } {70720 70720}
+
+    # TODO: % ** << >>  - /  == != < <= > >=  ne  in ni
+
+    test mathop-13.100 {compiled -: argument processing order} -body {
+      # Bytecode compilation known hard for 3+ arguments
+      list [catch {
+          - [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+      } msg] $msg $x
+    } -result {1 expected 2}
+
+    test mathop-14.100 {compiled /: argument processing order} -body {
+      # Bytecode compilation known hard for 3+ arguments
+      list [catch {
+          / [set x 0] [incr x] NaN [incr x] [error expected] [incr x]
+      } msg] $msg $x
+    } -result {1 expected 2}
+}
+
+test mathop-20.1 { zero args, return unit } {
+    set res {}
+    foreach op {+ * & ^ | ** < <= > >= == eq} {
+        lappend res [TestOp $op]
+    }
+    set res
+} {0 1 -1 0 0 1 1 1 1 1 1 1}
+test mathop-20.2 { zero args, not allowed } {
+    set exp {}
+    foreach op {~ ! << >> % != ne in ni - /} {
+        set res [TestOp $op]
+        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
+            lappend exp 0
+        } else {
+            lappend exp $res
+        }
+    }
+    set exp
+} {0 0 0 0 0 0 0 0 0 0 0}
+test mathop-20.3 { one arg } {
+    set res {}
+    foreach val {7 8.3} {
+        foreach op {+ ** - * / < <= > >= == eq !} {
+            lappend res [TestOp $op $val]
+        }
+    }
+    set res
+} [list 7   7   -7   7   [expr {1.0/7.0}] 1 1 1 1 1 1 0 \
+        8.3 8.3 -8.3 8.3 [expr {1.0/8.3}] 1 1 1 1 1 1 0]
+test mathop-20.4 { one arg, integer only ops } {
+    set res {}
+    foreach val {23} {
+        foreach op {& | ^ ~} {
+            lappend res [TestOp $op $val]
+        }
+    }
+    set res
+} [list 23 23 23 -24]
+test mathop-20.5 { one arg, not allowed } {
+    set exp {}
+    foreach op {% != ne in ni << >>} {
+        set res [TestOp $op 1]
+        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
+            lappend exp 0
+        } else {
+            lappend exp $res
+        }
+    }
+    set exp
+} {0 0 0 0 0 0 0}
+test mathop-20.6 { one arg, error } {
+    set res {}
+    set exp {}
+    foreach vals {x {1 x} {1 1 x} {1 x 1}} {
+        # skipping - for now, knownbug...
+        foreach op {+ * / & | ^ **} {
+            lappend res [TestOp $op {*}$vals]
+            lappend exp "can't use non-numeric string as operand of \"$op\"\
+		ARITH DOMAIN {non-numeric string}"
+        }
+    }
+    foreach op {+ * / & | ^ **} {
+	lappend res [TestOp $op NaN 1]
+	lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\
+	    ARITH DOMAIN {non-numeric floating-point value}"
+    }
+    expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-20.7 { multi arg } {
+    set res {}
+    foreach vals {{1 2} {3 4 5} {4 3 2 1}} {
+        foreach op {+ - * /} {
+            lappend res [TestOp $op {*}$vals]
+        }
+    }
+    set res
+} [list 3 -1 2 0  12 -6 60 0  10 -2 24 0]
+test mathop-20.8 { multi arg, double } {
+    set res {}
+    foreach vals {{1.0 2} {3.0 4 5} {4 3.0 2 1}
+	    {1.0 -1.0 1e-18} {1.0 1.0 1e-18}} {
+        foreach op {+ - * /} {
+            lappend res [TestOp $op {*}$vals]
+        }
+    }
+    set res
+} [list 3.0 -1.0 2.0 0.5  12.0 -6.0 60.0 0.15  10.0 -2.0 24.0 [expr {2.0/3}] 1e-18 2.0 -1e-18 [expr {-1.0/1e-18}] 2.0 -1e-18 1e-18 [expr {1.0/1e-18}]]
+
+test mathop-21.1 { unary ops, bitnot } {
+    set res {}
+    lappend res [TestOp ~ 7]
+    lappend res [TestOp ~ -5]
+    lappend res [TestOp ~ 354657483923456]
+    lappend res [TestOp ~ 123456789123456789123456789]
+    set res
+} [list -8 4 -354657483923457 -123456789123456789123456790]
+test mathop-21.2 { unary ops, logical not } {
+    set res {}
+    lappend res [TestOp ! 0]
+    lappend res [TestOp ! 1]
+    lappend res [TestOp ! true]
+    lappend res [TestOp ! false]
+    lappend res [TestOp ! 37]
+    lappend res [TestOp ! 8.5]
+    set res
+} [list 1 0 0 1 0 0]
+test mathop-21.3 { unary ops, negation } {
+    set res {}
+    lappend res [TestOp -  7.2]
+    lappend res [TestOp - -5]
+    lappend res [TestOp - -2147483648]                  ;# -2**31
+    lappend res [TestOp - -9223372036854775808]         ;# -2**63
+    lappend res [TestOp -  354657483923456]             ;# wide
+    lappend res [TestOp -  123456789123456789123456789] ;# big
+    set res
+} [list -7.2 5 2147483648 9223372036854775808 -354657483923456 \
+           -123456789123456789123456789]
+test mathop-21.4 { unary ops, inversion } {
+    set res {}
+    lappend res [TestOp / 1]
+    lappend res [TestOp / 5]
+    lappend res [TestOp / 5.6]
+    lappend res [TestOp / -8]
+    lappend res [TestOp /  354657483923456]             ;# wide
+    lappend res [TestOp /  123456789123456789123456789] ;# big
+    set res
+} [list 1.0 0.2 0.17857142857142858 -0.125 \
+           2.8196218755553604e-15 8.10000006561e-27]
+test mathop-21.5 { unary ops, bad values } {
+    set res {}
+    set exp {}
+    lappend res [TestOp / x]
+    lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}"
+    lappend res [TestOp - x]
+    lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}"
+    lappend res [TestOp ~ x]
+    lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}"
+    lappend res [TestOp ! x]
+    lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}"
+    lappend res [TestOp ~ 5.0]
+    lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}"
+    expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-21.6 { unary ops, too many } {
+    set exp {}
+    foreach op {~ !} {
+        set res [TestOp $op 7 8]
+        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
+            lappend exp 0
+        } else {
+            lappend exp $res
+        }
+    }
+    set exp
+} {0 0}
+
+test mathop-22.1 { bitwise ops } {
+    set res {}
+    foreach vals {5 {1 6} {1 2 3} {1 2 3 4}} {
+        foreach op {& | ^} {
+            lappend res [TestOp $op {*}$vals]
+        }
+    }
+    set res
+} [list 5 5 5  0 7 7  0 3 0  0 7 4]
+test mathop-22.2 { bitwise ops on bignums } {
+    set dig 50
+    set a 0x[string repeat 5 $dig]
+    set b 0x[string repeat 7 $dig]
+    set c 0x[string repeat 9 $dig]
+    set bn [expr {~$b}]
+    set cn [expr {~$c}]
+
+    set res {}
+    foreach vals [list [list $a $b] [list $a $c] [list $b $c] \
+                          [list $a $bn] [list $bn $c] [list $bn $cn]] {
+        foreach op {& | ^} {
+            lappend res [TestOp $op {*}$vals]
+        }
+    }
+    set exp {}
+    foreach d {5 7 2  1 D C  1 F E  0 -D -D  8 -9 -1  -0 -E E} {
+        if {[string match "-*" $d]} {
+            set d [format %X [expr 15-0x[string range $d 1 end]]]
+            set val [expr -0x[string repeat $d $dig]-1]
+        } else {
+            set val [expr 0x[string repeat $d $dig]]
+        }
+        lappend exp $val
+    }
+    expr {$exp eq $res ? 1 : "($res != $exp"}
+} 1
+test mathop-22.3 { bitwise ops } {
+    set big1      12135435435354435435342423948763867876
+    set big2       2746237174783836746262564892918327847
+    set wide1                             12345678912345
+    set wide2                             87321847232215
+    set small1                                     87345
+    set small2                                     16753
+
+    set res {}
+    foreach op {& | ^} {
+        lappend res [TestOp $op $big1   $big2]
+        lappend res [TestOp $op $big1   $wide2]
+        lappend res [TestOp $op $big1   $small2]
+        lappend res [TestOp $op $wide1  $big2]
+        lappend res [TestOp $op $wide1  $wide2]
+        lappend res [TestOp $op $wide1  $small2]
+        lappend res [TestOp $op $small1 $big2]
+        lappend res [TestOp $op $small1 $wide2]
+        lappend res [TestOp $op $small1 $small2]
+    }
+    set res
+} [list \
+           712439449294653815890598856501796 \
+           78521450111684 \
+           96 \
+           2371422390785 \
+           12275881497169 \
+           16721 \
+           33 \
+           87057 \
+           16689 \
+           14880960170688977527789098242825693927 \
+           12135435435354435435342432749160988407 \
+           12135435435354435435342423948763884533 \
+           2746237174783836746262574867174849407 \
+           87391644647391 \
+           12345678912377 \
+           2746237174783836746262564892918415159 \
+           87321847232503 \
+           87409 \
+           14880247731239682873973207643969192131 \
+           12135435435354435435342354227710876723 \
+           12135435435354435435342423948763884437 \
+           2746237174783836746262572495752458622 \
+           75115763150222 \
+           12345678895656 \
+           2746237174783836746262564892918415126 \
+           87321847145446 \
+           70720 \
+          ]
+test mathop-22.4 { unary ops, bad values } {
+    set res {}
+    set exp {}
+    foreach op {& | ^} {
+        lappend res [TestOp $op x 5]
+        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+        lappend res [TestOp $op 5 x]
+        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+    }
+    expr {$res eq $exp ? 0 : $res}
+} 0
+
+test mathop-23.1 { comparison ops, numerical } {
+    set res {}
+    set todo {5 {1 6} {1 2 2 3} {4 3 2 1} {5.0 5.0} {6 3 3 1} {5.0 5}}
+    lappend todo [list 2342476234762482734623842342 234827463876473 3434]
+    lappend todo [list 2653 453735910264536 453735910264537 2384762472634982746239847637]
+    lappend todo [list 2653 2384762472634982746239847637]
+    lappend todo [list 2653 -2384762472634982746239847637]
+    lappend todo [list 3789253678212653 -2384762472634982746239847637]
+    lappend todo [list 5.0 6 7.0 8 1e13 1945628567352654 1.1e20 \
+                          6734253647589123456784564378 2.3e50]
+    set a 7
+    lappend todo [list $a $a] ;# Same object
+    foreach vals $todo {
+        foreach op {< <= > >= == eq} {
+            lappend res [TestOp $op {*}$vals]
+        }
+    }
+    set res
+} [list 1 1 1 1 1 1 \
+        1 1 0 0 0 0 \
+        0 1 0 0 0 0 \
+        0 0 1 1 0 0 \
+        0 1 0 1 1 1 \
+        0 0 0 1 0 0 \
+        0 1 0 1 1 0 \
+        0 0 1 1 0 0 \
+        1 1 0 0 0 0 \
+        1 1 0 0 0 0 \
+        0 0 1 1 0 0 \
+        0 0 1 1 0 0 \
+        1 1 0 0 0 0 \
+        0 1 0 1 1 1 \
+       ]
+test mathop-23.2 { comparison ops, string } {
+    set res {}
+    set todo {a {a b} {5 b b c} {d c b a} {xy xy} {gy ef ef ab}}
+    set a x
+    lappend todo [list $a $a]
+    foreach vals $todo {
+        foreach op {< <= > >= == eq} {
+            lappend res [TestOp $op {*}$vals]
+        }
+    }
+    set res
+} [list 1 1 1 1 1 1 \
+        1 1 0 0 0 0 \
+        0 1 0 0 0 0 \
+        0 0 1 1 0 0 \
+        0 1 0 1 1 1 \
+        0 0 0 1 0 0 \
+        0 1 0 1 1 1 \
+       ]
+test mathop-23.3 { comparison ops, nonequal} {
+    set res {}
+    foreach vals {{a b} {17.0 0x11} {foo foo} {10 10}} {
+        foreach op {!= ne} {
+            lappend res [TestOp $op {*}$vals]
+        }
+    }
+    set res
+} [list 1 1  0 1  0 0  0 0 ]
+
+test mathop-24.1 { binary ops } {
+    set res {}
+    foreach vals {{3 5} {17 7} {199 5} {293234675763434238476239486 17} \
+                  {5 1} {0 7}} {
+        foreach op {% << >> in ni} {
+            lappend res [TestOp $op {*}$vals]
+        }
+    }
+    set res
+} [list 3 96 0 0 1  3 2176 0 0 1  4 6368 6 0 1 \
+        14 38434855421664852505557661908992 2237203031642412097749 0 1 \
+        0 10 2 0 1  0 0 0 0 1]
+test mathop-24.2 { binary ops, modulo } {
+    # Test different combinations to get all code paths
+    set res {}
+
+    set bigbig 14372423674564535234543545248972634923869
+    set big       12135435435354435435342423948763867876
+    set wide                              12345678912345
+    set negwide                          -12345678912345
+    set small                                          5
+    set neg                                           -5
+
+    lappend res [TestOp % $bigbig  $big]
+    lappend res [TestOp % $wide    $big]
+    lappend res [TestOp % $negwide $big]
+    lappend res [TestOp % $small   $big]
+    lappend res [TestOp % $neg     $big]
+    lappend res [TestOp % $small  $wide]
+    lappend res [TestOp % $neg    $wide]
+    lappend res [TestOp % $wide  $small]
+    set res
+} [list   4068119104883679098115293636215358685 \
+                                 12345678912345 \
+         12135435435354435435342411603084955531 \
+                                              5 \
+         12135435435354435435342423948763867871 \
+                                              5 \
+                                 12345678912340 \
+                                              0 \
+          ]
+test mathop-24.3 { binary ops, bad values } {
+    set res {}
+    set exp {}
+    foreach op {% << >>} {
+        lappend res [TestOp $op x 1]
+        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+        lappend res [TestOp $op 1 x]
+        lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+    }
+    foreach op {% << >>} {
+        lappend res [TestOp $op 5.0 1]
+        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
+        lappend res [TestOp $op 1 5.0]
+        lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
+    }
+    foreach op {in ni} {
+        lappend res [TestOp $op 5 "a b \{ c"]
+        lappend exp "unmatched open brace in list TCL VALUE LIST BRACE"
+    }
+    lappend res [TestOp % 5 0]
+    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
+    lappend res [TestOp % 9838923468297346238478737647637375 0]
+    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
+    lappend res [TestOp / 5 0]
+    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
+    lappend res [TestOp / 9838923468297346238478737647637375 0]
+    lappend exp "divide by zero ARITH DIVZERO {divide by zero}"
+    expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-24.4 { binary ops, negative shift } {
+    set res {}
+
+    set big      -12135435435354435435342423948763867876
+    set wide                             -12345678912345
+    set small                                         -1
+
+    lappend res [TestOp << 10 $big]
+    lappend res [TestOp << 10 $wide]
+    lappend res [TestOp << 10 $small]
+    lappend res [TestOp >> 10 $big]
+    lappend res [TestOp >> 10 $wide]
+    lappend res [TestOp >> 10 $small]
+
+    set exp [lrepeat 6 "negative shift argument NONE"]
+    expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-24.5 { binary ops, large shift } {
+    set res {}
+    set exp {}
+
+    set big      12135435435354435435342423948763867876
+    set wide                             12345678912345
+    set small                                         1
+
+    lappend res [TestOp << 1 2147483648]
+    lappend exp "integer value too large to represent NONE"
+    lappend res [TestOp << 1 4294967296]
+    lappend exp "integer value too large to represent NONE"
+    lappend res [TestOp << $small $wide]
+    lappend exp "integer value too large to represent NONE"
+    lappend res [TestOp << $small $big]
+    lappend exp "integer value too large to represent NONE"
+    lappend res [TestOp >> $big $wide]
+    lappend exp 0
+    lappend res [TestOp >> $big $big]
+    lappend exp 0
+    lappend res [TestOp >> $small 70]
+    lappend exp 0
+    lappend res [TestOp >> $wide 70]
+    lappend exp 0
+    lappend res [TestOp >> -$big $wide]
+    lappend exp -1
+    lappend res [TestOp >> -$wide $wide]
+    lappend exp -1
+    lappend res [TestOp >> -$small $wide]
+    lappend exp -1
+    lappend res [TestOp >> -$small 70]
+    lappend exp -1
+    lappend res [TestOp >> -$wide 70]
+    lappend exp -1
+
+    expr {$res eq $exp ? 0 : $res}
+} 0
+test mathop-24.6 { binary ops, shift } {
+    # Test different combinations to get all code paths
+    set res {}
+
+    set bigbig 14372423674564535234543545248972634923869
+    set big       12135435435354435435342423948763867876
+    set wide                              12345678912345
+    set negwide                          -12345678912345
+    set small                                          5
+    set neg                                           -5
+
+    lappend res [TestOp << $wide $small]
+    lappend res [TestOp >> $wide $small]
+    set res
+} [list   395061725195040 \
+             385802466010 \
+          ]
+test mathop-24.7 { binary ops, list search } {
+    set res {}
+
+    foreach op {in ni} {
+        lappend res [TestOp $op 5 {7 5 8}]
+        lappend res [TestOp $op hej {foo bar hej}]
+        lappend res [TestOp $op 5 {7 0x5 8}]
+    }
+    set res
+} [list 1 1 0  0 0 1]
+test mathop-24.8 { binary ops, too many } {
+    set exp {}
+    foreach op {<< >> % != ne in ni ~ !} {
+        set res [TestOp $op 7 8 9]
+        if {[string match "wrong # args: should be * TCL WRONGARGS" $res]} {
+            lappend exp 0
+        } else {
+            lappend exp $res
+        }
+    }
+    set exp
+} {0 0 0 0 0 0 0 0 0}
+
+test mathop-25.1  { exp operator } {TestOp **        } 1
+test mathop-25.2  { exp operator } {TestOp **   0    } 0
+test mathop-25.3  { exp operator } {TestOp **   0   5} 0
+test mathop-25.4  { exp operator } {TestOp ** 7.5    } 7.5
+test mathop-25.5  { exp operator } {TestOp **   1   5} 1
+test mathop-25.6  { exp operator } {TestOp **   5   1} 5
+test mathop-25.7  { exp operator } {TestOp ** 4 3 2 1} 262144
+test mathop-25.8  { exp operator } {TestOp ** 5.5   4} 915.0625
+test mathop-25.9  { exp operator } {TestOp **  16 3.5} 16384.0
+test mathop-25.10 { exp operator } {TestOp ** 3.5   0} 1.0
+test mathop-25.11 { exp operator } {TestOp ** 378   0} 1
+test mathop-25.12 { exp operator } {TestOp ** 7.8   1} 7.8
+test mathop-25.13 { exp operator } {TestOp ** 748   1} 748
+test mathop-25.14 { exp operator } {TestOp ** 1.6  -1} 0.625
+test mathop-25.15 { exp operator } {TestOp ** 683  -1} 0
+test mathop-25.16 { exp operator } {TestOp **   1  -1} 1
+test mathop-25.17 { exp operator } {TestOp **  -1  -1} -1
+test mathop-25.18 { exp operator } {TestOp **  -1  -2} 1
+test mathop-25.19 { exp operator } {TestOp **  -1   3} -1
+test mathop-25.20 { exp operator } {TestOp **  -1   4} 1
+test mathop-25.21 { exp operator } {TestOp **   2  63} 9223372036854775808
+test mathop-25.22 { exp operator } {TestOp ** 83756485763458746358734658473567847567473 2} 7015148907444467657897585474493757781161998914521537835809623408157343003287605729
+test mathop-25.23 { exp operator errors } {
+    set res {}
+    set exp {}
+
+    set huge     [string repeat 145782 1000]
+    set big      12135435435354435435342423948763867876
+    set wide                             12345678912345
+    set small                                         2
+
+    lappend res [TestOp ** 0 -5]
+    lappend exp "exponentiation of zero by negative power ARITH DOMAIN {exponentiation of zero by negative power}"
+    lappend res [TestOp ** 0.0 -5.0]
+    lappend exp "exponentiation of zero by negative power ARITH DOMAIN {exponentiation of zero by negative power}"
+    lappend res [TestOp ** $small $wide]
+    lappend exp "exponent too large NONE"
+    lappend res [TestOp ** 2 $big]
+    lappend exp "exponent too large NONE"
+    lappend res [TestOp ** $huge 2.1]
+    lappend exp "Inf"
+    lappend res [TestOp ** 2 foo]
+    lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
+    lappend res [TestOp ** foo 2]
+    lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
+
+    expr {$res eq $exp ? 0 : $res}
+} 0
+
+test mathop-26.1 { misc ops, size combinations } {
+    set big1      12135435435354435435342423948763867876
+    set big2       2746237174783836746262564892918327847
+    set wide1                             87321847232215
+    set wide2                             12345678912345
+    set small1                                     87345
+    set small2                                     16753
+
+    set res {}
+    foreach op {+ * - /} {
+        lappend res [TestOp $op $big1   $big2]
+        lappend res [TestOp $op $big1   $wide2]
+        lappend res [TestOp $op $big1   $small2]
+        lappend res [TestOp $op $wide1  $big2]
+        lappend res [TestOp $op $wide1  $wide2]
+        lappend res [TestOp $op $wide1  $small2]
+        lappend res [TestOp $op $small1 $big2]
+        lappend res [TestOp $op $small1 $wide2]
+        lappend res [TestOp $op $small1 $small2]
+    }
+    set res
+} [list \
+           14881672610138272181604988841682195723 \
+           12135435435354435435342436294442780221 \
+           12135435435354435435342423948763884629 \
+           2746237174783836746262652214765560062 \
+           99667526144560 \
+           87321847248968 \
+           2746237174783836746262564892918415192 \
+           12345678999690 \
+           104098 \
+           33326783924759424684447891401270222910405366244661685890993770489959542972 \
+           149820189346379518024969783068410988366610965329220 \
+           203304949848492856848291628413641078526628 \
+           239806503039903915972546163440347114360602909991105 \
+           1078047487961768329845194175 \
+           1462902906681297895 \
+           239870086031494220602303730571951345796215 \
+           1078333324598774025 \
+           1463290785 \
+           9389198260570598689079859055845540029 \
+           12135435435354435435342411603084955531 \
+           12135435435354435435342423948763851123 \
+           -2746237174783836746262477571071095632 \
+           74976168319870 \
+           87321847215462 \
+           -2746237174783836746262564892918240502 \
+           -12345678825000 \
+           70592 \
+           4 \
+           982970278225822587257201 \
+           724373869477373332259441529801460 \
+           0 \
+           7 \
+           5212311062 \
+           0 \
+           0 \
+           5 \
+          ]
+test mathop-26.2 { misc ops, corner cases } {
+    set res {}
+    lappend res [TestOp - 0 -2147483648]                  ;# -2**31
+    lappend res [TestOp - 0 -9223372036854775808]         ;# -2**63
+    lappend res [TestOp / -9223372036854775808 -1]
+    lappend res [TestOp * 2147483648 2]
+    lappend res [TestOp * 9223372036854775808 2]
+    set res
+} [list 2147483648 9223372036854775808 9223372036854775808 4294967296 18446744073709551616]
+
+if 0 {
+    # Compare ops to expr bytecodes
+    namespace import ::tcl::mathop::*
+    proc _X {a b c} {
+        set x [+ $a [- $b $c]]
+        set y [expr {$a + ($b - $c)}]
+        set z [< $a $b $c]
+    }
+    set ::tcl_traceCompile 2
+    _X 3 4 5
+    set ::tcl_traceCompile 0
+}
+
+# cleanup
+namespace delete ::testmathop
+namespace delete ::testmathop2
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/misc.test b/tests/misc.test
index c82944b..d4ece74 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -11,14 +11,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: misc.test,v 1.10 2004/09/22 22:23:40 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testhashsystemhash [llength [info commands testhashsystemhash]]
 
 test misc-1.1 {error in variable ref. in command in array reference} {
@@ -53,17 +54,12 @@ test misc-1.2 {error in variable ref. in command in array reference} {
 	# this is a bogus comment
     "
     set msg {}
-    join [list [catch tstProc msg] $msg $errorInfo] \n
+    join [list [catch tstProc msg] $msg $::errorInfo] \n
 } [subst -novariables -nocommands {1
 missing close-brace for variable name
 missing close-brace for variable name
     while executing
-"set tst $a([winfo name $\{zz)
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a bogus comment
-	# this is a ..."
+"set tst $a([winfo name $\{"
     (procedure "tstProc" line 4)
     invoked from within
 "tstProc"}]
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 06fccf6..050b592 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -11,16 +11,14 @@
 #
 # Note that after running these tests, entries will be left behind in the
 # message catalogs for locales foo, foo_BAR, and foo_BAR_baz.
-#
-# RCS: @(#) $Id: msgcat.test,v 1.18 2005/05/10 18:35:22 kennykb Exp $
 
-package require Tcl 8.2
+package require Tcl 8.5
 if {[catch {package require tcltest 2}]} {
     puts stderr "Skipping tests in [info script].  tcltest 2 required."
     return
 }
-if {[catch {package require msgcat 1.4.1}]} {
-    puts stderr "Skipping tests in [info script].  No msgcat 1.4.1 found to test."
+if {[catch {package require msgcat 1.5}]} {
+    puts stderr "Skipping tests in [info script].  No msgcat 1.5 found to test."
     return
 }
 
@@ -54,15 +52,27 @@ namespace eval ::msgcat::test {
     foreach setVars [PowerSet $envVars] { 
 	set result [string tolower [lindex $setVars 0]]
 	if {[string length $result] == 0} {
-	    set result c
+	    if {[info exists ::tcl::mac::locale]} {
+		set result [string tolower \
+			[msgcat::ConvertLocale $::tcl::mac::locale]]
+	    } else {
+		if {([info sharedlibextension] eq ".dll")
+			&& ![catch {package require registry}]} {
+		    # Windows and Cygwin have other ways to determine the
+		    # locale when the environment variables are missing
+		    # and the registry package is present
+		    continue
+		}
+		set result c
+	    }
 	}
-	test msgcat-0.$count {
-	    locale initialization from environment variables
-	} -setup {
+	test msgcat-0.$count [list \
+	    locale initialization from environment variables $setVars \
+	] -setup {
 	    variable var
 	    foreach var $envVars {
 		catch {variable $var $::env($var)}
-		catch {unset ::env($var)}
+		unset -nocomplain ::env($var)
 	    }
 	    foreach var $setVars {
 		set ::env($var) $var
@@ -74,13 +84,13 @@ namespace eval ::msgcat::test {
 	} -cleanup {
 	    interp delete [namespace current]::i
 	    foreach var $envVars {
-		catch {unset ::env($var)}
+		unset -nocomplain ::env($var)
 		catch {set ::env($var) [set [namespace current]::$var]}
 	    }
 	} -body {i eval msgcat::mclocale} -result $result
 	incr count
     }
-    catch {unset result}
+    unset -nocomplain result
     
     # Could add tests of initialization from Windows registry here.
     # Use a fake registry package.
@@ -314,7 +324,7 @@ namespace eval ::msgcat::test {
 	    incr count
 	}
     }
-    catch {unset result}
+    unset -nocomplain result
 
     # Tests msgcat-4.*: [mcunknown]
 
@@ -608,6 +618,45 @@ namespace eval ::msgcat::test {
 	mc "this is a %s" "good test"
     } -result "this is a good test"
 
+    # Tests msgcat-8.*: [mcflset]
+
+    set msgdir1 [makeDirectory msgdir1]
+    makeFile {::msgcat::mcflset k1 v1} l1.msg $msgdir1
+
+	test msgcat-8.1 {mcflset} -setup {
+	    variable locale [mclocale]
+	    mclocale l1
+	    mcload $msgdir1
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    mc k1
+	} -result v1
+
+    removeFile l1.msg $msgdir1
+    removeDirectory msgdir1
+
+    set msgdir2 [makeDirectory msgdir2]
+    set msgdir3 [makeDirectory msgdir3]
+    makeFile "::msgcat::mcflset k2 v2 ; ::msgcat::mcload [list $msgdir3]"\
+	    l2.msg $msgdir2
+    makeFile {::msgcat::mcflset k3 v3} l2.msg $msgdir3
+
+	# chained mcload
+	test msgcat-8.2 {mcflset} -setup {
+	    variable locale [mclocale]
+	    mclocale l2
+	    mcload $msgdir2
+	} -cleanup {
+	    mclocale $locale
+	} -body {
+	    return [mc k2][mc k3]
+	} -result v2v3
+
+    removeFile l2.msg $msgdir2
+    removeDirectory msgdir2
+    removeDirectory msgdir3
+
     cleanupTests
 }
 namespace delete ::msgcat::test
diff --git a/tests/namespace-old.test b/tests/namespace-old.test
index 0fadd1f..1d8ba31 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -13,52 +13,42 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: namespace-old.test,v 1.9 2004/08/27 14:39:14 dkf Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.2
     namespace import -force ::tcltest::*
 }
 
 # Clear out any namespaces called test_ns_*
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
-
+catch {namespace delete {*}[namespace children :: test_ns_*]}
+
 test namespace-old-1.1 {usage for "namespace" command} {
     list [catch {namespace} msg] $msg
 } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
-
 test namespace-old-1.2 {global namespace's name is "::" or {}} {
     list [namespace current] [namespace eval {} {namespace current}]
 } {:: ::}
-
 test namespace-old-1.3 {usage for "namespace eval"} {
     list [catch {namespace eval} msg] $msg
 } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
-
 test namespace-old-1.4 {create new namespaces} {
     list [lsort [namespace children :: test_ns_simple*]] \
 	 [namespace eval test_ns_simple {}] \
 	 [namespace eval test_ns_simple2 {}] \
          [lsort [namespace children :: test_ns_simple*]]
 } {{} {} {} {::test_ns_simple ::test_ns_simple2}}
-
 test namespace-old-1.5 {access a new namespace} {
     namespace eval test_ns_simple { namespace current }
 } {::test_ns_simple}
-
 test namespace-old-1.6 {usage for "namespace eval"} {
     list [catch {namespace eval} msg] $msg
 } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
-
 test namespace-old-1.7 {usage for "namespace eval"} {
     list [catch {namespace eval test_ns_xyzzy} msg] $msg
 } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
-
 test namespace-old-1.8 {command "namespace eval" concatenates args} {
     namespace eval test_ns_simple namespace current
 } {::test_ns_simple}
-
 test namespace-old-1.9 {add elements to a namespace} {
     namespace eval test_ns_simple {
         variable test_ns_x 0
@@ -67,19 +57,15 @@ test namespace-old-1.9 {add elements to a namespace} {
         }
     }
 } {}
-
 test namespace-old-1.10 {commands in a namespace} {
     namespace eval test_ns_simple { info commands [namespace current]::*}
 } {::test_ns_simple::test}
-
 test namespace-old-1.11 {variables in a namespace} {
     namespace eval test_ns_simple { info vars [namespace current]::* }
 } {::test_ns_simple::test_ns_x}
-
 test namespace-old-1.12 {global vars are separate from locals vars} {
     list [test_ns_simple::test 123] [set test_ns_simple::test_ns_x]
 } {{test: 123} 0}
-
 test namespace-old-1.13 {add to an existing namespace} {
     namespace eval test_ns_simple {
         variable test_ns_y 123
@@ -88,18 +74,15 @@ test namespace-old-1.13 {add to an existing namespace} {
         }
     }
 } ""
-
 test namespace-old-1.14 {commands in a namespace} {
     lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
 } {::test_ns_simple::_backdoor ::test_ns_simple::test}
-
 test namespace-old-1.15 {variables in a namespace} {
     lsort [namespace eval test_ns_simple {info vars [namespace current]::*}]
 } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
 test namespace-old-1.16 {variables in a namespace} {
     lsort [info vars test_ns_simple::*]
 } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
-
 test namespace-old-1.17 {commands in a namespace are hidden} {
     list [catch "_backdoor {return yes!}" msg] $msg
 } {1 {invalid command name "_backdoor"}}
@@ -109,7 +92,6 @@ test namespace-old-1.18 {using namespace qualifiers} {
 test namespace-old-1.19 {using absolute namespace qualifiers} {
     list [catch "::test_ns_simple::_backdoor {return yes!}" msg] $msg
 } {0 yes!}
-
 test namespace-old-1.20 {variables in a namespace are hidden} {
     list [catch "set test_ns_x" msg] $msg [catch "set test_ns_y" msg] $msg
 } {1 {can't read "test_ns_x": no such variable} 1 {can't read "test_ns_y": no such variable}}
@@ -128,25 +110,21 @@ test namespace-old-1.23 {variables can be accessed within a namespace} {
         return "$test_ns_x $test_ns_y"
     }
 } {0 123}
-
 test namespace-old-1.24 {setting global variables} {
     test_ns_simple::_backdoor {variable test_ns_x;  set test_ns_x "new val"}
     namespace eval test_ns_simple {set test_ns_x}
 } {new val}
-
 test namespace-old-1.25 {qualified variables don't need a global declaration} {
     namespace eval test_ns_another { variable test_ns_x 456 }
     set cmd {set ::test_ns_another::test_ns_x}
     list [catch {test_ns_simple::_backdoor "$cmd some-value"} msg] $msg \
          [eval $cmd]
 } {0 some-value some-value}
-
 test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
     namespace eval test_ns_simple { set test_ns_x 12; set test_ns_y 34 }
     set cmd {list $::test_ns_simple::test_ns_x $::test_ns_simple::test_ns_y}
     list [test_ns_simple::_backdoor $cmd] [eval $cmd]
 } {{12 34} {12 34}}
-
 test namespace-old-1.27 {can create commands with null names} {
     proc test_ns_simple:: {args} {return $args}
 } {}
@@ -157,35 +135,27 @@ test namespace-old-1.27 {can create commands with null names} {
 test namespace-old-2.1 {querying:  info commands} {
     lsort [test_ns_simple::_backdoor {info commands [namespace current]::*}]
 } {::test_ns_simple:: ::test_ns_simple::_backdoor ::test_ns_simple::test}
-
 test namespace-old-2.2 {querying:  info procs} {
     lsort [test_ns_simple::_backdoor {info procs}]
 } {{} _backdoor test}
-
 test namespace-old-2.3 {querying:  info vars} {
     lsort [info vars test_ns_simple::*]
 } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
-
 test namespace-old-2.4 {querying:  info vars} {
     lsort [test_ns_simple::_backdoor {info vars [namespace current]::*}]
 } {::test_ns_simple::test_ns_x ::test_ns_simple::test_ns_y}
-
 test namespace-old-2.5 {querying:  info locals} {
     lsort [test_ns_simple::_backdoor {info locals}]
 } {cmd}
-
 test namespace-old-2.6 {querying:  info exists} {
     test_ns_simple::_backdoor {info exists test_ns_x}
 } {0}
-
 test namespace-old-2.7 {querying:  info exists} {
     test_ns_simple::_backdoor {info exists cmd}
 } {1}
-
 test namespace-old-2.8 {querying:  info args} {
     info args test_ns_simple::_backdoor
 } {cmd}
-
 test namespace-old-2.9 {querying:  info body} {
     string trim [info body test_ns_simple::test]
 } {return "test: $test_ns_x"}
@@ -196,7 +166,6 @@ test namespace-old-2.9 {querying:  info body} {
 test namespace-old-3.1 {usage for "namespace qualifiers"} {
     list [catch "namespace qualifiers" msg] $msg
 } {1 {wrong # args: should be "namespace qualifiers string"}}
-
 test namespace-old-3.2 {querying:  namespace qualifiers} {
     list [namespace qualifiers ""] \
          [namespace qualifiers ::] \
@@ -205,11 +174,9 @@ test namespace-old-3.2 {querying:  namespace qualifiers} {
          [namespace qualifiers foo::x] \
          [namespace qualifiers ::foo::bar::xyz]
 } {{} {} {} {} foo ::foo::bar}
-
 test namespace-old-3.3 {usage for "namespace tail"} {
     list [catch "namespace tail" msg] $msg
 } {1 {wrong # args: should be "namespace tail string"}}
-
 test namespace-old-3.4 {querying:  namespace tail} {
     list [namespace tail ""] \
          [namespace tail ::] \
@@ -236,23 +203,20 @@ test namespace-old-4.1 {define test namespaces} {
         lsort [namespace children]
     }
 } {::test_ns_delete::another ::test_ns_delete::ns1 ::test_ns_delete::ns2}
-
 test namespace-old-4.2 {it's okay to invoke "namespace delete" with no args} {
     list [catch {namespace delete} msg] $msg
 } {0 {}}
-
 test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
     set cmd {
         namespace eval test_ns_delete {namespace delete ns*}
     }
     list [catch $cmd msg] $msg
 } {1 {unknown namespace "ns*" in namespace delete command}}
-
 test namespace-old-4.4 {command "namespace delete" handles multiple args} {
     set cmd {
         namespace eval test_ns_delete {
             namespace delete \
-                {expand}[namespace children [namespace current] ns?]
+                {*}[namespace children [namespace current] ns?]
         }
     }
     list [catch $cmd msg] $msg [namespace children test_ns_delete]
@@ -264,125 +228,99 @@ test namespace-old-4.4 {command "namespace delete" handles multiple args} {
 test namespace-old-5.1 {define nested namespaces} {
     set test_ns_var_global "var in ::"
     proc test_ns_cmd_global {} {return "cmd in ::"}
-
     namespace eval test_ns_hier1 {
         set test_ns_var_hier1 "particular to hier1"
         proc test_ns_cmd_hier1 {} {return "particular to hier1"}
-
         set test_ns_level 1
         proc test_ns_show {} {return "[namespace current]: 1"}
-
         namespace eval test_ns_hier2 {
             set test_ns_var_hier2 "particular to hier2"
             proc test_ns_cmd_hier2 {} {return "particular to hier2"}
-
             set test_ns_level 2
             proc test_ns_show {} {return "[namespace current]: 2"}
-
             namespace eval test_ns_hier3a {}
             namespace eval test_ns_hier3b {}
         }
-
         namespace eval test_ns_hier2a {}
         namespace eval test_ns_hier2b {}
     }
 } {}
-
 test namespace-old-5.2 {namespaces can be nested} {
     list [namespace eval test_ns_hier1 {namespace current}] \
          [namespace eval test_ns_hier1 {
               namespace eval test_ns_hier2 {namespace current}
           }]
 } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
-
 test namespace-old-5.3 {namespace qualifiers work in namespace command} {
     list [namespace eval ::test_ns_hier1 {namespace current}] \
          [namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
          [namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
 } {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
-
 test namespace-old-5.4 {nested namespaces can access global namespace} {
     list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
          [namespace eval test_ns_hier1 {test_ns_cmd_global}] \
          [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
          [namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
 } {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
-
 test namespace-old-5.5 {variables in different namespaces don't conflict} {
     list [set test_ns_hier1::test_ns_level] \
          [set test_ns_hier1::test_ns_hier2::test_ns_level]
 } {1 2}
-
 test namespace-old-5.6 {commands in different namespaces don't conflict} {
     list [test_ns_hier1::test_ns_show] \
          [test_ns_hier1::test_ns_hier2::test_ns_show]
 } {{::test_ns_hier1: 1} {::test_ns_hier1::test_ns_hier2: 2}}
-
 test namespace-old-5.7 {nested namespaces don't see variables in parent} {
     set cmd {
         namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_hier1}
     }
     list [catch $cmd msg] $msg
 } {1 {can't read "test_ns_var_hier1": no such variable}}
-
 test namespace-old-5.8 {nested namespaces don't see commands in parent} {
     set cmd {
         namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_hier1}
     }
     list [catch $cmd msg] $msg
 } {1 {invalid command name "test_ns_cmd_hier1"}}
-
 test namespace-old-5.9 {usage for "namespace children"} {
     list [catch {namespace children test_ns_hier1 y z} msg] $msg
 } {1 {wrong # args: should be "namespace children ?name? ?pattern?"}}
-
-test namespace-old-5.10 {command "namespace children" must get valid namespace} {
-    list [catch {namespace children xyzzy} msg] $msg
-} {1 {unknown namespace "xyzzy" in namespace children command}}
-
+test namespace-old-5.10 {command "namespace children" must get valid namespace} -body {
+    namespace children xyzzy
+} -returnCodes error -result {namespace "xyzzy" not found in "::"}
 test namespace-old-5.11 {querying namespace children} {
     lsort [namespace children :: test_ns_hier*]
 } {::test_ns_hier1}
-
 test namespace-old-5.12 {querying namespace children} {
     lsort [namespace children test_ns_hier1]
 } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
-
 test namespace-old-5.13 {querying namespace children} {
     lsort [namespace eval test_ns_hier1 {namespace children}]
 } {::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2a ::test_ns_hier1::test_ns_hier2b}
-
 test namespace-old-5.14 {querying namespace children} {
     lsort [namespace children test_ns_hier1::test_ns_hier2]
 } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
-
 test namespace-old-5.15 {querying namespace children} {
     lsort [namespace eval test_ns_hier1::test_ns_hier2 {namespace children}]
 } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
-
 test namespace-old-5.16 {querying namespace children with patterns} {
     lsort [namespace children test_ns_hier1::test_ns_hier2 test_ns_*]
 } {::test_ns_hier1::test_ns_hier2::test_ns_hier3a ::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
-
 test namespace-old-5.17 {querying namespace children with patterns} {
     lsort [namespace children test_ns_hier1::test_ns_hier2 *b]
 } {::test_ns_hier1::test_ns_hier2::test_ns_hier3b}
-
 test namespace-old-5.18 {usage for "namespace parent"} {
     list [catch {namespace parent x y} msg] $msg
 } {1 {wrong # args: should be "namespace parent ?name?"}}
-
-test namespace-old-5.19 {command "namespace parent" must get valid namespace} {
-    list [catch {namespace parent xyzzy} msg] $msg
-} {1 {unknown namespace "xyzzy" in namespace parent command}}
-
+test namespace-old-5.19 {command "namespace parent" must get valid namespace} -body {
+    namespace parent xyzzy
+} -returnCodes error -result {namespace "xyzzy" not found in "::"}
 test namespace-old-5.20 {querying namespace parent} {
     list [namespace eval :: {namespace parent}] \
         [namespace eval test_ns_hier1 {namespace parent}] \
         [namespace eval test_ns_hier1::test_ns_hier2 {namespace parent}] \
         [namespace eval test_ns_hier1::test_ns_hier2::test_ns_hier3a {namespace parent}] \
 } {{} :: ::test_ns_hier1 ::test_ns_hier1::test_ns_hier2}
-
 test namespace-old-5.21 {querying namespace parent for explicit namespace} {
     list [namespace parent ::] \
          [namespace parent test_ns_hier1] \
@@ -406,25 +344,21 @@ test namespace-old-6.1 {relative ns names only looked up in current ns} {
     list [namespace eval test_ns_cache1 $trigger] \
          [namespace eval test_ns_cache1 $trigger2]
 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
-
 test namespace-old-6.2 {relative ns names only looked up in current ns} {
     namespace eval test_ns_cache1::test_ns_cache2 {}
     list [namespace eval test_ns_cache1 $trigger] \
          [namespace eval test_ns_cache1 $trigger2]
 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
-
 test namespace-old-6.3 {relative ns names only looked up in current ns} {
     namespace eval test_ns_cache1::test_ns_cache2::test_ns_cache3 {}
     list [namespace eval test_ns_cache1 $trigger] \
          [namespace eval test_ns_cache1 $trigger2]
 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
-
 test namespace-old-6.4 {relative ns names only looked up in current ns} {
     namespace delete test_ns_cache1::test_ns_cache2
     list [namespace eval test_ns_cache1 $trigger] \
          [namespace eval test_ns_cache1 $trigger2]
 } {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
-
 test namespace-old-6.5 {define test commands} {
     proc test_ns_cache_cmd {} {
         return "global version"
@@ -436,35 +370,30 @@ test namespace-old-6.5 {define test commands} {
     }
     test_ns_cache1::trigger
 } {global version}
-
 test namespace-old-6.6 {one-level check for command shadowing} {
     proc test_ns_cache1::test_ns_cache_cmd {} {
         return "cache1 version"
     }
     test_ns_cache1::trigger
 } {cache1 version}
-
 test namespace-old-6.7 {renaming commands changes command epoch} {
     namespace eval test_ns_cache1 {
         rename test_ns_cache_cmd test_ns_new
     }
     test_ns_cache1::trigger
 } {global version}
-
 test namespace-old-6.8 {renaming back handles shadowing} {
     namespace eval test_ns_cache1 {
         rename test_ns_new test_ns_cache_cmd
     }
     test_ns_cache1::trigger
 } {cache1 version}
-
 test namespace-old-6.9 {deleting commands changes command epoch} {
     namespace eval test_ns_cache1 {
         rename test_ns_cache_cmd ""
     }
     test_ns_cache1::trigger
 } {global version}
-
 test namespace-old-6.10 {define test namespaces} {
     namespace eval test_ns_cache2 {
         proc test_ns_cache_cmd {} {
@@ -483,34 +412,29 @@ test namespace-old-6.10 {define test namespaces} {
     }
     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
 } {{global cache2 version} {global version}}
-
 test namespace-old-6.11 {commands affect all parent namespaces} {
     proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
         return "cache2 version"
     }
     list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
 } {{cache2 version} {cache2 version}}
-
 test namespace-old-6.12 {define test variables} {
     variable test_ns_cache_var "global version"
     set trigger {set test_ns_cache_var}
     namespace eval test_ns_cache1 $trigger
 } {global version}
-
 test namespace-old-6.13 {one-level check for variable shadowing} {
     namespace eval test_ns_cache1 {
         variable test_ns_cache_var "cache1 version"
     }
     namespace eval test_ns_cache1 $trigger
 } {cache1 version}
-
 test namespace-old-6.14 {deleting variables changes variable epoch} {
     namespace eval test_ns_cache1 {
         unset test_ns_cache_var
     }
     namespace eval test_ns_cache1 $trigger
 } {global version}
-
 test namespace-old-6.15 {define test namespaces} {
     namespace eval test_ns_cache2 {
         variable test_ns_cache_var "global cache2 version"
@@ -519,13 +443,11 @@ test namespace-old-6.15 {define test namespaces} {
     list [namespace eval test_ns_cache1 $trigger2] \
          [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
 } {{global cache2 version} {global version}}
-
 test namespace-old-6.16 {public variables affect all parent namespaces} {
     variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
     list [namespace eval test_ns_cache1 $trigger2] \
          [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
 } {{cache2 version} {cache2 version}}
-
 test namespace-old-6.17 {usage for "namespace which"} {
     list [catch "namespace which -baz x" msg] $msg
 } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
@@ -533,7 +455,6 @@ test namespace-old-6.18 {usage for "namespace which"} {
     # Presume no imported command called -command ;^)
     namespace which -command
 } {}
-
 test namespace-old-6.19 {querying:  namespace which -command} {
     proc test_ns_cache1::test_ns_cache_cmd {} {
         return "cache1 version"
@@ -543,17 +464,14 @@ test namespace-old-6.19 {querying:  namespace which -command} {
          [namespace eval :: {namespace which -command test_ns_cache_cmd}] \
          [namespace eval test_ns_cache1 {namespace which -command test_ns_cache_cmd}]
 } {::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd ::test_ns_cache_cmd ::test_ns_cache1::test_ns_cache_cmd}
-
 test namespace-old-6.20 {command "namespace which" may not find commands} {
     namespace eval test_ns_cache1 {namespace which -command xyzzy}
 } {}
-
 test namespace-old-6.21 {querying:  namespace which -variable} {
     namespace eval test_ns_cache1::test_ns_cache2 {
         namespace which -variable test_ns_cache_var
     }
 } {::test_ns_cache1::test_ns_cache2::test_ns_cache_var}
-
 test namespace-old-6.22 {command "namespace which" may not find variables} {
     namespace eval test_ns_cache1 {namespace which -variable xyzzy}
 } {}
@@ -565,7 +483,6 @@ test namespace-old-7.1 {define test namespace} {
     namespace eval test_ns_uplevel {
         variable x 0
         variable y 1
-
         proc show_vars {num} {
             return [uplevel $num {info vars}]
         }
@@ -577,8 +494,8 @@ test namespace-old-7.1 {define test namespace} {
     }
 } {}
 test namespace-old-7.2 {uplevel can access namespace call frame} {
-    list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] x]>=0}] \
-         [expr {[lsearch -exact [test_ns_uplevel::test_uplevel 1] y]>=0}]
+    list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \
+         [expr {"y" in [test_ns_uplevel::test_uplevel 1]}]
 } {1 1}
 test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
     lsort [test_ns_uplevel::test_uplevel 2]
@@ -586,10 +503,9 @@ test namespace-old-7.3 {uplevel can go beyond namespace call frame} {
 test namespace-old-7.4 {uplevel can go up to global context} {
     expr {[test_ns_uplevel::test_uplevel 3] == [info globals]}
 } {1}
-
 test namespace-old-7.5 {absolute call frame references work too} {
-    list [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] x]>=0}] \
-         [expr {[lsearch -exact [test_ns_uplevel::test_uplevel #2] y]>=0}]
+    list [expr {"x" in [test_ns_uplevel::test_uplevel #2]}] \
+         [expr {"y" in [test_ns_uplevel::test_uplevel #2]}]
 } {1 1}
 test namespace-old-7.6 {absolute call frame references work too} {
     lsort [test_ns_uplevel::test_uplevel #1]
@@ -597,11 +513,9 @@ test namespace-old-7.6 {absolute call frame references work too} {
 test namespace-old-7.7 {absolute call frame references work too} {
     expr {[test_ns_uplevel::test_uplevel #0] == [info globals]}
 } {1}
-
 test namespace-old-7.8 {namespaces are included in the call stack} {
     namespace eval test_ns_upvar {
         variable scope "test_ns_upvar"
-
         proc show_val {var num} {
             upvar $num $var x
             return $x
@@ -633,7 +547,6 @@ test namespace-old-8.1 {traces work across namespace boundaries} {
         namespace eval foo {
             variable x ""
         }
-
         variable status ""
         proc monitor {name1 name2 op} {
             variable status
@@ -644,7 +557,6 @@ test namespace-old-8.1 {traces work across namespace boundaries} {
     set test_ns_trace::foo::x "yes!"
     set test_ns_trace::foo::x
     unset test_ns_trace::foo::x
-
     namespace eval test_ns_trace { set status }
 } {{w: test_ns_trace::foo::x} {r: test_ns_trace::foo::x} {u: test_ns_trace::foo::x}}
 
@@ -657,7 +569,6 @@ test namespace-old-9.1 {empty "namespace export" list} {
 test namespace-old-9.2 {usage for "namespace export" command} {
     list [catch "namespace export test_ns_trace::zzz" msg] $msg
 } {1 {invalid export pattern "test_ns_trace::zzz": pattern can't specify a namespace}}
-
 test namespace-old-9.3 {define test namespaces for import} {
     namespace eval test_ns_export {
         namespace export cmd1 cmd2 cmd3
@@ -670,7 +581,6 @@ test namespace-old-9.3 {define test namespaces for import} {
     }
     lsort [info commands test_ns_export::*]
 } {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
-
 test namespace-old-9.4 {check export status} {
     set x ""
     namespace eval test_ns_import {
@@ -682,19 +592,20 @@ test namespace-old-9.4 {check export status} {
     }
     set x
 } {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
-
 test namespace-old-9.5 {empty import list in "namespace import" command} {
-    namespace import
-} {}
-
-test namespace-old-9.6 {empty import list for "namespace import" command} {
-    namespace import
-} {}
-
+    namespace eval test_ns_import_empty {
+	namespace import ::test_ns_export::*
+	try {
+	    lsort [namespace import]
+	} finally {
+	    namespace delete [namespace current]
+	}
+    }
+} {cmd1 cmd2 cmd3}
+# there is no namespace-old-9.6
 test namespace-old-9.7 {empty forget list for "namespace forget" command} {
     namespace forget
 } {}
-
 catch {rename cmd1 {}}
 catch {rename cmd2 {}}
 catch {rename ncmd {}}
@@ -704,11 +615,9 @@ test namespace-old-9.8 {only exported commands are imported} {
     namespace import test_ns_import::cmd*
     set x [lsort [info commands cmd*]]
 } {cmd1 cmd2}
-
 test namespace-old-9.9 {imported commands work just the same as original} {
     list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
 } {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
-
 test namespace-old-9.10 {commands can be imported from many namespaces} {
     namespace eval test_ns_import2 {
         namespace export ncmd ncmd1 ncmd2
@@ -720,27 +629,22 @@ test namespace-old-9.10 {commands can be imported from many namespaces} {
     namespace import test_ns_import2::*
     lsort [concat [info commands cmd*] [info commands ncmd*]]
 } {cmd1 cmd2 ncmd ncmd1 ncmd2}
-
 test namespace-old-9.11 {imported commands can be removed by deleting them} {
     rename cmd1 ""
     lsort [concat [info commands cmd*] [info commands ncmd*]]
 } {cmd2 ncmd ncmd1 ncmd2}
-
 test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
     list [catch {namespace forget xyzzy::*} msg] $msg
 } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
-
 test namespace-old-9.13 {command "namespace forget" ignores patterns that don't match} {
     list [catch {namespace forget test_ns_import::xy*zzy} msg] $msg \
          [lsort [info commands cmd?]]
 } {0 {} cmd2}
-
 test namespace-old-9.14 {imported commands can be removed} {
     namespace forget test_ns_import::cmd?
     list [lsort [info commands cmd?]] \
          [catch {cmd1 another test} msg] $msg
 } {{} 1 {invalid command name "cmd1"}}
-
 test namespace-old-9.15 {existing commands can't be overwritten} {
     proc cmd1 {x y} {
         return [expr $x+$y]
@@ -748,13 +652,11 @@ test namespace-old-9.15 {existing commands can't be overwritten} {
     list [catch {namespace import test_ns_import::cmd?} msg] $msg \
          [cmd1 3 5]
 } {1 {can't import command "cmd1": already exists} 8}
-
 test namespace-old-9.16 {use "-force" option to override existing commands} {
     list [cmd1 3 5] \
          [namespace import -force test_ns_import::cmd?] \
          [cmd1 3 5]
 } {8 {} {cmd1: 3 5}}
-
 test namespace-old-9.17 {commands can be imported into many namespaces} {
     namespace eval test_ns_import_use {
         namespace import ::test_ns_import::* ::test_ns_import2::ncmd?
@@ -762,13 +664,11 @@ test namespace-old-9.17 {commands can be imported into many namespaces} {
                       [info commands ::test_ns_import_use::ncmd*]]
     }
 } {::test_ns_import_use::cmd1 ::test_ns_import_use::cmd2 ::test_ns_import_use::ncmd1 ::test_ns_import_use::ncmd2}
-
 test namespace-old-9.18 {when command is deleted, imported commands go away} {
     namespace eval test_ns_import { rename cmd1 "" }
     list [info commands cmd1] \
          [namespace eval test_ns_import_use {info commands cmd1}]
 } {{} {}}
-
 test namespace-old-9.19 {when namesp is deleted, all imported commands go away} {
     namespace delete test_ns_import test_ns_import2
     list [info commands cmd*] \
@@ -792,43 +692,36 @@ test namespace-old-10.1 {define namespace for scope test} {
         list [set x] [show test]
     }
 } {x-value {show: test}}
-
 test namespace-old-10.2 {command "namespace code" requires one argument} {
     list [catch {namespace code} msg] $msg
 } {1 {wrong # args: should be "namespace code arg"}}
-
 test namespace-old-10.3 {command "namespace code" requires one argument} {
     list [catch {namespace code first "second arg" third} msg] $msg
 } {1 {wrong # args: should be "namespace code arg"}}
-
 test namespace-old-10.4 {command "namespace code" gets current namesp context} {
     namespace eval test_ns_inscope {
         namespace code {"1 2 3" "4 5" 6}
     }
 } {::namespace inscope ::test_ns_inscope {"1 2 3" "4 5" 6}}
-
 test namespace-old-10.5 {with one arg, first "scope" sticks} {
     set sval [namespace eval test_ns_inscope {namespace code {one two}}]
     namespace code $sval
 } {::namespace inscope ::test_ns_inscope {one two}}
-
 test namespace-old-10.6 {with many args, each "scope" adds new args} {
     set sval [namespace eval test_ns_inscope {namespace code {one two}}]
     namespace code "$sval three"
 } {::namespace inscope ::test_ns_inscope {one two} three}
-
 test namespace-old-10.7 {scoped commands work with eval} {
     set cref [namespace eval test_ns_inscope {namespace code show}]
     list [eval $cref "a" "b c" "d e f"]
 } {{show: a b c d e f}}
-
 test namespace-old-10.8 {scoped commands execute in namespace context} {
     set cref [namespace eval test_ns_inscope {
         namespace code {set x "some new value"}
     }]
     list [set test_ns_inscope::x] [eval $cref] [set test_ns_inscope::x]
 } {x-value {some new value} {some new value}}
-
+
 foreach cmd [info commands test_ns_*] {
     rename $cmd ""
 }
@@ -851,3 +744,7 @@ eval namespace delete [namespace children :: test_ns_*]
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/namespace.test b/tests/namespace.test
index 947beb6..fab0040 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -1,25 +1,37 @@
 # Functionality covered: this file contains a collection of tests for the
-# procedures in tclNamesp.c that implement Tcl's basic support for
-# namespaces. Other namespace-related tests appear in variable.test.
+# procedures in tclNamesp.c and tclEnsemble.c that implement Tcl's basic
+# support for namespaces.  Other namespace-related tests appear in
+# variable.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-2000 by Scriptics Corporation.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: namespace.test,v 1.46 2005/07/05 17:33:07 dgp Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import -force ::tcltest::*
+testConstraint memory [llength [info commands memory]]
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+#
+# REMARK: the tests for 'namespace upvar' are not done here. They are to be
+# found in the file 'upvar.test'.
+#
 
 # Clear out any namespaces called test_ns_*
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
+catch {namespace delete {*}[namespace children :: test_ns_*]}
+
+proc fq {ns} {
+    if {[string match ::* $ns]} {return $ns}
+    set current [uplevel 1 {namespace current}]
+    return [string trimright $current :]::[string trimleft $ns :]
+}
 
 test namespace-1.1 {TclInitNamespaces, GetNamespaceFromObj, NamespaceChildrenCmd} {
     namespace children :: test_ns_*
@@ -40,7 +52,6 @@ test namespace-2.2 {Tcl_GetCurrentNamespace} {
         }
     }
     lappend l [namespace current]
-    set l
 } {:: ::test_ns_1 ::test_ns_1::foo ::}
 
 test namespace-3.1 {Tcl_GetGlobalNamespace} {
@@ -79,7 +90,7 @@ test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
 } {123}
 
 test namespace-6.1 {Tcl_CreateNamespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [lsort [namespace children :: test_ns_*]] \
         [namespace eval test_ns_1 {namespace current}] \
 	[namespace eval test_ns_2 {namespace current}] \
@@ -98,7 +109,7 @@ test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
     list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg 
 } {0 ::test_ns_7}
 test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1:: {
         namespace eval test_ns_2:: {}
         namespace eval test_ns_3:: {}
@@ -116,7 +127,7 @@ test namespace-6.5 {Tcl_CreateNamespace, relative ns names now only looked up in
 } {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_2}
 
 test namespace-7.1 {Tcl_DeleteNamespace, active call frames in ns} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1 {
         proc p {} {
             namespace delete [namespace current]
@@ -133,6 +144,56 @@ test namespace-7.2 {Tcl_DeleteNamespace, no active call frames in ns} {
     }
     list [test_ns_2::p] [namespace delete test_ns_2]
 } {::test_ns_2 {}}
+test namespace-7.3 {recursive Tcl_DeleteNamespace, active call frames in ns} {
+    # [Bug 1355942]
+    namespace eval test_ns_2 {
+        set x 1
+	trace add variable x unset "namespace delete [namespace current];#"
+	namespace delete [namespace current]
+    }
+} {}
+test namespace-7.4 {recursive Tcl_DeleteNamespace, active call frames in ns} {
+    # [Bug 1355942]
+    namespace eval test_ns_2 {
+        proc x {} {}
+	trace add command x delete "namespace delete [namespace current];#"
+	namespace delete [namespace current]
+    }
+} {}
+test namespace-7.5 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
+    # [Bug 1355942]
+    namespace eval test_ns_2 {
+        set x 1
+	trace add variable x unset "namespace delete [namespace current];#"
+    }
+    namespace delete test_ns_2
+} {}
+test namespace-7.6 {recursive Tcl_DeleteNamespace, no active call frames in ns} {
+    # [Bug 1355942]
+    namespace eval test_ns_2 {
+        proc x {} {}
+	trace add command x delete "namespace delete [namespace current];#"
+    }
+    namespace delete test_ns_2
+} {}
+test namespace-7.7 {Bug 1655305} -setup {
+    interp create slave
+    # Can't invoke through the ensemble, since deleting the global namespace
+    # (indirectly, via deleting ::tcl) deletes the ensemble.
+    slave eval {rename ::tcl::info::commands ::infocommands}
+    slave hide infocommands
+    slave eval {
+	proc foo {} {
+	    namespace delete ::
+	}
+    }
+} -body {
+    slave eval foo
+    slave invokehidden infocommands
+} -cleanup {
+    interp delete slave
+} -result {}
+
 
 test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
     catch {interp delete test_interp}
@@ -161,7 +222,7 @@ test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
          [interp delete test_interp]
 } {{::test_ns_1 27} {} 1 {invalid command name "set"} {}}
 test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
     namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
     list [namespace children test_ns_1] \
@@ -169,7 +230,7 @@ test namespace-8.2 {TclTeardownNamespace, remove deleted ns from parent} {
          [namespace children test_ns_1]
 } {::test_ns_1::test_ns_2 {} {}}
 test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1::test_ns_2::test_ns_3a {proc p {} {}}
     namespace eval test_ns_1::test_ns_2::test_ns_3b {proc q {} {}}
     list [namespace children test_ns_1] \
@@ -177,9 +238,9 @@ test namespace-8.3 {TclTeardownNamespace, delete child namespaces} {
          [namespace children test_ns_1] \
          [catch {namespace children test_ns_1::test_ns_2} msg] $msg \
          [info commands test_ns_1::test_ns_2::test_ns_3a::*]
-} {::test_ns_1::test_ns_2 {} {} 1 {unknown namespace "test_ns_1::test_ns_2" in namespace children command} {}}
+} {::test_ns_1::test_ns_2 {} {} 1 {namespace "test_ns_1::test_ns_2" not found in "::"} {}}
 test namespace-8.4 {TclTeardownNamespace, cmds imported from deleted ns go away} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_export {
         namespace export cmd1 cmd2
         proc cmd1 {args} {return "cmd1: $args"}
@@ -220,7 +281,7 @@ test namespace-8.7 {TclTeardownNamespace: preserve errorInfo; errorCode values}
 } baz
 
 test namespace-9.1 {Tcl_Import, empty import pattern} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace eval test_ns_import {namespace import {}}} msg] $msg
 } {1 {empty import pattern}}
 test namespace-9.2 {Tcl_Import, unknown namespace in import pattern} {
@@ -230,7 +291,7 @@ test namespace-9.3 {Tcl_Import, import ns == export ns} {
     list [catch {namespace eval test_ns_import {namespace import ::test_ns_import::puts}} msg] $msg
 } {1 {import pattern "::test_ns_import::puts" tries to import from namespace "test_ns_import" into itself}}
 test namespace-9.4 {Tcl_Import, simple import} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_export {
         namespace export cmd1
         proc cmd1 {args} {return "cmd1: $args"}
@@ -242,7 +303,7 @@ test namespace-9.4 {Tcl_Import, simple import} {
     }
     test_ns_import::p
 } {cmd1: 123}
-test namespace-9.5 {Tcl_Import, can't redefine cmd unless allowOverwrite!=0} {
+test namespace-9.5 {Tcl_Import, RFE 1230597} {
     list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
 } {0 {}}
 test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
@@ -252,7 +313,7 @@ test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
     }
 } {cmd1: 555}
 test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_export {
         namespace export cmd1
         proc cmd1 {args} {return "cmd1: $args"}
@@ -314,7 +375,7 @@ test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
 } -returnCodes error -match glob -result {import pattern * would create a loop*}
 
 test namespace-10.1 {Tcl_ForgetImport, check for valid namespaces} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace forget xyzzy::*} msg] $msg
 } {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
 test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
@@ -454,7 +515,7 @@ test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
 } -returnCodes error -match glob -result *
 
 test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_export {
         namespace export cmd1
         proc cmd1 {args} {return "cmd1: $args"}
@@ -478,7 +539,7 @@ test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
 } {{cmd1: 123} ::test_ns_export::cmd1}
 
 test namespace-12.1 {InvokeImportedCmd} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_export {
         namespace export cmd1
         proc cmd1 {args} {namespace current}
@@ -497,9 +558,18 @@ test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
         lappend l [info commands ::test_ns_import::*]
     }
 } {::test_ns_import::cmd1 {}}
+test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
+    # Will panic if still buggy
+    namespace eval src {namespace export foo; proc foo {} {}}
+    namespace eval dst {namespace import [namespace parent]::src::foo}
+    trace add command src::foo delete \
+        "[list namespace delete [namespace current]::dst] ;#"
+    proc src::foo {} {}
+    namespace delete src
+} {}
 
 test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     variable v 10
     namespace eval test_ns_1::test_ns_2 {
         variable v 20
@@ -517,7 +587,7 @@ test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
         list [catch {set ::test_ns_777::v} msg] $msg \
              [catch {namespace children test_ns_777} msg] $msg
     }
-} {1 {can't read "::test_ns_777::v": no such variable} 1 {unknown namespace "test_ns_777" in namespace children command}}
+} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
 test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
     namespace eval test_ns_1 {
         list $v $test_ns_2::v
@@ -531,15 +601,14 @@ test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up onl
         list [namespace children test_ns_2] \
              [catch {namespace children test_ns_1} msg] $msg
     }
-} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
+} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
 test namespace-14.5 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
     namespace eval ::test_ns_2 {
         namespace eval bar {}
     }
     namespace eval test_ns_1 {
-        set l [list [catch {namespace delete test_ns_2::bar} msg] $msg]
+        list [catch {namespace delete test_ns_2::bar} msg] $msg
     }
-    set l
 } {1 {unknown namespace "test_ns_2::bar" in namespace delete command}}
 test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
     namespace eval test_ns_1::test_ns_2 {
@@ -549,7 +618,7 @@ test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up onl
         list [namespace children test_ns_2] \
              [catch {namespace children test_ns_1} msg] $msg
     }
-} {::test_ns_1::test_ns_2::foo 1 {unknown namespace "test_ns_1" in namespace children command}}
+} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
 test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
     namespace children test_ns_1:::
 } {::test_ns_1::test_ns_2}
@@ -577,7 +646,7 @@ test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for
     lappend l [test_ns_1::test_ns_2:: hello]
 } {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
 test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1 {
         variable {}
         set test_ns_1::(x) y
@@ -585,12 +654,12 @@ test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for
     set test_ns_1::(x)
 } y
 test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
 } {1 {can't create namespace "": only global namespace can have empty name}}
 
 test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_delete {
         namespace eval test_ns_delete2 {}
         proc cmd {args} {namespace current}
@@ -617,7 +686,7 @@ test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
 } {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
 
 test namespace-16.1 {Tcl_FindCommand, absolute name found} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1 {
         proc cmd {args} {return "[namespace current]::cmd: $args"}
         variable v "::test_ns_1::cmd"
@@ -660,14 +729,16 @@ test namespace-16.8 {Tcl_FindCommand, relative name found} {
         cmd a b c
     }
 } {::test_ns_1::cmd: a b c}
-test namespace-16.9 {Tcl_FindCommand, relative name found} {
-    catch {rename cmd2 {}}
+test namespace-16.9 {Tcl_FindCommand, relative name found} -body {
     proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
     namespace eval test_ns_1 {
        cmd2 a b c
     }
-} {::::cmd2: a b c}
-test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} {
+} -cleanup {
+    catch {rename cmd2 {}}
+} -result {::::cmd2: a b c}
+test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current then global ns} -body {
+    proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
     namespace eval test_ns_1 {
         proc cmd2 {args} {
             return "[namespace current]::cmd2 in test_ns_1: $args"
@@ -676,7 +747,9 @@ test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current
             cmd2 a b c
         }
     }
-} {::::cmd2: a b c}
+} -cleanup {
+    catch {rename cmd2 {}}
+} -result {::::cmd2: a b c}
 test namespace-16.11 {Tcl_FindCommand, relative name not found} {
     namespace eval test_ns_1 {
        list [catch {cmd3 a b c} msg] $msg
@@ -685,7 +758,7 @@ test namespace-16.11 {Tcl_FindCommand, relative name not found} {
 
 catch {unset x}
 test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     set x 314159
     namespace eval test_ns_1 {
         set ::x
@@ -754,7 +827,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
     set a 0
     namespace eval test_ns_1 set a 1
     namespace delete test_ns_1
-    set a
+    return $a
 } 1
 catch {unset a}
 catch {unset x}
@@ -762,7 +835,7 @@ catch {unset x}
 catch {unset l}
 catch {rename foo {}}
 test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     proc foo {} {return "global foo"}
     namespace eval test_ns_1 {
         proc trigger {} {
@@ -776,7 +849,6 @@ test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadow
         proc foo {} {return "foo in test_ns_1"}
     }
     lappend l [test_ns_1::trigger]
-    set l
 } {{global foo} {foo in test_ns_1}}
 test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
     namespace eval test_ns_2 {
@@ -797,13 +869,12 @@ test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shado
         }
     }
     lappend l [test_ns_1::trigger]
-    set l
 } {{foo in ::test_ns_2} {foo in ::test_ns_1::test_ns_2}}
 catch {unset l}
 catch {rename foo {}}
 
 test namespace-19.1 {GetNamespaceFromObj, global name found} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1::test_ns_2 {}
     namespace children ::test_ns_1
 } {::test_ns_1::test_ns_2}
@@ -812,11 +883,11 @@ test namespace-19.2 {GetNamespaceFromObj, relative name found} {
         namespace children test_ns_2
     }
 } {}
-test namespace-19.3 {GetNamespaceFromObj, name not found} {
+test namespace-19.3 {GetNamespaceFromObj, name not found} -body {
     namespace eval test_ns_1 {
-        list [catch {namespace children test_ns_99} msg] $msg
+        namespace children test_ns_99
     }
-} {1 {unknown namespace "test_ns_99" in namespace children command}}
+} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
 test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
     namespace eval test_ns_1 {
         proc foo {} {
@@ -829,22 +900,21 @@ test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
     namespace delete test_ns_1::test_ns_2
     namespace eval test_ns_1::test_ns_2::test_ns_3 {}
     lappend l [test_ns_1::foo]
-    set l
 } {{} ::test_ns_1::test_ns_2::test_ns_3}
 
 test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace} msg] $msg
 } {1 {wrong # args: should be "namespace subcommand ?arg ...?"}}
-test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} {
-    list [catch {namespace wombat {}} msg] $msg
-} {1 {bad option "wombat": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, path, qualifiers, tail, or which}}
+test namespace-20.2 {Tcl_NamespaceObjCmd, bad subcommand} -body {
+    namespace wombat {}
+} -returnCodes error -match glob -result {unknown or ambiguous subcommand "wombat": must be *}
 test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
     namespace ch :: test_ns_*
 } {}
 
 test namespace-21.1 {NamespaceChildrenCmd, no args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1::test_ns_2 {}
     expr {[string first ::test_ns_1 [namespace children]] != -1}
 } {1}
@@ -874,9 +944,13 @@ test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
     namespace eval test_ns_1::test_ns_foo {}
     lsort [namespace children test_ns_1 test*]
 } [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
+test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
+    namespace eval test_ns_1 {}
+    namespace children [namespace current] [fq test_ns_1]
+} [fq test_ns_1]
 
 test namespace-22.1 {NamespaceCodeCmd, bad args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace code} msg] $msg \
          [catch {namespace code xxx yyy} msg] $msg
 } {1 {wrong # args: should be "namespace code arg"} 1 {wrong # args: should be "namespace code arg"}}
@@ -884,11 +958,11 @@ test namespace-22.2 {NamespaceCodeCmd, arg is already scoped value} {
     namespace eval test_ns_1 {
         proc cmd {} {return "test_ns_1::cmd"}
     }
-    namespace code {namespace inscope ::test_ns_1 cmd}
-} {namespace inscope ::test_ns_1 cmd}
+    namespace code {::namespace inscope ::test_ns_1 cmd}
+} {::namespace inscope ::test_ns_1 cmd}
 test namespace-22.3 {NamespaceCodeCmd, arg is already scoped value} {
     namespace code {namespace     inscope     ::test_ns_1 cmd}
-} {namespace     inscope     ::test_ns_1 cmd}
+} {::namespace inscope :: {namespace     inscope     ::test_ns_1 cmd}}
 test namespace-22.4 {NamespaceCodeCmd, in :: namespace} {
     namespace code unknown
 } {::namespace inscope :: unknown}
@@ -908,9 +982,15 @@ test namespace-22.6 {NamespaceCodeCmd, in other namespace} {
 	namespace code {set v} 
     }] 
 } {42} 
+test namespace-22.7 {NamespaceCodeCmd, Bug 3202171} {
+    namespace eval demo {
+	proc namespace args {puts $args}
+	::namespace code {namespace inscope foo}
+    }
+} [list ::namespace inscope [fq demo] {namespace inscope foo}]
 
 test namespace-23.1 {NamespaceCurrentCmd, bad args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace current xxx} msg] $msg \
          [catch {namespace current xxx yyy} msg] $msg
 } {1 {wrong # args: should be "namespace current"} 1 {wrong # args: should be "namespace current"}}
@@ -924,7 +1004,7 @@ test namespace-23.3 {NamespaceCurrentCmd, in nested ns} {
 } {::test_ns_1::test_ns_2}
 
 test namespace-24.1 {NamespaceDeleteCmd, no args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace delete
 } {}
 test namespace-24.2 {NamespaceDeleteCmd, one arg} {
@@ -940,12 +1020,12 @@ test namespace-24.4 {NamespaceDeleteCmd, unknown ns} {
 } {1 {unknown namespace "::test_ns_foo" in namespace delete command}}
 
 test namespace-25.1 {NamespaceEvalCmd, bad args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace eval} msg] $msg
 } {1 {wrong # args: should be "namespace eval name arg ?arg...?"}}
-test namespace-25.2 {NamespaceEvalCmd, bad args} {
-    list [catch {namespace test_ns_1} msg] $msg
-} {1 {bad option "test_ns_1": must be children, code, current, delete, ensemble, eval, exists, export, forget, import, inscope, origin, parent, path, qualifiers, tail, or which}}
+test namespace-25.2 {NamespaceEvalCmd, bad args} -body {
+    namespace test_ns_1
+} -returnCodes error -match glob -result {unknown or ambiguous subcommand "test_ns_1": must be *}
 catch {unset v}
 test namespace-25.3 {NamespaceEvalCmd, new namespace} {
     set v 123
@@ -968,7 +1048,7 @@ test namespace-25.5 {NamespaceEvalCmd, multiple args} {
     namespace eval test_ns_1 "set" "v"
 } {314159}
 test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
-    list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $errorInfo
+    list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
 } {1 {invalid command name "xxxx"} {invalid command name "xxxx"
     while executing
 "xxxx"
@@ -976,21 +1056,24 @@ test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
     invoked from within
 "namespace eval test_ns_1 {xxxx}"}}
 test namespace-25.7 {NamespaceEvalCmd, error in eval'd script} {
-    list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $errorInfo
+    list [catch {namespace eval test_ns_1 {error foo bar baz}} msg] $msg $::errorInfo
 } {1 foo {bar
     (in namespace eval "::test_ns_1" script line 1)
     invoked from within
 "namespace eval test_ns_1 {error foo bar baz}"}}
 test namespace-25.8 {NamespaceEvalCmd, error in eval'd script} {
-    list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $errorInfo
+    list [catch {namespace eval test_ns_1 error foo bar baz} msg] $msg $::errorInfo
 } {1 foo {bar
     (in namespace eval "::test_ns_1" script line 1)
     invoked from within
 "namespace eval test_ns_1 error foo bar baz"}}
 catch {unset v}
+test namespace-25.9 {NamespaceEvalCmd, 545325} {
+    namespace eval test_ns_1 info level 0
+} {namespace eval test_ns_1 info level 0}
 
 test namespace-26.1 {NamespaceExportCmd, no args and new ns} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace export
 } {}
 test namespace-26.2 {NamespaceExportCmd, just -clear arg} {
@@ -1037,9 +1120,17 @@ test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
     }
     list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
 } [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
+test namespace-26.8 {NamespaceExportCmd, -clear resets export list} {
+    catch {namespace delete foo}
+    namespace eval foo {
+	namespace export x
+	namespace export -clear
+    }
+    list [namespace eval foo namespace export] [namespace delete foo]
+} {{} {}}
 
 test namespace-27.1 {NamespaceForgetCmd, no args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace forget
 } {}
 test namespace-27.2 {NamespaceForgetCmd, args must be valid namespaces} {
@@ -1058,10 +1149,23 @@ test namespace-27.3 {NamespaceForgetCmd, arg is forgotten} {
     info commands ::test_ns_2::*
 } {::test_ns_2::cmd2}
 
-test namespace-28.1 {NamespaceImportCmd, no args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
-    namespace import
-} {}
+test namespace-28.1 {NamespaceImportCmd, no args} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
+    namespace eval ::test_ns_1 {
+	proc foo {} {}
+	proc bar {} {}
+	proc boo {} {}
+	proc glorp {} {}
+	namespace export foo b*
+    }
+    namespace eval ::test_ns_2 {
+	namespace import ::test_ns_1::*
+	lsort [namespace import]
+    }
+} -cleanup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -result {bar boo foo}
 test namespace-28.2 {NamespaceImportCmd, no args and just "-force"} {
     namespace import -force
 } {}
@@ -1079,15 +1183,15 @@ test namespace-28.3 {NamespaceImportCmd, arg is imported} {
 } {::test_ns_2::cmd2}
 
 test namespace-29.1 {NamespaceInscopeCmd, bad args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace inscope} msg] $msg
 } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
 test namespace-29.2 {NamespaceInscopeCmd, bad args} {
     list [catch {namespace inscope ::} msg] $msg
 } {1 {wrong # args: should be "namespace inscope name arg ?arg...?"}}
-test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} {
-    list [catch {namespace inscope test_ns_1 {set v}} msg] $msg
-} {1 {unknown namespace "test_ns_1" in inscope namespace command}}
+test namespace-29.3 {NamespaceInscopeCmd, specified ns must exist} -body {
+    namespace inscope test_ns_1 {set v}
+} -returnCodes error -result {namespace "test_ns_1" not found in "::"}
 test namespace-29.4 {NamespaceInscopeCmd, simple case} {
     namespace eval test_ns_1 {
         variable v 747
@@ -1102,9 +1206,13 @@ test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
     list [namespace inscope test_ns_1 cmd x y z] \
          [namespace eval test_ns_1 [concat cmd [list x y z]]]
 } {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
+test namespace-29.6 {NamespaceInscopeCmd, 1400572} {
+    namespace inscope test_ns_1 {info level 0}
+} {namespace inscope test_ns_1 {info level 0}}
+
 
 test namespace-30.1 {NamespaceOriginCmd, bad args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace origin} msg] $msg
 } {1 {wrong # args: should be "namespace origin name"}}
 test namespace-30.2 {NamespaceOriginCmd, bad args} {
@@ -1137,7 +1245,7 @@ test namespace-30.5 {NamespaceOriginCmd, imported command} {
 } {::foreach ::test_ns_2::p ::test_ns_1::cmd1 ::test_ns_1::cmd2}
 
 test namespace-31.1 {NamespaceParentCmd, bad args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace parent a b} msg] $msg
 } {1 {wrong # args: should be "namespace parent ?name?"}}
 test namespace-31.2 {NamespaceParentCmd, no args} {
@@ -1153,12 +1261,12 @@ test namespace-31.3 {NamespaceParentCmd, namespace specified} {
          [namespace parent test_ns_1::test_ns_2] \
          [namespace eval test_ns_1::test_ns_2::test_ns_3 {namespace parent ::test_ns_1::test_ns_2}]
 } {{} ::test_ns_1 ::test_ns_1}
-test namespace-31.4 {NamespaceParentCmd, bad namespace specified} {
-    list [catch {namespace parent test_ns_1::test_ns_foo} msg] $msg
-} {1 {unknown namespace "test_ns_1::test_ns_foo" in namespace parent command}}
+test namespace-31.4 {NamespaceParentCmd, bad namespace specified} -body {
+    namespace parent test_ns_1::test_ns_foo
+} -returnCodes error -result {namespace "test_ns_1::test_ns_foo" not found in "::"}
 
 test namespace-32.1 {NamespaceQualifiersCmd, bad args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace qualifiers} msg] $msg
 } {1 {wrong # args: should be "namespace qualifiers string"}}
 test namespace-32.2 {NamespaceQualifiersCmd, bad args} {
@@ -1184,7 +1292,7 @@ test namespace-32.8 {NamespaceQualifiersCmd, odd number of :s} {
 } {foo}
 
 test namespace-33.1 {NamespaceTailCmd, bad args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace tail} msg] $msg
 } {1 {wrong # args: should be "namespace tail string"}}
 test namespace-33.2 {NamespaceTailCmd, bad args} {
@@ -1210,7 +1318,7 @@ test namespace-33.8 {NamespaceTailCmd, odd number of :s} {
 } {}
 
 test namespace-34.1 {NamespaceWhichCmd, bad args} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     list [catch {namespace which} msg] $msg
 } {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
 test namespace-34.2 {NamespaceWhichCmd, bad args} {
@@ -1263,7 +1371,7 @@ test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
 } {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
 
 test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1 {
         proc p {} {
             namespace delete [namespace current]
@@ -1286,7 +1394,7 @@ test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
 catch {unset x}
 catch {unset y}
 test namespace-36.1 {DupNsNameInternalRep} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1 {}
     set x "::test_ns_1"
     list [namespace parent $x] [set y $x] [namespace parent $y]
@@ -1295,27 +1403,27 @@ catch {unset x}
 catch {unset y}
 
 test namespace-37.1 {SetNsNameFromAny, ns name found} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval test_ns_1::test_ns_2 {}
     namespace eval test_ns_1 {
         namespace children ::test_ns_1
     }
 } {::test_ns_1::test_ns_2}
-test namespace-37.2 {SetNsNameFromAny, ns name not found} {
+test namespace-37.2 {SetNsNameFromAny, ns name not found} -body {
     namespace eval test_ns_1 {
-        list [catch {namespace children ::test_ns_1::test_ns_foo} msg] $msg
+        namespace children ::test_ns_1::test_ns_foo
     }
-} {1 {unknown namespace "::test_ns_1::test_ns_foo" in namespace children command}}
+} -returnCodes error -result {namespace "::test_ns_1::test_ns_foo" not found}
 
 test namespace-38.1 {UpdateStringOfNsName} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     ;# Tcl_NamespaceObjCmd calls UpdateStringOfNsName to get subcmd name
     list [namespace eval {} {namespace current}] \
          [namespace eval {} {namespace current}]
 } {:: ::}
 
 test namespace-39.1 {NamespaceExistsCmd} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     namespace eval ::test_ns_z::test_me { variable foo }
     list [namespace exists ::] \
 	    [namespace exists ::bogus_namespace] \
@@ -1334,16 +1442,17 @@ test namespace-39.3 {NamespaceExistsCmd error} {
     list [catch {namespace exists a b} msg] $msg
 } {1 {wrong # args: should be "namespace exists name"}}
 
-test namespace-40.1 {Ignoring namespace proc "unknown"} {
+test namespace-40.1 {Ignoring namespace proc "unknown"} -setup {
     rename unknown _unknown
+} -body {
     proc unknown args {return global}
     namespace eval ns {proc unknown args {return local}}
-    set l [list [namespace eval ns aaa bbb] [namespace eval ns aaa]]
+    list [namespace eval ns aaa bbb] [namespace eval ns aaa]
+} -cleanup {
     rename unknown {}   
     rename _unknown unknown
     namespace delete ns
-    set l
-} {global global}
+} -result {global global}
 
 test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
     set res {}
@@ -1361,7 +1470,6 @@ test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
     namespace delete ns
     set res
 } {0 1}
-
 test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
     set res {}
     namespace eval ns {}
@@ -1375,19 +1483,16 @@ test namespace-41.2 {Shadowing byte-compiled commands, Bug: 231259} {
     namespace delete ns
     set res
 } {New proc is called}
-
 test namespace-41.3 {Shadowing byte-compiled commands, Bugs: 231259, 729692} {
     set res {}
     namespace eval ns {
 	variable b 0
     }
-
     proc ns::a {i} {
 	variable b
 	proc set args {return "New proc is called"}
 	return [set b $i]
     }
-    
     set res [list [ns::a 1] $ns::b]
     namespace delete ns
     set res
@@ -1426,18 +1531,18 @@ test namespace-42.3 {ensembles: basic} {
     namespace delete ns
     lappend result [info command ns::x1]
 } {1 2 1 {unknown or ambiguous subcommand "x": must be x1, or x2} ::ns::x1 {}}
-test namespace-42.4 {ensembles: basic} {
+test namespace-42.4 {ensembles: basic} -body {
     namespace eval ns {
 	namespace export y*
 	proc x1 {} {format 1}
 	proc x2 {} {format 2}
 	namespace ensemble create
     }
-    set result [list [catch {ns x} msg] $msg]
+    list [catch {ns x} msg] $msg
+} -cleanup {
     namespace delete ns
-    set result
-} {1 {unknown subcommand "x": namespace ::ns does not export any commands}}
-test namespace-42.5 {ensembles: basic} {
+} -result {1 {unknown subcommand "x": namespace ::ns does not export any commands}}
+test namespace-42.5 {ensembles: basic} -body {
     namespace eval ns {
 	namespace export x*
 	proc x1 {} {format 1}
@@ -1445,11 +1550,11 @@ test namespace-42.5 {ensembles: basic} {
 	proc x3 {} {format 3}
 	namespace ensemble create
     }
-    set result [list [catch {ns x} msg] $msg]
+    list [catch {ns x} msg] $msg
+} -cleanup {
     namespace delete ns
-    set result
-} {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}}
-test namespace-42.6 {ensembles: nested} {
+} -result {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}}
+test namespace-42.6 {ensembles: nested} -body {
     namespace eval ns {
 	namespace export x*
 	namespace eval x0 {
@@ -1462,11 +1567,11 @@ test namespace-42.6 {ensembles: nested} {
 	proc x3 {} {format 3}
 	namespace ensemble create
     }
-    set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
+    list [ns x0 z] [ns x1] [ns x2] [ns x3]
+} -cleanup {
     namespace delete ns
-    set result
-} {0 1 2 3}
-test namespace-42.7 {ensembles: nested} {
+} -result {0 1 2 3}
+test namespace-42.7 {ensembles: nested} -body {
     namespace eval ns {
 	namespace export x*
 	namespace eval x0 {
@@ -1479,10 +1584,24 @@ test namespace-42.7 {ensembles: nested} {
 	proc x3 {} {format 3}
 	namespace ensemble create
     }
-    set result [list [ns x0 z] [ns x1] [ns x2] [ns x3]]
+    list [ns x0 z] [ns x1] [ns x2] [ns x3]
+} -cleanup {
     namespace delete ns
-    set result
-} {{1 ::ns::x0::z} 1 2 3}
+} -result {{1 ::ns::x0::z} 1 2 3}
+test namespace-42.8 {ensembles: [Bug 1670091]} -setup {
+    proc demo args {}
+    variable target [list [namespace which demo] x]
+    proc trial args {variable target; string length $target}
+    trace add execution demo enter [namespace code trial]
+    namespace ensemble create -command foo -map [list bar $target]
+} -body {
+    foo bar
+} -cleanup {
+    unset target
+    rename demo {}
+    rename trial {}
+    rename foo {}
+} -result {}
 
 test namespace-43.1 {ensembles: dict-driven} {
     namespace eval ns {
@@ -1495,7 +1614,7 @@ test namespace-43.1 {ensembles: dict-driven} {
     rename ns {}
     lappend result [namespace ensemble exists ns]
 } {1 {unknown or ambiguous subcommand "c": must be a, or b} 1 0}
-test namespace-43.2 {ensembles: dict-driven} {
+test namespace-43.2 {ensembles: dict-driven} -body {
     namespace eval ns {
 	namespace export x*
 	proc x1 {args} {list 1 $args}
@@ -1504,10 +1623,10 @@ test namespace-43.2 {ensembles: dict-driven} {
 	    a ::ns::x1 b ::ns::x2 c {::ns::x1 .} d {::ns::x2 .}
 	}
     }
-    set result [list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]]
+    list [ns a] [ns b] [ns c] [ns c foo] [ns d] [ns d foo]
+} -cleanup {
     namespace delete ns
-    set result
-} {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}}
+} -result {{1 {}} {2 0} {1 .} {1 {. foo}} {2 1} {2 2}}
 set SETUP {
     namespace eval ns {
 	namespace export a b
@@ -1605,6 +1724,9 @@ test namespace-44.5 {ensemble: errors} -setup {
 } -cleanup {
     rename foobar {}
 } -returnCodes error -result {invalid command name "::foobarconfigure"}
+test namespace-44.6 {ensemble: errors} -returnCodes error -body {
+    namespace ensemble create gorp
+} -result {wrong # args: should be "namespace ensemble create ?option value ...?"}
 
 test namespace-45.1 {ensemble: introspection} {
     namespace eval ns {
@@ -1615,7 +1737,7 @@ test namespace-45.1 {ensemble: introspection} {
     }
     namespace delete ns
     set result
-} {-map {} -namespace ::ns -prefixes 1 -subcommands {} -unknown {}}
+} {-map {} -namespace ::ns -parameters {} -prefixes 1 -subcommands {} -unknown {}}
 test namespace-45.2 {ensemble: introspection} {
     namespace eval ns {
 	namespace export x
@@ -1631,15 +1753,12 @@ test namespace-46.1 {ensemble: modification} {
     namespace eval ns {
 	namespace export x
 	proc x {} {format 123}
-
 	# Ensemble maps A->x
 	namespace ensemble create -command ns -map {A ::ns::x}
 	set ::result [list [namespace ensemble configure ns -map] [ns A]]
-
 	# Ensemble maps B->x
 	namespace ensemble configure ns -map {B ::ns::x}
 	lappend ::result [namespace ensemble configure ns -map] [ns B]
-
 	# Ensemble maps x->x
 	namespace ensemble configure ns -map {}
 	lappend ::result [namespace ensemble configure ns -map] [ns x]
@@ -1679,7 +1798,7 @@ test namespace-46.3 {ensemble: implementation errors} {
     lappend result $ns::count
     namespace delete ns
     lappend result [info command p]
-} {1 {wrong # args: should be "ns subcommand ?argument ...?"} 10 3010 3010 {}}
+} {1 {wrong # args: should be "ns subcommand ?arg ...?"} 10 3010 3010 {}}
 test namespace-46.4 {ensemble: implementation errors} {
     namespace eval ns {
 	namespace ensemble create
@@ -1777,7 +1896,7 @@ test namespace-47.2 {ensemble: unknown handler} {
 	}
 	namespace ensemble create -unknown ::ns::Magic
     }
-    list [catch {ns spong} msg] $msg $errorInfo [namespace delete ns]
+    list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns]
 } {1 foobar {foobar
     while executing
 "error foobar"
@@ -1810,7 +1929,7 @@ test namespace-47.4 {ensemble: unknown handler} {
 	}
 	namespace ensemble create -unknown ::ns::Magic
     }
-    list [catch {ns spong} msg] $msg $errorInfo [namespace delete ns]
+    list [catch {ns spong} msg] $msg $::errorInfo [namespace delete ns]
 } {1 {unknown subcommand handler returned bad code: break} {unknown subcommand handler returned bad code: break
     result of ensemble unknown subcommand handler: ::ns::Magic ::ns spong
     invoked from within
@@ -1829,19 +1948,37 @@ test namespace-47.5 {ensemble: unknown handler} {
     lappend result [catch {foo bar} msg] $msg [namespace ensemble config foo]
     rename foo {}
     set result
-} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -prefixes 1 -subcommands {} -unknown bar}}
+} {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo 0 {{LOG ::foo bar} 1 {unknown subcommand "bar": namespace :: does not export any commands} {LOG ::foo bar} boo hoo} {-map {} -namespace :: -parameters {} -prefixes 1 -subcommands {} -unknown bar}}
 test namespace-47.6 {ensemble: unknown handler} {
     namespace ensemble create -command foo -unknown bar
     proc bar {args} {
 	return "\{"
     }
-    set result [list [catch {foo bar} msg] $msg $errorInfo]
+    set result [list [catch {foo bar} msg] $msg $::errorInfo]
     rename foo {}
     set result
 } {1 {unmatched open brace in list} {unmatched open brace in list
     while parsing result of ensemble unknown subcommand handler
     invoked from within
 "foo bar"}}
+test namespace-47.7 {ensemble: unknown handler, commands with spaces} {
+    namespace ensemble create -command foo -unknown bar
+    proc bar {args} {
+	list ::set ::x [join $args |]
+    }
+    set result [foo {one two three}]
+    rename foo {}
+    set result
+} {::foo|one two three}
+test namespace-47.8 {ensemble: unknown handler, commands with spaces} {
+    namespace ensemble create -command foo -unknown {bar boo}
+    proc bar {args} {
+	list ::set ::x [join $args |]
+    }
+    set result [foo {one two three}]
+    rename foo {}
+    set result
+} {boo|::foo|one two three}
 
 test namespace-48.1 {ensembles and namespace import: unknown handler} {
     namespace eval foo {
@@ -1878,7 +2015,7 @@ test namespace-48.1 {ensembles and namespace import: unknown handler} {
     bar z 789
     namespace delete foo
     set result
-} {{-map {} -namespace ::foo -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789}
+} {{-map {} -namespace ::foo -parameters {} -prefixes 1 -subcommands x -unknown ::foo::u} XXX 123 ::foo::bar {y 456} YYY 456 ::foo::bar {z 789} ZZZ 789}
 test namespace-48.2 {ensembles and namespace import: exists} {
     namespace eval foo {
 	namespace ensemble create -command ::foo::bar
@@ -1942,7 +2079,7 @@ test namespace-50.1 {ensembles affect proc arguments error messages} -body {
     namespace ens cre -command a -map {b {bb foo}}
     proc bb {c d {e f} args} {list $c $args}
     a b
-} -returnCodes error -result "wrong # args: should be \"a b d ?e? ...\"" -cleanup {
+} -returnCodes error -result "wrong # args: should be \"a b d ?e? ?arg ...?\"" -cleanup {
     rename a {}
     rename bb {}
 }
@@ -1959,6 +2096,7 @@ test namespace-50.3 {chained ensembles affect error messages} -body {
     a b d
 } -returnCodes error -result "wrong # args: should be \"a b d f\"" -cleanup {
     rename a {}
+    rename c {}
 }
 test namespace-50.4 {chained ensembles affect error messages} -body {
     namespace ens cre -command a -map {b {c d}}
@@ -1967,6 +2105,7 @@ test namespace-50.4 {chained ensembles affect error messages} -body {
     a b d
 } -returnCodes error -result "wrong # args: should be \"a b\"" -cleanup {
     rename a {}
+    rename c {}
 }
 
 test namespace-51.1 {name resolution path control} -body {
@@ -2235,7 +2374,7 @@ test namespace-51.10 {name resolution path control} -body {
     namespace eval ::test_ns_1 {
 	namespace path does::not::exist
     }
-} -returnCodes error -result {unknown namespace "does::not::exist"} -cleanup {
+} -returnCodes error -result {namespace "does::not::exist" not found in "::test_ns_1"} -cleanup {
     catch {namespace delete ::test_ns_1}
 }
 test namespace-51.11 {name resolution path control} -body {
@@ -2278,15 +2417,14 @@ test namespace-51.12 {name resolution path control} -body {
     catch {namespace delete ::test_ns_3}
     catch {namespace delete ::test_ns_4}
 }
-# Fails right now due to unrelated bug...
-test namespace-51.13 {name resolution path control} -constraints knownBug -body {
+test namespace-51.13 {name resolution path control} -body {
     set ::result {}
     namespace eval ::test_ns_1 {
 	proc foo {} {lappend ::result 1}
     }
     namespace eval ::test_ns_2 {
 	proc foo {} {lappend ::result 2}
-	trace add command foo delete {namespace eval ::test_ns_3 foo;#}
+	trace add command foo delete "namespace eval ::test_ns_3 foo;#"
     }
     namespace eval ::test_ns_3 {
 	proc foo {} {
@@ -2302,21 +2440,24 @@ test namespace-51.13 {name resolution path control} -constraints knownBug -body
 	}
 	bar
     }
-    # Should the result be "2 {} {2 3 1 1}" instead?
-} -result {2 {} {2 3 2 1}} -cleanup {
+    # Should the result be "2 {} {2 3 2 1}" instead?
+} -result {2 {} {2 3 1 1}} -cleanup {
     catch {namespace delete ::test_ns_1}
     catch {namespace delete ::test_ns_2}
     catch {namespace delete ::test_ns_3}
     catch {namespace delete ::test_ns_4}
 }
-test namespace-51.14 {name resolution path control} -body {
-    proc foo0 {} {}
-    namespace eval ::test_ns_1 {
-	proc foo1 {} {}
-    }
-    namespace eval ::test_ns_2 {
-	proc foo2 {} {}
+test namespace-51.14 {name resolution path control} -setup {
+    foreach cmd [info commands foo*] {
+	rename $cmd {}
     }
+    namespace eval ::test_ns_1 {}
+    namespace eval ::test_ns_2 {}
+    namespace eval ::test_ns_3 {}
+} -body {
+    proc foo0 {} {}
+    proc ::test_ns_1::foo1 {} {}
+    proc ::test_ns_2::foo2 {} {}
     namespace eval ::test_ns_3 {
 	variable result {}
 	lappend result [info commands foo*]
@@ -2329,11 +2470,11 @@ test namespace-51.14 {name resolution path control} -body {
 	namespace delete ::test_ns_1
 	lappend result [info commands foo*]
     }
-} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}} -cleanup {
+} -cleanup {
     catch {namespace delete ::test_ns_1}
     catch {namespace delete ::test_ns_2}
     catch {namespace delete ::test_ns_3}
-}
+} -result {foo0 {foo1 foo2 foo0} {foo2 foo1 foo0} {foo1 foo2 foo0} {foo2 foo0}}
 test namespace-51.15 {namespace resolution path control} -body {
     namespace eval ::test_ns_2 {
 	proc foo {} {return 2}
@@ -2351,13 +2492,470 @@ test namespace-51.15 {namespace resolution path control} -body {
     namespace delete ::test_ns_1
     namespace delete ::test_ns_2
 }
+test namespace-51.16 {Bug 1566526} {
+    interp create slave
+    slave eval namespace eval demo namespace path ::
+    interp delete slave
+} {}
+test namespace-51.17 {resolution epoch handling: Bug 2898722} -setup {
+    set result {}
+    catch {namespace delete ::a}
+} -body {
+    namespace eval ::a {
+	proc c {} {lappend ::result A}
+	c
+	namespace eval b {
+	    variable d c
+	    lappend ::result [catch { $d }]
+	}
+	lappend ::result .
+	namespace eval b {
+	    namespace path [namespace parent]
+	    $d;[format %c 99]
+	}
+	lappend ::result .
+	namespace eval b {
+	    proc c {} {lappend ::result B}
+	    $d;[format %c 99]
+	}
+	lappend ::result .
+    }
+    namespace eval ::a::b {
+	$d;[format %c 99]
+	lappend ::result .
+	proc ::c {} {lappend ::result G}
+	$d;[format %c 99]
+	lappend ::result .
+	rename ::a::c {}
+	$d;[format %c 99]
+	lappend ::result .
+	rename ::a::b::c {}
+	$d;[format %c 99]
+    }
+} -cleanup {
+    namespace delete ::a
+    catch {rename ::c {}}
+    unset result
+} -result {A 1 . A A . B B . B B . B B . B B . G G}
+test namespace-51.18 {Bug 3185407} -setup {
+    namespace eval ::test_ns_1 {}
+} -body {
+    namespace eval ::test_ns_1 {
+	variable result {}
+	namespace eval ns {proc foo {} {}}
+	namespace eval ns2 {proc foo {} {}}
+	namespace path {ns ns2}
+	variable x foo
+	lappend result [namespace which $x]
+	proc foo {} {}
+	lappend result [namespace which $x]
+    }
+} -cleanup {
+    namespace delete ::test_ns_1
+} -result {::test_ns_1::ns::foo ::test_ns_1::foo}
+
+# TIP 181 - namespace unknown tests
+test namespace-52.1 {unknown: default handler ::unknown} {
+    set result [list [namespace eval foobar { namespace unknown }]]
+    lappend result [namespace eval :: { namespace unknown }]
+    namespace delete foobar
+    set result
+} {{} ::unknown}
+test namespace-52.2 {unknown: default resolution global} {
+    proc ::foo {} { return "GLOBAL" }
+    namespace eval ::bar { proc foo {} { return "NAMESPACE" } }
+    namespace eval ::bar::jim { proc test {} { foo } }
+    set result [::bar::jim::test]
+    namespace delete ::bar
+    rename ::foo {}
+    set result
+} {GLOBAL}
+test namespace-52.3 {unknown: default resolution local} {
+    proc ::foo {} { return "GLOBAL" }
+    namespace eval ::bar {
+	proc foo {} { return "NAMESPACE" }
+	proc test {} { foo }
+    }
+    set result [::bar::test]
+    namespace delete ::bar
+    rename ::foo {}
+    set result
+} {NAMESPACE}
+test namespace-52.4 {unknown: set handler} {
+    namespace eval foo {
+	namespace unknown [list dispatch]
+	proc dispatch {args} { return $args }
+	proc test {} {
+	    UnknownCmd a b c
+	}
+    }
+    set result [foo::test]
+    namespace delete foo
+    set result
+} {UnknownCmd a b c}
+test namespace-52.5 {unknown: search path before unknown is unaltered} {
+    proc ::test2 {args} { return "TEST2: $args" }
+    namespace eval foo {
+	namespace unknown [list dispatch]
+	proc dispatch {args} { return "UNKNOWN: $args" }
+	proc test1 {args} { return "TEST1: $args" }
+	proc test {} {
+	    set result [list [test1 a b c]]
+	    lappend result [test2 a b c]
+	    lappend result [test3 a b c]
+	    return $result
+	}
+    }
+    set result [foo::test]
+    namespace delete foo
+    rename ::test2 {}
+    set result
+} {{TEST1: a b c} {TEST2: a b c} {UNKNOWN: test3 a b c}}
+test namespace-52.6 {unknown: deleting handler restores default} {
+    rename ::unknown ::_unknown_orig
+    proc ::unknown {args} { return "DEFAULT: $args" }
+    namespace eval foo {
+	namespace unknown dummy
+	namespace unknown {}
+    }
+    set result [namespace eval foo { dummy a b c }]
+    rename ::unknown {}
+    rename ::_unknown_orig ::unknown
+    namespace delete foo
+    set result
+} {DEFAULT: dummy a b c}
+test namespace-52.7 {unknown: setting global unknown handler} {
+    proc ::myunknown {args} { return "MYUNKNOWN: $args" }
+    namespace eval :: { namespace unknown ::myunknown }
+    set result [namespace eval foo { dummy a b c }]
+    namespace eval :: { namespace unknown {} }
+    rename ::myunknown {}
+    namespace delete foo
+    set result
+} {MYUNKNOWN: dummy a b c}
+test namespace-52.8 {unknown: destroying and redefining global namespace} {
+    set i [interp create]
+    $i hide proc
+    $i hide namespace
+    $i hide return
+    $i invokehidden namespace delete ::
+    $i expose return
+    $i invokehidden proc unknown args { return "FINE" }
+    $i eval { foo bar bob }
+} {FINE}
+test namespace-52.9 {unknown: refcounting} -setup {
+    proc this args {
+	unset args		;# stop sharing
+	set copy [namespace unknown]
+	string length $copy	;# shimmer away list rep
+	info level 0
+    }
+    set handler [namespace unknown]
+    namespace unknown {this is a test}
+    catch {rename noSuchCommand {}}
+} -body {
+    noSuchCommand
+} -cleanup {
+    namespace unknown $handler
+    rename this {}
+} -result {this is a test noSuchCommand}
+testConstraint testevalobjv [llength [info commands testevalobjv]]
+test namespace-52.10 {unknown: with TCL_EVAL_GLOBAL} -constraints {
+    testevalobjv
+} -setup {
+    rename ::unknown unknown.save
+    proc ::unknown args {
+	set caller [uplevel 1 {namespace current}]
+	namespace eval $caller {
+	    variable foo
+	    return $foo
+	}
+    }
+    catch {rename ::noSuchCommand {}}
+} -body {
+    namespace eval :: {
+	variable foo SUCCESS
+    }
+    namespace eval test_ns_1 {
+	variable foo FAIL
+	testevalobjv 1 noSuchCommand
+    }
+} -cleanup {
+    unset -nocomplain ::foo
+    namespace delete test_ns_1
+    rename ::unknown {}
+    rename unknown.save ::unknown
+} -result SUCCESS
+test namespace-52.11 {unknown: with TCL_EVAL_INVOKE} -setup {
+    set handler [namespace eval :: {namespace unknown}]
+    namespace eval :: {namespace unknown unknown}
+    rename ::unknown unknown.save
+    namespace eval :: {
+	proc unknown args {
+	    return SUCCESS
+	}
+    }
+    catch {rename ::noSuchCommand {}}
+    set ::slave [interp create]
+} -body {
+    $::slave alias bar noSuchCommand
+    namespace eval test_ns_1 {
+	namespace unknown unknown
+	proc unknown args {
+	    return FAIL
+	}
+	$::slave eval bar
+    }
+} -cleanup {
+    interp delete $::slave
+    unset ::slave
+    namespace delete test_ns_1
+    rename ::unknown {}
+    rename unknown.save ::unknown
+    namespace eval :: [list namespace unknown $handler]
+} -result SUCCESS
+test namespace-52.12 {unknown: error case must not reset handler} -body {
+    namespace eval foo {
+	namespace unknown ok
+	catch {namespace unknown {{}{}{}}}
+	namespace unknown
+    }
+} -cleanup {
+    namespace delete foo
+} -result ok
 
+# TIP 314 - ensembles with parameters
+test namespace-53.1 {ensembles: parameters} {
+    namespace eval ns {
+	namespace export x
+	proc x {para} {list 1 $para}
+	namespace ensemble create -parameters {para1}
+    }
+    list [info command ns] [ns bar x] [namespace delete ns] [info command ns]
+} {ns {1 bar} {} {}}
+test namespace-53.2 {ensembles: parameters} -setup {
+    namespace eval ns {
+	namespace export x
+	proc x {para} {list 1 $para}
+	namespace ensemble create
+    }
+} -body {
+    namespace ensemble configure ns -parameters {para1}
+    rename ns foo
+    list [info command foo] [foo bar x] [namespace delete ns] [info command foo]
+} -result {foo {1 bar} {} {}}
+test namespace-53.3 {ensembles: parameters} -setup {
+    namespace eval ns {
+	namespace export x*
+	proc x1 {para} {list 1 $para}
+	proc x2 {para} {list 2 $para}
+	namespace ensemble create -parameters param1
+    }
+} -body {
+    set result [list [ns x2 x1] [ns x1 x2]]
+    lappend result [catch {ns x} msg] $msg
+    lappend result [catch {ns x x} msg] $msg
+    rename ns {}
+    lappend result [info command ns::x1]
+    namespace delete ns
+    lappend result [info command ns::x1]
+} -result\
+   {{1 x2} {2 x1}\
+    1 {wrong # args: should be "ns param1 subcommand ?arg ...?"}\
+    1 {unknown or ambiguous subcommand "x": must be x1, or x2}\
+    ::ns::x1 {}}
+test namespace-53.4 {ensembles: parameters} -setup {
+    namespace eval ns {
+	namespace export x*
+	proc x1 {a1 a2} {list 1 $a1 $a2}
+	proc x2 {a1 a2} {list 2 $a1 $a2}
+	proc x3 {a1 a2} {list 3 $a1 $a2}
+	namespace ensemble create
+    }
+} -body {
+    set result {}
+    lappend result [ns x1 x2 x3]
+    namespace ensemble configure ns -parameters p1
+    lappend result [ns x1 x2 x3]
+    namespace ensemble configure ns -parameters {p1 p2}
+    lappend result [ns x1 x2 x3]
+} -cleanup {
+    namespace delete ns
+} -result {{1 x2 x3} {2 x1 x3} {3 x1 x2}}
+test namespace-53.5 {ensembles: parameters} -setup {
+    namespace eval ns {
+	namespace export x*
+	proc x1 {para} {list 1 $para}
+	proc x2 {para} {list 2 $para}
+	proc x3 {para} {list 3 $para}
+	namespace ensemble create
+    }
+} -body {
+    set result [list [catch {ns x x1} msg] $msg]
+    lappend result [catch {ns x1 x} msg] $msg
+    namespace ensemble configure ns -parameters p1
+    lappend result [catch {ns x1 x} msg] $msg
+    lappend result [catch {ns x x1} msg] $msg
+} -cleanup {
+    namespace delete ns
+} -result\
+   {1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\
+    0 {1 x}\
+    1 {unknown or ambiguous subcommand "x": must be x1, x2, or x3}\
+    0 {1 x}}
+test namespace-53.6 {ensembles: nested} -setup {
+    namespace eval ns {
+	namespace export x*
+	namespace eval x0 {
+	    proc z {args} {list 0 $args}
+	    namespace export z
+	    namespace ensemble create
+	}
+	proc x1 {args} {list 1 $args}
+	proc x2 {args} {list 2 $args}
+	proc x3 {args} {list 3 $args}
+	namespace ensemble create -parameters p
+    }
+} -body {
+    list [ns z x0] [ns z x1] [ns z x2] [ns z x3]
+} -cleanup {
+    namespace delete ns
+} -result {{0 {}} {1 z} {2 z} {3 z}}
+test namespace-53.7 {ensembles: parameters & wrong # args} -setup {
+    namespace eval ns {
+	namespace export x*
+	proc x1 {a1 a2 a3 a4} {list x1 $a1 $a2 $a3 $a4}
+	namespace ensemble create -parameters p1
+    }
+} -body {
+    set result {}
+    lappend result [catch {ns} msg] $msg
+    lappend result [catch {ns x1} msg] $msg
+    lappend result [catch {ns x1 x1} msg] $msg
+    lappend result [catch {ns x1 x1 x1} msg] $msg
+    lappend result [catch {ns x1 x1 x1 x1} msg] $msg
+    lappend result [catch {ns x1 x1 x1 x1 x1} msg] $msg
+} -cleanup {
+    namespace delete ns
+} -result\
+   {1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\
+    1 {wrong # args: should be "ns p1 subcommand ?arg ...?"}\
+    1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
+    1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
+    1 {wrong # args: should be "ns x1 x1 a2 a3 a4"}\
+    0 {x1 x1 x1 x1 x1}}
+test namespace-53.8 {ensemble: unknown handler changing -parameters} -setup {
+    namespace eval ns {
+	namespace export x*
+	proc x1 {a1} {list 1 $a1}
+	proc Magic {ensemble subcmd args} {
+	    namespace ensemble configure $ensemble\
+              -parameters [lrange p1 [llength [
+                namespace ensemble configure $ensemble -parameters
+              ]] 0]
+            list
+	}
+	namespace ensemble create -unknown ::ns::Magic
+    }
+} -body {
+    set result {}
+    lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters]
+    lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters]
+    lappend result [catch {ns x2 x3} msg] $msg [namespace ensemble configure ns -parameters]
+} -cleanup {
+    namespace delete ns
+} -result\
+   {0 {1 x2} {}\
+    0 {1 x2} p1\
+    1 {unknown or ambiguous subcommand "x2": must be x1} {}}
+test namespace-53.9 {ensemble: unknown handler changing -parameters,\
+  thereby eating all args} -setup {
+    namespace eval ns {
+	namespace export x*
+	proc x1 {args} {list 1 $args}
+	proc Magic {ensemble subcmd args} {
+	    namespace ensemble configure $ensemble\
+              -parameters {p1 p2 p3 p4 p5}
+            list
+	}
+	namespace ensemble create -unknown ::ns::Magic
+    }
+} -body {
+    set result {}
+    lappend result [catch {ns x1 x2} msg] $msg [namespace ensemble configure ns -parameters]
+    lappend result [catch {ns x2 x1} msg] $msg [namespace ensemble configure ns -parameters]
+    lappend result [catch {ns a1 a2 a3 a4 a5 x1} msg] $msg [namespace ensemble configure ns -parameters]
+} -cleanup {
+    namespace delete ns
+} -result\
+   {0 {1 x2} {}\
+    1 {wrong # args: should be "ns p1 p2 p3 p4 p5 subcommand ?arg ...?"} {p1 p2 p3 p4 p5}\
+    0 {1 {a1 a2 a3 a4 a5}} {p1 p2 p3 p4 p5}}
+test namespace-53.10 {ensembles: nested rewrite} -setup {
+    namespace eval ns {
+	namespace export x
+	namespace eval x {
+	    proc z0 {} {list 0}
+	    proc z1 {a1} {list 1 $a1}
+	    proc z2 {a1 a2} {list 2 $a1 $a2}
+	    proc z3 {a1 a2 a3} {list 3 $a1 $a2 $a3}
+	    namespace export z*
+	    namespace ensemble create
+	}
+	namespace ensemble create -parameters p
+    }
+} -body {
+    set result {}
+    # In these cases, parsing the subensemble does not grab a new word.
+    lappend result [catch {ns z0 x} msg] $msg
+    lappend result [catch {ns z1 x} msg] $msg
+    lappend result [catch {ns z2 x} msg] $msg
+    lappend result [catch {ns z2 x v} msg] $msg
+    namespace ensemble configure ns::x -parameters q1
+    # In these cases, parsing the subensemble grabs a new word.
+    lappend result [catch {ns v x z0} msg] $msg
+    lappend result [catch {ns v x z1} msg] $msg
+    lappend result [catch {ns v x z2} msg] $msg
+    lappend result [catch {ns v x z2 v2} msg] $msg
+} -cleanup {
+    namespace delete ns
+} -result\
+   {0 0\
+    1 {wrong # args: should be "ns z1 x a1"}\
+    1 {wrong # args: should be "ns z2 x a1 a2"}\
+    1 {wrong # args: should be "ns z2 x a1 a2"}\
+    1 {wrong # args: should be "::ns::x::z0"}\
+    0 {1 v}\
+    1 {wrong # args: should be "ns v x z2 a2"}\
+    0 {2 v v2}}
+
+test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
+-setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+} -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	set ns ::y$i
+	namespace eval $ns {}
+	namespace delete $ns
+	set start $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $start}]
+} -cleanup {
+    rename getbytes {}
+    unset i ns start end
+} -result 0
+
 # cleanup
 catch {rename cmd1 {}}
 catch {unset l}
 catch {unset msg}
 catch {unset trigger}
-namespace delete {expand}[namespace children :: test_ns_*]
+namespace delete {*}[namespace children :: test_ns_*]
 ::tcltest::cleanupTests
 return
 
diff --git a/tests/notify.test b/tests/notify.test
index 0d80132..d2b9123 100755..100644
--- a/tests/notify.test
+++ b/tests/notify.test
@@ -12,14 +12,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: notify.test,v 1.3 2003/10/06 14:32:22 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testevent [llength [info commands testevent]]
 
 test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \
diff --git a/tests/nre.test b/tests/nre.test
new file mode 100644
index 0000000..b5eb032
--- /dev/null
+++ b/tests/nre.test
@@ -0,0 +1,426 @@
+# Commands covered:  proc, apply, [interp alias], [namespce import]
+#
+# This file contains a collection of tests for the non-recursive executor that
+# avoids recursive calls to TEBC. Only the NRE behaviour is tested here, the
+# actual command functionality is tested in the specific test file.
+#
+# Copyright (c) 2008 by Miguel Sofer.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testnrelevels [llength [info commands testnrelevels]]
+
+#
+# The tests that risked blowing the C stack on failure have been removed: we
+# can now actually measure using testnrelevels.
+#
+
+if {[testConstraint testnrelevels]} {
+    namespace eval testnre {
+	namespace path ::tcl::mathop
+	#
+	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
+	# cmdFrame level, callFrame level, tosPtr and callback depth 
+	#
+	variable last [testnrelevels] 
+	proc depthDiff {} {
+	    variable last
+	    set depth [testnrelevels]
+	    set res {}
+	    foreach t $depth l $last {
+		lappend res [expr {$t-$l}]
+	    }
+	    set last $depth
+	    return $res
+	}
+	proc setabs {} {
+	    variable abs [- [lindex [testnrelevels] 0]]
+	}
+
+	variable body0 {
+	    set x [depthDiff]
+	    if {[incr i] > 10} {
+		namespace upvar [namespace qualifiers \
+			[namespace origin depthDiff]] abs abs
+		incr abs [lindex [testnrelevels] 0]
+		return [list [lrange $x 0 3] $abs]
+	    }
+	}
+	proc makebody txt {
+	    variable body0
+	    return "$body0; $txt"
+	}
+	namespace export *
+    }
+    namespace import testnre::*
+}
+
+test nre-1.1 {self-recursive procs} -setup {
+    proc a i [makebody {a $i}]
+} -body {
+    setabs
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-1.2 {self-recursive lambdas} -setup {
+    set a [list i [makebody {apply $::a $i}]]
+} -body {
+    setabs
+    apply $a 0
+} -cleanup {
+    unset a
+} -constraints {
+    testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-1.3 {mutually recursive procs and lambdas} -setup {
+    proc a i {
+	apply $::b [incr i]
+    }
+    set b [list i [makebody {a $i}]]
+} -body {
+    setabs
+    a 0
+} -cleanup {
+    rename a {}
+    unset b
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 2} 0}
+
+#
+# Test that aliases are non-recursive
+#
+
+test nre-2.1 {alias is not recursive} -setup {
+    proc a i [makebody {b $i}]
+    interp alias {} b {} a
+} -body {
+    setabs
+    a 0
+} -cleanup {
+    rename a {}
+    rename b {}
+} -constraints {
+    testnrelevels
+} -result {{0 2 1 1} 0}
+
+#
+# Test that imports are non-recursive
+#
+
+test nre-3.1 {imports are not recursive} -setup {
+    namespace eval foo {
+	setabs
+	namespace export a
+    }
+    proc foo::a i [makebody {::a $i}]
+    namespace import foo::a
+} -body {
+    a 0
+} -cleanup {
+    rename a {}
+    namespace delete ::foo
+} -constraints {
+    testnrelevels
+} -result {{0 2 1 1} 0}
+
+test nre-4.1 {ensembles are not recursive} -setup {
+    proc a i [makebody {b foo $i}]
+    namespace ensemble create \
+	-command b \
+	-map [list foo a]
+} -body {
+    setabs
+    a 0
+} -cleanup {
+    rename a {}
+    rename b {}
+} -constraints {
+    testnrelevels
+} -result {{0 2 1 1} 0}
+
+test nre-5.1 {[namespace eval] is not recursive} -setup {
+    namespace eval ::foo {
+	setabs
+    }
+    proc foo::a i [makebody {namespace eval ::foo [list a $i]}]
+} -body {
+    ::foo::a 0
+} -cleanup {
+    namespace delete ::foo
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 2} 0}
+test nre-5.2 {[namespace eval] is not recursive} -setup {
+    namespace eval ::foo {
+	setabs
+    }
+    proc foo::a i [makebody {namespace eval ::foo "set x $i; a $i"}]
+} -body {
+    foo::a 0
+} -cleanup {
+    namespace delete ::foo
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 2} 0}
+
+test nre-6.1 {[uplevel] is not recursive} -setup {
+    proc a i [makebody {uplevel 1 [list a $i]}]
+} -body {
+    setabs
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 0} 0}
+test nre-6.2 {[uplevel] is not recursive} -setup {
+    setabs
+    proc a i [makebody {uplevel 1 "set x $i; a $i"}]
+} -body {
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 0} 0}
+
+test nre-7.1 {[catch] is not recursive} -setup {
+    setabs
+    proc a i [makebody {uplevel 1 "catch {a $i} msg; set msg"}]
+} -body {
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 3 3 0} 0}
+test nre-7.2 {[if] is not recursive} -setup {
+    setabs
+    proc a i [makebody {uplevel 1 "if 1 {a $i}"}]
+} -body {
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 0} 0}
+test nre-7.3 {[while] is not recursive} -setup {
+    setabs
+    proc a i [makebody {uplevel 1 "while 1 {set res \[a $i\]; break}; set res"}]
+} -body {
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 0} 0}
+test nre-7.4 {[for] is not recursive} -setup {
+    setabs
+    proc a i [makebody {uplevel 1 "for {set j 0} {\$j < 10} {incr j} {set res \[a $i\]; break}; set res"}]
+} -body {
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 0} 0}
+test nre-7.5 {[foreach] is not recursive} -setup {
+    #
+    # Enable once [foreach] is NR-enabled
+    #
+    setabs
+    proc a i [makebody {uplevel 1 "foreach j {1 2 3 4 5 6} {set res \[a $i\]; break}; set res"}]
+} -body {
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 3 3 0} 0}
+test nre-7.6 {[eval] is not recursive} -setup {
+    proc a i [makebody {eval [list a $i]}]
+} -body {
+    setabs
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 1} 0}
+test nre-7.7 {[eval] is not recursive} -setup {
+    proc a i [makebody {eval "a $i"}]
+} -body {
+    setabs
+    a 0
+} -cleanup {
+    rename a {}
+} -constraints {
+    testnrelevels
+} -result {{0 2 2 1} 0}
+test nre-7.8 {bug #2910748: switch out of stale BC is not nre-aware} -setup {
+    proc foo args {}
+    foo
+    coroutine bar apply {{} {
+	yield
+	proc foo args {return ok}
+	while 1 {
+	    yield [incr i]
+	    foo
+	}
+    }}
+} -body {
+    # if switching to plain eval is not nre aware, this will cause a "cannot
+    # yield" error
+    list [bar] [bar] [bar]
+} -cleanup {
+    rename bar {}
+    rename foo {}
+} -result {1 2 3}
+
+test nre-8.1 {nre and {*}} -body {
+    # force an expansion that grows the evaluation stack, check that nre
+    # adapts the TEBCdataPtr. This crashes on failure.
+    proc inner {} {
+	set long [lrepeat 1000000 1]
+	list {*}$long
+    }
+    proc outer {} inner
+    lrange [outer] 0 2
+} -cleanup {
+    rename inner {}
+    rename outer {}
+} -result {1 1 1} 
+test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
+    # force an expansion that grows the evaluation stack, check that nre
+    # adapts the bcFramePtr. This causes an NRE assertion to fail if it is not
+    # done properly.
+    proc nop {} {}
+    proc crash {} {
+	foreach val [list {*}[lrepeat 100000 x]] {
+	    nop
+	}
+    }
+    crash
+} -cleanup {
+    rename nop {}
+    rename crash {}
+}
+
+#
+#  Basic TclOO tests
+#
+
+test nre-oo.1 {really deep calls in oo - direct} -setup {
+    oo::object create foo
+    oo::objdefine foo method bar i [makebody {foo bar $i}]
+} -body {
+    setabs
+    foo bar 0
+} -cleanup {
+    foo destroy
+} -constraints {
+    testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-oo.2 {really deep calls in oo - call via [self]} -setup {
+    oo::object create foo
+    oo::objdefine foo method bar i [makebody {[self] bar $i}]
+} -body {
+    setabs
+    foo bar 0
+} -cleanup {
+    foo destroy
+} -constraints {
+    testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-oo.3 {really deep calls in oo - private calls} -setup {
+    oo::object create foo
+    oo::objdefine foo method bar i [makebody {my bar $i}]
+} -body {
+    setabs
+    foo bar 0
+} -cleanup {
+    foo destroy
+} -constraints {
+    testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-oo.4 {really deep calls in oo - overriding} -setup {
+    oo::class create foo {
+	method bar i [makebody {my bar $i}]
+    }
+    oo::class create boo {
+	superclass foo
+	method bar i [makebody {next $i}]
+    }
+} -body {
+    setabs
+    [boo new] bar 0
+} -cleanup {
+    foo destroy
+} -constraints {
+    testnrelevels
+} -result {{0 1 1 1} 0}
+test nre-oo.5 {really deep calls in oo - forwards} -setup {
+    oo::object create foo
+    set body [makebody {my boo $i}]
+    oo::objdefine foo "
+	method bar i {$body}
+	forward boo ::foo bar
+    "
+} -body {
+    setabs
+    foo bar 0
+} -cleanup {
+    foo destroy
+} -constraints {
+    testnrelevels
+} -result {{0 2 1 1} 0}
+
+#
+# NASTY BUG found by tcllib's interp package
+#
+
+test nre-X.1 {eval in wrong interp} -setup {
+    set i [interp create]
+    $i eval {proc filter lst {lsearch -all -inline -not $lst "::tcl"}}
+} -body {
+    $i eval {
+	set x {namespace children ::}
+	set y [list namespace children ::]
+	namespace delete {*}[filter [{*}$y]]
+	set j [interp create]
+	$j alias filter filter
+	$j eval {namespace delete {*}[filter [namespace children ::]]}
+	namespace eval foo {}
+	list [filter [eval $x]] [filter [eval $y]] [filter [$j eval $x]] [filter [$j eval $y]]
+    }
+} -cleanup {
+    interp delete $i
+} -result {::foo ::foo {} {}}
+
+# cleanup
+::tcltest::cleanupTests
+
+if {[testConstraint testnrelevels]} {
+    namespace forget testnre::*
+    namespace delete testnre
+}
+
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/obj.test b/tests/obj.test
index e905698..151abfb 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -10,14 +10,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: obj.test,v 1.18 2005/07/28 18:42:32 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testobj [llength [info commands testobj]]
 testConstraint longIs32bit	[expr {int(0x80000000) < 0}]
 testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
@@ -26,18 +27,13 @@ test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} tes
     set r 1
     foreach {t} {
 	{array search} 
-	bignum
 	bytearray
 	bytecode
 	cmdName
 	dict
-	double
 	end-offset
-	int
-	nsName
 	regexp
 	string
-	wideInt
     } {
         set first [string first $t [testobj types]]
         set r [expr {$r && ($first != -1)}]
@@ -52,17 +48,19 @@ test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj {
     set result ""
     lappend result [testobj freeallvars]
     lappend result [testintobj set 1 12]
-    lappend result [testobj convert 1 double]
+    lappend result [testobj convert 1 bytearray]
     lappend result [testobj type 1]
     lappend result [testobj refcount 1]
-} {{} 12 12 double 3}
+} {{} 12 12 bytearray 3}
 
 test obj-3.1 {Tcl_ConvertToType error} testobj {
-    list [testdoubleobj set 1 12.34] [catch {testobj convert 1 int} msg] $msg
-} {12.34 1 {expected integer but got "12.34"}}
+    list [testdoubleobj set 1 12.34] \
+	[catch {testobj convert 1 end-offset} msg] \
+	 $msg
+} {12.34 1 {bad index "12.34": must be end?[+-]integer?}}
 test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj {
-    list [testobj newobj 1] [catch {testobj convert 1 int} msg] $msg
-} {{} 1 {expected integer but got ""}}
+    list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg
+} {{} 1 {bad index "": must be end?[+-]integer?}}
 
 test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
     set result ""
@@ -607,7 +605,7 @@ test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
     set x 0xffff; append x ffff
     list [string is integer $x] [expr { wide($x) }]
 } {1 4294967295}
-test obj-33.3 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.3 {integer overflow on input} {
     set x 0x10000; append x 0000
     list [string is integer $x] [expr { wide($x) }]
 } {0 4294967296}
@@ -623,7 +621,7 @@ test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
     set x -0xffff; append x ffff
     list [string is integer $x] [expr { wide($x) }]
 } {1 -4294967295}
-test obj-33.7 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.7 {integer overflow on input} {
     set x -0x10000; append x 0000
     list [string is integer $x] [expr { wide($x) }]
 } {0 -4294967296}
diff --git a/tests/oo.test b/tests/oo.test
new file mode 100644
index 0000000..d63e931
--- /dev/null
+++ b/tests/oo.test
@@ -0,0 +1,3512 @@
+# This file contains a collection of tests for Tcl's built-in object system.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 2006-2013 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require TclOO 1.0.1
+package require tcltest 2
+if {"::tcltest" in [namespace children]} {
+    namespace import -force ::tcltest::*
+}
+
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
+
+test oo-0.1 {basic test of OO's ability to clean up its initial state} {
+    interp create t
+    t eval {
+	package require TclOO
+    }
+    interp delete t
+} {}
+test oo-0.2 {basic test of OO's ability to clean up its initial state} {
+    set i [interp create]
+    interp eval $i {
+	package require TclOO
+	namespace delete ::
+    }
+    interp delete $i
+} {}
+test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
+    leaktest {
+	[oo::object new] destroy
+    }
+} -constraints memory -result 0
+test oo-0.4 {basic test of OO's ability to clean up its initial state} -body {
+    leaktest {
+	oo::class create foo
+	foo new
+	foo destroy
+    }
+} -constraints memory -result 0
+test oo-0.5 {testing literal leak on interp delete} memory {
+    leaktest {
+	interp create foo
+	foo eval {oo::object new}
+	interp delete foo
+    }
+} 0
+test oo-0.6 {cleaning the core class pair; way #1} -setup {
+    interp create t
+} -body {
+    t eval {
+	package require TclOO
+	namespace path oo
+	list [catch {class destroy} m] $m [catch {object destroy} m] $m
+    }
+} -cleanup {
+    interp delete t
+} -result {0 {} 1 {invalid command name "object"}}
+test oo-0.7 {cleaning the core class pair; way #2} -setup {
+    interp create t
+} -body {
+    t eval {
+	package require TclOO
+	namespace path oo
+	list [catch {object destroy} m] $m [catch {class destroy} m] $m
+    }
+} -cleanup {
+    interp delete t
+} -result {0 {} 1 {invalid command name "class"}}
+test oo-0.8 {leak in variable management} -setup {
+    oo::class create foo
+} -constraints memory -body {
+    oo::define foo {
+	constructor {} {
+	    variable v 0
+	}
+    }
+    leaktest {[foo new] destroy}
+} -cleanup {
+    foo destroy
+} -result 0
+test oo-0.9 {various types of presence of the TclOO package} {
+    list [lsearch -nocase -all -inline [package names] tcloo] \
+	[package present TclOO] [package versions TclOO]
+} [list TclOO $::oo::patchlevel $::oo::patchlevel]
+
+test oo-1.1 {basic test of OO functionality: no classes} {
+    set result {}
+    lappend result [oo::object create foo]
+    lappend result [oo::objdefine foo {
+	method bar args {
+	    global result
+	    lappend result {*}$args
+	    return [llength $args]
+	}
+    }]
+    lappend result [foo bar a b c]
+    lappend result [foo destroy] [info commands foo]
+} {::foo {} a b c 3 {} {}}
+test oo-1.2 {basic test of OO functionality: no classes} -body {
+    oo::define oo::object method missingArgs
+} -returnCodes 1 -result "wrong # args: should be \"oo::define oo::object method name args body\""
+test oo-1.3 {basic test of OO functionality: no classes} {
+    catch {oo::define oo::object method missingArgs}
+    set errorInfo
+} "wrong # args: should be \"oo::define oo::object method name args body\"
+    while executing
+\"oo::define oo::object method missingArgs\""
+test oo-1.4 {basic test of OO functionality} -body {
+    oo::object create {}
+} -returnCodes 1 -result {object name must not be empty}
+test oo-1.5 {basic test of OO functionality} -body {
+    oo::object doesnotexist
+} -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new}
+test oo-1.5.1 {basic test of OO functionality} -setup {
+    oo::object create aninstance
+} -returnCodes error -body {
+    aninstance
+} -cleanup {
+    rename aninstance {}
+} -result {wrong # args: should be "aninstance method ?arg ...?"}
+test oo-1.6 {basic test of OO functionality} -setup {
+    oo::object create aninstance
+} -body {
+    oo::objdefine aninstance unexport destroy
+    aninstance doesnotexist
+} -cleanup {
+    rename aninstance {}
+} -returnCodes 1 -result {object "::aninstance" has no visible methods}
+test oo-1.7 {basic test of OO functionality} -setup {
+    oo::object create aninstance
+} -body {
+    oo::objdefine aninstance {
+	# Do not do this in real code! Ever! This is *not* supported!
+	::oo::define::method ha ha ha
+    }
+} -returnCodes error -cleanup {
+    aninstance destroy
+} -result {attempt to misuse API}
+test oo-1.8 {basic test of OO functionality} -setup {
+    oo::object create obj
+    set result {}
+} -cleanup {
+    obj destroy
+} -body {
+    oo::objdefine obj method foo {} {return bar}
+    lappend result [obj foo]
+    oo::objdefine obj method foo {} {}
+    lappend result [obj foo]
+} -result {bar {}}
+test oo-1.9 {basic test of OO functionality} -setup {
+    oo::object create a
+    oo::object create b
+} -cleanup {
+    catch {a destroy}
+    b destroy
+} -body {
+    oo::objdefine a method foo {} { return A }
+    oo::objdefine b method foo {} { return B }
+    apply {{} {
+	set m foo
+	return [a $m],[a destroy],[b $m]
+    }}
+} -result A,,B
+test oo-1.10 {basic test of OO functionality} -body {
+    namespace eval foo {
+	namespace eval bar {
+	    oo::object create o
+	    namespace export o
+	}
+	namespace import bar::o
+    }
+    list [info object isa object foo::bar::o] [info object isa object foo::o]
+} -cleanup {
+    namespace delete foo
+} -result {1 1}
+test oo-1.11 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c super oo::class
+    info class super c
+} -result ::oo::class
+test oo-1.12 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c {super oo::class}
+    info class super c
+} -result ::oo::class
+test oo-1.13 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c self {forw a b}
+    info object forw c a
+} -result b
+test oo-1.14 {basic test of OO functionality: abbreviating} -setup {
+    oo::class create c
+} -cleanup {
+    c destroy
+} -body {
+    oo::define c self forw a b
+    info object forw c a
+} -result b
+test oo-1.15 {basic test of OO functionality: abbreviating} -setup {
+    oo::object create o
+} -cleanup {
+    o destroy
+} -body {
+    oo::objdefine o {forw a b}
+    info object forw o a
+} -result b
+test oo-1.16 {basic test of OO functionality: abbreviating} -setup {
+    oo::object create o
+} -cleanup {
+    o destroy
+} -body {
+    oo::objdefine o forw a b
+    info object forw o a
+} -result b
+test oo-1.17 {basic test of OO functionality: Bug 2481109} -body {
+    namespace eval ::foo {oo::object create lreplace}
+} -cleanup {
+    namespace delete ::foo
+} -result ::foo::lreplace
+# Check for Bug 2519474; problem in tclNamesp.c, but tested here...
+test oo-1.18 {OO: create object in NS with same name as global cmd} -setup {
+    proc test-oo-1.18 {} return
+    oo::class create A
+    oo::class create B {superclass A}
+} -body {
+    oo::define B constructor {} {A create test-oo-1.18}
+    B create C
+} -cleanup {
+    rename test-oo-1.18 {}
+    A destroy
+} -result ::C
+test oo-1.19 {basic test of OO functionality: teardown order} -body {
+    oo::object create o
+    namespace delete [info object namespace o]
+    o destroy
+    # Crashes on error
+} -returnCodes error -result {invalid command name "o"}
+test oo-1.20 {basic test of OO functionality: my teardown post rename} -body {
+    oo::object create obj
+    rename [info object namespace obj]::my ::AGlobalName
+    obj destroy
+    info commands ::AGlobalName
+} -result {}
+
+test oo-2.1 {basic test of OO functionality: constructor} -setup {
+    # This is a bit complex because it needs to run in a sub-interp as
+    # we're modifying the root object class's constructor
+    interp create subinterp
+    subinterp eval {
+	package require TclOO
+    }
+} -body {
+    subinterp eval {
+	oo::define oo::object constructor {} {
+	    lappend ::result [info level 0]
+	}
+	lappend result 1
+	lappend result 2 [oo::object create foo]
+    }
+} -cleanup {
+    interp delete subinterp
+} -result {1 {oo::object create foo} 2 ::foo}
+test oo-2.2 {basic test of OO functionality: constructor} {
+    oo::class create testClass {
+	constructor {} {
+	    global result
+	    lappend result "[self]->construct"
+	}
+	method bar {} {
+	    global result
+	    lappend result "[self]->bar"
+	}
+    }
+    set result {}
+    [testClass create foo] bar
+    testClass destroy
+    return $result
+} {::foo->construct ::foo->bar}
+test oo-2.4 {OO constructor - Bug 2531577} -setup {
+    oo::class create foo
+} -body {
+    oo::define foo constructor {} return
+    [foo new] destroy
+    oo::define foo constructor {} {}
+    llength [info command [foo new]]
+} -cleanup {
+    foo destroy
+} -result 1
+test oo-2.5 {OO constructor - Bug 2531577} -setup {
+    oo::class create foo
+    set result {}
+} -body {
+    oo::define foo constructor {} {error x}
+    lappend result [catch {foo new}]
+    oo::define foo constructor {} {}
+    lappend result [llength [info command [foo new]]]
+} -cleanup {
+    foo destroy
+} -result {1 1}
+test oo-2.6 {OO constructor and tailcall - Bug 2414858} -setup {
+    oo::class create foo
+} -body {
+    oo::define foo {
+	constructor {} { tailcall my bar }
+	method bar {}  { return bad }
+    }
+    namespace tail [foo create good]
+} -cleanup {
+    foo destroy
+} -result good
+test oo-2.7 {construction, method calls and ensembles - Bug 3514761} -setup {
+    namespace eval k {}
+} -body {
+    namespace eval k {
+	oo::class create s {
+	    constructor {j} {
+		# nothing
+	    }
+	}
+	namespace export s
+	namespace ensemble create
+    }
+    k s create X
+} -returnCodes error -cleanup {
+    namespace delete k
+} -result {wrong # args: should be "k s create X j"}
+test oo-2.8 {construction, method calls and ensembles - Bug 3514761} -setup {
+    namespace eval k {}
+} -body {
+    namespace eval k {
+	oo::class create s {
+	    constructor {j} {
+		# nothing
+	    }
+	}
+	oo::class create t {
+	    superclass s
+	    constructor args {
+		k next {*}$args
+	    }
+	}
+	interp alias {} ::k::next {} ::oo::Helpers::next
+	namespace export t next
+	namespace ensemble create
+    }
+    k t create X
+} -returnCodes error -cleanup {
+    namespace delete k
+} -result {wrong # args: should be "k next j"}
+
+test oo-3.1 {basic test of OO functionality: destructor} -setup {
+    # This is a bit complex because it needs to run in a sub-interp as we're
+    # modifying the root object class's constructor
+    interp create subinterp
+    subinterp eval {
+	package require TclOO
+    }
+} -body {
+    subinterp eval {
+	oo::define oo::object destructor {
+	    lappend ::result died
+	}
+	lappend result 1 [oo::object create foo]
+	lappend result 2 [rename foo {}]
+	oo::define oo::object destructor {}
+	return $result
+    }
+} -cleanup {
+    interp delete subinterp
+} -result {1 ::foo died 2 {}}
+test oo-3.2 {basic test of OO functionality: destructor} -setup {
+    # This is a bit complex because it needs to run in a sub-interp as
+    # we're modifying the root object class's constructor
+    interp create subinterp
+    subinterp eval {
+	package require TclOO
+    }
+} -body {
+    subinterp eval {
+	oo::define oo::object destructor {
+	    lappend ::result died
+	}
+	lappend result 1 [oo::object create foo]
+	lappend result 2 [rename foo {}]
+    }
+} -cleanup {
+    interp delete subinterp
+} -result {1 ::foo died 2 {}}
+test oo-3.3 {basic test of OO functionality: destructor} -setup {
+    oo::class create foo
+    set result {}
+} -cleanup {
+    foo destroy
+} -body {
+    oo::define foo {
+	constructor {} {lappend ::result made}
+	destructor {lappend ::result died}
+    }
+    namespace delete [info object namespace [foo new]]
+    return $result
+} -result {made died}
+test oo-3.4 {basic test of OO functionality: my exists in destructor} -setup {
+    oo::class create cls
+    set result {}
+} -cleanup {
+    cls destroy
+} -body {
+    oo::define cls {
+	variable state
+	constructor {} {
+	    proc localcmdexists {} {}
+	    set state ok
+	}
+	forward Report lappend ::result
+	destructor {
+	    objmy Report [catch {set state} msg] $msg
+	    objmy Report [namespace which -var state]
+	    objmy Report [info commands localcmdexists]
+	}
+    }
+    cls create obj
+    rename [info object namespace obj]::my ::objmy
+    obj destroy
+    lappend result [info commands ::objmy]
+} -match glob -result {0 ok *::state localcmdexists {}}
+test oo-3.4a {basic test of OO functionality: my exists in destructor} -setup {
+    oo::class create cls
+    set result {}
+} -cleanup {
+    cls destroy
+} -body {
+    oo::define cls {
+	variable state
+	constructor {} {
+	    proc localcmdexists {} {}
+	    set state ok
+	}
+	forward Report lappend ::result
+	destructor {
+	    objmy Report [catch {set state} msg] $msg
+	    objmy Report [namespace which -var state]
+	    objmy Report [info commands localcmdexists]
+	}
+    }
+    cls create obj
+    rename [info object namespace obj]::my ::objmy
+    rename obj {}
+    lappend result [info commands ::objmy]
+} -match glob -result {0 ok *::state localcmdexists {}}
+test oo-3.5 {basic test of OO functionality: destructor: evil case for Itcl} -setup {
+    oo::class create cls
+    set result {}
+} -cleanup {
+    cls destroy
+} -body {
+    oo::define cls {
+	variable state
+	constructor {} {
+	    proc localcmdexists {} {}
+	    set state ok
+	}
+	forward Report lappend ::result
+	destructor {
+	    objmy Report [catch {set state} msg] $msg
+	    objmy Report [namespace which -var state]
+	    objmy Report [info commands localcmdexists]
+	}
+    }
+    cls create obj
+    rename [info object namespace obj]::my ::objmy
+    namespace delete [info object namespace obj]
+    lappend result [info commands ::objmy]
+} -match glob -result {0 ok *::state localcmdexists {}}
+test oo-3.5a {basic test of OO functionality: destructor: evil case for Itcl} -setup {
+    oo::class create cls
+    set result {}
+} -cleanup {
+    cls destroy
+} -body {
+    oo::define cls {
+	variable state result
+	constructor {} {
+	    proc localcmdexists {} {}
+	    set state ok
+	    my eval {upvar 0 ::result result}
+	}
+	method nuke {} {
+	    namespace delete [namespace current]
+	    return $result
+	}
+	destructor {
+	    lappend result [self] $state [info commands localcmdexists]
+	}
+    }
+    cls create obj
+    namespace delete [info object namespace obj]
+    [cls create obj2] nuke
+} -match glob -result {::obj ok localcmdexists ::obj2 ok localcmdexists}
+test oo-3.6 {basic test of OO functionality: errors in destructor} -setup {
+    oo::class create cls
+} -cleanup {
+    cls destroy
+} -body {
+    oo::define cls destructor {error foo}
+    list [catch {[cls create obj] destroy} msg] $msg [info commands obj]
+} -result {1 foo {}}
+test oo-3.7 {basic test of OO functionality: errors in destructor} -setup {
+    oo::class create cls
+    set result {}
+    proc bgerror msg {lappend ::result $msg}
+} -cleanup {
+    cls destroy
+    rename bgerror {}
+} -body {
+    oo::define cls destructor {error foo}
+    list [rename [cls create obj] {}] \
+	[update idletasks] $result [info commands obj]
+} -result {{} {} foo {}}
+test oo-3.8 {basic test of OO functionality: errors in destructor} -setup {
+    oo::class create cls
+    set result {}
+    proc bgerror msg {lappend ::result $msg}
+} -cleanup {
+    cls destroy
+    rename bgerror {}
+} -body {
+    oo::define cls destructor {error foo}
+    list [namespace delete [info object namespace [cls create obj]]] \
+	[update idletasks] $result [info commands obj]
+} -result {{} {} foo {}}
+test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup {
+    oo::class create cls
+    set result {}
+} -body {
+    oo::define cls {
+	destructor {
+	    lappend ::result in destructor
+	    [self] destroy
+	}
+    }
+    # This used to crash
+    [cls new] destroy
+    return $result
+} -cleanup {
+    cls destroy
+} -result {in destructor}
+
+test oo-4.1 {basic test of OO functionality: export} {
+    set o [oo::object new]
+    set result {}
+    oo::objdefine $o method Foo {} {lappend ::result Foo; return}
+    lappend result [catch {$o Foo} msg] $msg
+    oo::objdefine $o export Foo
+    lappend result [$o Foo] [$o destroy]
+} {1 {unknown method "Foo": must be destroy} Foo {} {}}
+test oo-4.2 {basic test of OO functionality: unexport} {
+    set o [oo::object new]
+    set result {}
+    oo::objdefine $o method foo {} {lappend ::result foo; return}
+    lappend result [$o foo]
+    oo::objdefine $o unexport foo
+    lappend result [catch {$o foo} msg] $msg [$o destroy]
+} {foo {} 1 {unknown method "foo": must be destroy} {}}
+test oo-4.3 {exporting and error messages, Bug 1824958} -setup {
+    oo::class create testClass
+} -cleanup {
+    testClass destroy
+} -body {
+    oo::define testClass self export Bad
+    testClass Bad
+} -returnCodes 1 -result {unknown method "Bad": must be create, destroy or new}
+test oo-4.4 {exporting a class method from an object} -setup {
+    oo::class create testClass
+    testClass create testObject
+} -cleanup {
+    testClass destroy
+} -body {
+    oo::define testClass method Good {} { return ok }
+    oo::objdefine testObject export Good
+    testObject Good
+} -result ok
+test oo-4.5 {export creates proper method entries} -setup {
+    oo::class create testClass
+} -body {
+    oo::define testClass {
+	export foo
+	method foo {} {return ok}
+    }
+    [testClass new] foo
+} -cleanup {
+    testClass destroy
+} -result ok
+test oo-4.6 {export creates proper method entries} -setup {
+    oo::class create testClass
+} -body {
+    oo::define testClass {
+	unexport foo
+	method foo {} {return ok}
+    }
+    [testClass new] foo
+} -cleanup {
+    testClass destroy
+} -result ok
+
+test oo-5.1 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::objdefine oo::object method foo {} { return "in object" }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.2 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::define oo::object self method foo {} { return "in object" }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.3 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::objdefine oo::object {
+	method foo {} { return "in object" }
+    }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.4 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::define oo::object {
+	self method foo {} { return "in object" }
+    }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+test oo-5.5 {OO: manipulation of classes as objects} -setup {
+    set obj [oo::object new]
+} -body {
+    oo::define oo::object {
+	self {
+	    method foo {} { return "in object" }
+	}
+    }
+    catch {$obj foo} result
+    list [catch {$obj foo} result] $result [oo::object foo]
+} -cleanup {
+    oo::objdefine oo::object deletemethod foo
+    $obj destroy
+} -result {1 {unknown method "foo": must be destroy} {in object}}
+
+test oo-6.1 {OO: forward} {
+    oo::object create foo
+    oo::objdefine foo {
+	forward a lappend
+	forward b lappend result
+    }
+    set result {}
+    foo a result 1
+    foo b 2
+    foo destroy
+    return $result
+} {1 2}
+test oo-6.2 {OO: forward resolution scope} -setup {
+    oo::class create fooClass
+} -body {
+    proc foo {} {return bad}
+    oo::define fooClass {
+	constructor {} {
+	    proc foo {} {return good}
+	}
+	forward bar foo
+    }
+    [fooClass new] bar
+} -cleanup {
+    fooClass destroy
+    rename foo {}
+} -result good
+test oo-6.3 {OO: forward resolution scope} -setup {
+    oo::class create fooClass
+} -body {
+    proc foo {} {return bad}
+    oo::define fooClass {
+	constructor {} {
+	    proc foo {} {return good}
+	}
+    }
+    oo::define fooClass forward bar foo
+    [fooClass new] bar
+} -cleanup {
+    fooClass destroy
+    rename foo {}
+} -result good
+test oo-6.4 {OO: forward resolution scope} -setup {
+    oo::class create fooClass
+} -body {
+    proc foo {} {return good}
+    oo::define fooClass {
+	constructor {} {
+	    proc foo {} {return bad}
+	}
+	forward bar ::foo
+    }
+    [fooClass new] bar
+} -cleanup {
+    fooClass destroy
+    rename foo {}
+} -result good
+test oo-6.5 {OO: forward resolution scope} -setup {
+    oo::class create fooClass
+    namespace eval foo {}
+} -body {
+    proc foo::foo {} {return good}
+    oo::define fooClass {
+	constructor {} {
+	    proc foo {} {return bad}
+	}
+	forward bar foo::foo
+    }
+    [fooClass new] bar
+} -cleanup {
+    fooClass destroy
+    namespace delete foo
+} -result good
+test oo-6.6 {OO: forward resolution scope} -setup {
+    oo::class create fooClass
+    namespace eval foo {}
+} -body {
+    proc foo::foo {} {return bad}
+    oo::define fooClass {
+	constructor {} {
+	    namespace eval foo {
+		proc foo {} {return good}
+	    }
+	}
+	forward bar foo::foo
+    }
+    [fooClass new] bar
+} -cleanup {
+    fooClass destroy
+    namespace delete foo
+} -result good
+test oo-6.7 {OO: forward resolution scope is per-object} -setup {
+    oo::class create fooClass
+} -body {
+    oo::define fooClass {
+	constructor {} {
+	    proc curns {} {namespace current}
+	}
+	forward ns curns
+    }
+    expr {[[fooClass new] ns] ne [[fooClass new] ns]}
+} -cleanup {
+    fooClass destroy
+} -result 1
+test oo-6.8 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+    oo::class create fooClass
+} -body {
+    oo::define fooClass {
+	forward test my handler
+	method handler {a b c} {}
+    }
+    fooClass create ::foo
+    foo test
+} -returnCodes error -cleanup {
+    fooClass destroy
+} -result {wrong # args: should be "foo test a b c"}
+test oo-6.9 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+    oo::class create fooClass
+} -body {
+    oo::define fooClass {
+	forward test my handler
+	method handler {a b c} {list $a,$b,$c}
+    }
+    fooClass create ::foo
+    foo test 1 2 3
+} -cleanup {
+    fooClass destroy
+} -result 1,2,3
+test oo-6.10 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+    oo::class create fooClass
+} -body {
+    oo::define fooClass {
+	forward test my handler
+	method handler {a b c} {list $a,$b,$c}
+    }
+    fooClass create ::foo
+    foo test 1 2
+} -returnCodes error -cleanup {
+    fooClass destroy
+} -result {wrong # args: should be "foo test a b c"}
+test oo-6.11 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo {
+	forward test my handler
+	method handler {a b c} {}
+    }
+    foo test
+} -returnCodes error -cleanup {
+    foo destroy
+} -result {wrong # args: should be "foo test a b c"}
+test oo-6.12 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo {
+	forward test my handler
+	method handler {a b c} {list $a,$b,$c}
+    }
+    foo test 1 2 3
+} -cleanup {
+    foo destroy
+} -result 1,2,3
+test oo-6.13 {Bug 3400658: forwarding and wrongargs rewriting} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo {
+	forward test my handler
+	method handler {a b c} {list $a,$b,$c}
+    }
+    foo test 1 2
+} -returnCodes error -cleanup {
+    foo destroy
+} -result {wrong # args: should be "foo test a b c"}
+test oo-6.14 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup {
+    oo::class create fooClass
+} -body {
+    oo::define fooClass {
+	forward test my handler1 p
+	forward handler1 my handler q
+	method handler {a b c} {}
+    }
+    fooClass create ::foo
+    foo test
+} -returnCodes error -cleanup {
+    fooClass destroy
+} -result {wrong # args: should be "foo test c"}
+test oo-6.15 {Bug 3400658: forwarding and wrongargs rewriting - multistep} -setup {
+    oo::class create fooClass
+} -body {
+    oo::define fooClass {
+	forward test my handler1 p
+	forward handler1 my handler q
+	method handler {a b c} {list $a,$b,$c}
+    }
+    fooClass create ::foo
+    foo test 1
+} -cleanup {
+    fooClass destroy
+} -result q,p,1
+test oo-6.16 {Bug 3400658: forwarding and wrongargs rewriting - via alias} -setup {
+    oo::class create fooClass
+} -body {
+    oo::define fooClass {
+	forward test handler1 foo bar
+	forward handler2 my handler x
+	method handler {a b c d} {list $a,$b,$c,$d}
+	export eval
+    }
+    fooClass create ::foo
+    foo eval {
+	interp alias {} [namespace current]::handler1 \
+	    {} [namespace current]::my handler2
+    }
+    foo test 1 2 3
+} -returnCodes error -cleanup {
+    fooClass destroy
+} -result {wrong # args: should be "foo test d"}
+test oo-6.17 {Bug 3400658: forwarding and wrongargs rewriting - via ensemble} -setup {
+    oo::class create fooClass
+} -body {
+    oo::define fooClass {
+	forward test handler1 foo bar boo
+	forward handler2 my handler
+	method handler {a b c d} {list $a,$b,$c,$d}
+	export eval
+    }
+    fooClass create ::foo
+    foo eval {
+	namespace ensemble create \
+	    -command [namespace current]::handler1 -parameters {p q} \
+	    -map [list boo [list [namespace current]::my handler2]]
+    }
+    foo test 1 2 3
+} -returnCodes error -cleanup {
+    fooClass destroy
+} -result {wrong # args: should be "foo test c d"}
+test oo-6.18 {Bug 3408830: more forwarding cases} -setup {
+    oo::class create fooClass
+} -body {
+    oo::define fooClass {
+	forward len  string length
+    }
+    [fooClass create foo] len a b
+} -returnCodes error -cleanup {
+    fooClass destroy
+} -result {wrong # args: should be "::foo len string"}
+test oo-6.19 {Bug 3610404: forwarding resolution + traces} -setup {
+    oo::object create foo
+    unset -nocomplain ::result
+    set ::result {}
+} -body {
+    proc ::my {method} {lappend ::result global}
+    oo::objdefine foo {
+	method target {} {lappend ::result instance}
+	forward bar my target
+	method bump {} {
+	    set ns [info object namespace ::foo]
+	    rename ${ns}::my ${ns}::
+	    rename ${ns}:: ${ns}::my
+	}
+    }
+    proc harness {} {
+	foo target
+	foo bar
+	foo target
+    }
+    trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
+    foo target
+    foo bar
+    foo bump
+    foo bar
+    harness
+} -cleanup {
+    catch {rename harness {}}
+    catch {rename ::my {}}
+    foo destroy
+} -result {instance instance instance instance instance instance}
+test oo-6.20 {Bug 3610404: forwarding resolution + traces} -setup {
+    oo::class create fooClass
+    fooClass create foo
+    unset -nocomplain ::result
+    set ::result {}
+} -body {
+    proc ::my {method} {lappend ::result global}
+    oo::define fooClass {
+	method target {} {lappend ::result class}
+	forward bar my target
+	method bump {} {
+	    set ns [info object namespace [self]]
+	    rename ${ns}::my ${ns}::
+	    rename ${ns}:: ${ns}::my
+	}
+    }
+    proc harness {} {
+	foo target
+	foo bar
+	foo target
+    }
+    trace add execution harness enterstep {apply {{cmd args} {foo bump}}}
+    foo target
+    foo bar
+    foo bump
+    foo bar
+    harness
+} -cleanup {
+    catch {rename harness {}}
+    catch {rename ::my {}}
+    fooClass destroy
+} -result {class class class class class class}
+
+test oo-7.1 {OO: inheritance 101} -setup {
+    oo::class create superClass
+    oo::class create subClass
+    subClass create instance
+} -body {
+    oo::define superClass method doit x {lappend ::result $x}
+    oo::define subClass superclass superClass
+    set result [list [catch {subClass doit bad} msg] $msg]
+    instance doit ok
+    return $result
+} -cleanup {
+    subClass destroy
+    superClass destroy
+} -result {1 {unknown method "doit": must be create, destroy or new} ok}
+test oo-7.2 {OO: inheritance 101} -setup {
+    oo::class create superClass
+    oo::class create subClass
+    subClass create instance
+} -body {
+    oo::define superClass method doit x {
+	lappend ::result |$x|
+    }
+    oo::define subClass superclass superClass
+    oo::objdefine instance method doit x {
+	lappend ::result =$x=
+	next [incr x]
+    }
+    set result {}
+    instance doit 1
+    return $result
+} -cleanup {
+    subClass destroy
+    superClass destroy
+} -result {=1= |2|}
+test oo-7.3 {OO: inheritance 101} -setup {
+    oo::class create superClass
+    oo::class create subClass
+    subClass create instance
+} -body {
+    oo::define superClass method doit x {
+	lappend ::result |$x|
+    }
+    oo::define subClass {
+	superclass superClass
+	method doit x {lappend ::result -$x-; next [incr x]}
+    }
+    oo::objdefine instance method doit x {
+	lappend ::result =$x=;
+	next [incr x]
+    }
+    set result {}
+    instance doit 1
+    return $result
+} -cleanup {
+    subClass destroy
+    superClass destroy
+} -result {=1= -2- |3|}
+test oo-7.4 {OO: inheritance from oo::class} -body {
+    oo::class create meta {
+	superclass oo::class
+	self {
+	    unexport create new
+	    method make {x {definitions {}}} {
+		if {![string match ::* $x]} {
+		    set ns [uplevel 1 {::namespace current}]
+		    set x ${ns}::$x
+		}
+		set o [my create $x]
+		lappend ::result "made $o"
+		oo::define $o $definitions
+		return $o
+	    }
+	}
+    }
+    set result [list [catch {meta create foo} msg] $msg]
+    lappend result [meta make classinstance {
+	lappend ::result "in definition script in [namespace current]"
+    }]
+    lappend result [classinstance create instance]
+} -cleanup {
+    catch {classinstance destroy}
+    catch {meta destroy}
+} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
+test oo-7.5 {OO: inheritance from oo::class in the secondary chain} -body {
+    oo::class create other
+    oo::class create meta {
+	superclass other oo::class
+	self {
+	    unexport create new
+	    method make {x {definitions {}}} {
+		if {![string match ::* $x]} {
+		    set ns [uplevel 1 {::namespace current}]
+		    set x ${ns}::$x
+		}
+		set o [my create $x]
+		lappend ::result "made $o"
+		oo::define $o $definitions
+		return $o
+	    }
+	}
+    }
+    set result [list [catch {meta create foo} msg] $msg]
+    lappend result [meta make classinstance {
+	lappend ::result "in definition script in [namespace current]"
+    }]
+    lappend result [classinstance create instance]
+} -cleanup {
+    catch {classinstance destroy}
+    catch {meta destroy}
+    catch {other destroy}
+} -result {1 {unknown method "create": must be destroy or make} {made ::classinstance} {in definition script in ::oo::define} ::classinstance ::instance}
+test oo-7.6 {OO: inheritance 101 - overridden methods should be oblivious} -setup {
+    oo::class create Aclass
+    oo::class create Bclass
+    Bclass create Binstance
+} -body {
+    oo::define Aclass {
+	method incr {var step} {
+	    upvar 1 $var v
+	    ::incr v $step
+	}
+    }
+    oo::define Bclass {
+	superclass Aclass
+	method incr {var {step 1}} {
+	    global result
+	    lappend result $var $step
+	    set r [next $var $step]
+	    lappend result returning:$r
+	    return $r
+	}
+    }
+    set result {}
+    set x 10
+    lappend result x=$x
+    lappend result [Binstance incr x]
+    lappend result x=$x
+} -result {x=10 x 1 returning:11 11 x=11} -cleanup {
+    unset -nocomplain x
+    Aclass destroy
+}
+test oo-7.7 {OO: inheritance and errorInfo} -setup {
+    oo::class create A
+    oo::class create B
+    B create c
+} -body {
+    oo::define A method foo {} {error foo!}
+    oo::define B {
+	superclass A
+	method foo {} { next }
+    }
+    oo::objdefine c method foo {} { next }
+    catch {c ?} msg
+    set result [list $msg]
+    catch {c foo} msg
+    lappend result $msg $errorInfo
+} -cleanup {
+    A destroy
+} -result {{unknown method "?": must be destroy or foo} foo! {foo!
+    while executing
+"error foo!"
+    (class "::A" method "foo" line 1)
+    invoked from within
+"next "
+    (class "::B" method "foo" line 1)
+    invoked from within
+"next "
+    (object "::c" method "foo" line 1)
+    invoked from within
+"c foo"}}
+test oo-7.8 {OO: next at the end of the method chain} -setup {
+    set ::result ""
+} -cleanup {
+    foo destroy
+} -body {
+    oo::class create foo {
+	method bar {} {lappend ::result foo; lappend ::result [next] foo}
+    }
+    oo::class create foo2 {
+	superclass foo
+	method bar {} {lappend ::result foo2; lappend ::result [next] foo2}
+    }
+    lappend result [catch {[foo2 new] bar} msg] $msg
+} -result {foo2 foo 1 {no next method implementation}}
+test oo-7.9 {OO: defining inheritance in namespaces} -setup {
+    set ::result {}
+    oo::class create ::master
+    namespace eval ::foo {
+	oo::class create mixin {superclass ::master}
+    }
+} -cleanup {
+    ::master destroy
+    namespace delete ::foo
+} -body {
+    namespace eval ::foo {
+	oo::class create bar {superclass master}
+	oo::class create boo
+	oo::define boo {superclass bar}
+	oo::define boo {mixin mixin}
+	oo::class create spong {superclass boo}
+	return
+    }
+} -result {}
+
+test oo-8.1 {OO: global must work in methods} {
+    oo::object create foo
+    oo::objdefine foo method bar x {global result; lappend result $x}
+    set result {}
+    foo bar this
+    foo bar is
+    lappend result a
+    foo bar test
+    foo destroy
+    return $result
+} {this is a test}
+
+test oo-9.1 {OO: multiple inheritance} -setup {
+    oo::class create A
+    oo::class create B
+    oo::class create C
+    oo::class create D
+    D create foo
+} -body {
+    oo::define A method test {} {lappend ::result A; return ok}
+    oo::define B {
+	superclass A
+	method test {} {lappend ::result B; next}
+    }
+    oo::define C {
+	superclass A
+	method test {} {lappend ::result C; next}
+    }
+    oo::define D {
+	superclass B C
+	method test {} {lappend ::result D; next}
+    }
+    set result {}
+    lappend result [foo test]
+} -cleanup {
+    D destroy
+    C destroy
+    B destroy
+    A destroy
+} -result {D B C A ok}
+test oo-9.2 {OO: multiple inheritance} -setup {
+    oo::class create A
+    oo::class create B
+    oo::class create C
+    oo::class create D
+    D create foo
+} -body {
+    oo::define A method test {} {lappend ::result A; return ok}
+    oo::define B {
+	superclass A
+	method test {} {lappend ::result B; next}
+    }
+    oo::define C {
+	superclass A
+	method test {} {lappend ::result C; next}
+    }
+    oo::define D {
+	superclass B C
+	method test {} {lappend ::result D; next}
+    }
+    set result {}
+    lappend result [foo test]
+} -cleanup {
+    A destroy
+} -result {D B C A ok}
+
+test oo-10.1 {OO: recursive invoke and modify} -setup {
+    [oo::class create C] create O
+} -cleanup {
+    C destroy
+} -body {
+    oo::define C method foo x {
+	lappend ::result $x
+	if {$x} {
+	    [self object] foo [incr x -1]
+	}
+    }
+    oo::objdefine O method foo x {
+	lappend ::result -$x-
+	if {$x == 1} {
+	    oo::objdefine O deletemethod foo
+	}
+	next $x
+    }
+    set result {}
+    O foo 2
+    return $result
+} -result {-2- 2 -1- 1 0}
+test oo-10.2 {OO: recursive invoke and modify} -setup {
+    oo::object create O
+} -cleanup {
+    O destroy
+} -body {
+    oo::objdefine O method foo {} {
+	oo::objdefine [self] method foo {} {
+	    error "not called"
+	}
+	return [format %s%s call ed]
+    }
+    O foo
+} -result called
+test oo-10.3 {OO: invoke and modify} -setup {
+    oo::class create A {
+	method a {} {return A.a}
+	method b {} {return A.b}
+	method c {} {return A.c}
+    }
+    oo::class create B {
+	superclass A
+	method a {} {return [next],B.a}
+	method b {} {return [next],B.b}
+	method c {} {return [next],B.c}
+    }
+    B create C
+    set result {}
+} -cleanup {
+    A destroy
+} -body {
+    lappend result [C a] [C b] [C c] -
+    oo::define B deletemethod b
+    lappend result [C a] [C b] [C c] -
+    oo::define B renamemethod a b
+    lappend result [C a] [C b] [C c] -
+    oo::define B deletemethod b c
+    lappend result [C a] [C b] [C c]
+} -result {A.a,B.a A.b,B.b A.c,B.c - A.a,B.a A.b A.c,B.c - A.a A.b,B.a A.c,B.c - A.a A.b A.c}
+
+test oo-11.1 {OO: cleanup} {
+    oo::object create foo
+    set result [list [catch {oo::object create foo} msg] $msg]
+    lappend result [foo destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.2 {OO: cleanup} {
+    oo::class create bar
+    bar create foo
+    set result [list [catch {bar create foo} msg] $msg]
+    lappend result [bar destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.3 {OO: cleanup} {
+    oo::class create bar0
+    oo::class create bar
+    oo::define bar superclass bar0
+    bar create foo
+    set result [list [catch {bar create foo} msg] $msg]
+    lappend result [bar0 destroy] [oo::object create foo] [foo destroy]
+} {1 {can't create object "foo": command already exists with that name} {} ::foo {}}
+test oo-11.4 {OO: cleanup} {
+    oo::class create bar0
+    oo::class create bar1
+    oo::define bar1 superclass bar0
+    oo::class create bar2
+    oo::define bar2 {
+	superclass bar0
+	destructor {lappend ::result destroyed}
+    }
+    oo::class create bar
+    oo::define bar superclass bar1 bar2
+    bar create foo
+    set result [list [catch {bar create foo} msg] $msg]
+    lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \
+	[oo::object create bar2] [bar2 destroy]
+} {1 {can't create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}}
+
+test oo-12.1 {OO: filters} {
+    oo::class create Aclass
+    Aclass create Aobject
+    oo::define Aclass {
+	method concatenate args {
+	    global result
+	    lappend result {*}$args
+	    join $args {}
+	}
+	method logFilter args {
+	    global result
+	    lappend result "calling [self object]->[self method] $args"
+	    set r [next {*}$args]
+	    lappend result "result=$r"
+	    return $r
+	}
+    }
+    oo::objdefine Aobject filter logFilter
+    set result {}
+    lappend result [Aobject concatenate 1 2 3 4 5]
+    Aclass destroy
+    return $result
+} {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 12345}
+test oo-12.2 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method concatenate args {
+	    global result
+	    lappend result {*}$args
+	    join $args {}
+	}
+	method logFilter args {
+	    global result
+	    lappend result "calling [self object]->[self method] $args"
+	    set r [next {*}$args]
+	    lappend result "result=$r"
+	    return $r
+	}
+    }
+    oo::objdefine Aobject filter logFilter
+    set result {}
+    lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
+} -cleanup {
+    Aclass destroy
+} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
+test oo-12.3 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method concatenate args {
+	    global result
+	    lappend result {*}$args
+	    join $args {}
+	}
+	method logFilter args {
+	    global result
+	    lappend result "calling [self object]->[self method] $args"
+	    set r [next {*}$args]
+	    lappend result "result=$r"
+	    return $r
+	}
+	filter logFilter
+    }
+    set result {}
+    lappend result [Aobject concatenate 1 2 3 4 5] [Aobject destroy]
+} -cleanup {
+    Aclass destroy
+} -result {{calling ::Aobject->logFilter 1 2 3 4 5} 1 2 3 4 5 result=12345 {calling ::Aobject->logFilter } result= 12345 {}}
+test oo-12.4 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method foo {} { return foo }
+	method Bar {} { return 1 }
+	method boo {} { if {[my Bar]} { next } { error forbidden } }
+	filter boo
+    }
+    Aobject foo
+} -cleanup {
+    Aclass destroy
+} -result foo
+test oo-12.5 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method foo {} { return foo }
+	method Bar {} { return [my Bar2] }
+	method Bar2 {} { return 1 }
+	method boo {} { if {[my Bar]} { next } { error forbidden } }
+	filter boo
+    }
+    Aobject foo
+} -cleanup {
+    Aclass destroy
+} -result foo
+test oo-12.6 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method foo {} { return foo }
+	method Bar {} { return [my Bar2] }
+	method Bar2 {} { return [my Bar3] }
+	method Bar3 {} { return 1 }
+	method boo {} { if {[my Bar]} { next } { error forbidden } }
+	filter boo
+    }
+    Aobject foo
+} -cleanup {
+    Aclass destroy
+} -result foo
+test oo-12.7 {OO: filters} -setup {
+    oo::class create Aclass
+    Aclass create Aobject
+} -body {
+    oo::define Aclass {
+	method outerfoo {} { return [my InnerFoo] }
+	method InnerFoo {} { return foo }
+	method Bar {} { return [my Bar2] }
+	method Bar2 {} { return [my Bar3] }
+	method Bar3 {} { return 1 }
+	method boo {} {
+	    lappend ::log [self target]
+	    if {[my Bar]} { next } else { error forbidden }
+	}
+	filter boo
+    }
+    set log {}
+    list [Aobject outerfoo] $log
+} -cleanup {
+    Aclass destroy
+} -result {foo {{::Aclass outerfoo} {::Aclass InnerFoo}}}
+
+test oo-13.1 {OO: changing an object's class} {
+    oo::class create Aclass
+    oo::define Aclass {method bar {} {lappend ::result "in A [self object]"}}
+    oo::class create Bclass
+    oo::define Bclass {method bar {} {lappend ::result "in B [self object]"}}
+    set result [Aclass create foo]
+    foo bar
+    oo::objdefine foo class Bclass
+    foo bar
+    Aclass destroy
+    lappend result [info command foo]
+    Bclass destroy
+    return $result
+} {::foo {in A ::foo} {in B ::foo} foo}
+test oo-13.2 {OO: changing an object's class} -body {
+    oo::object create foo
+    oo::objdefine foo class oo::class
+} -cleanup {
+    foo destroy
+} -returnCodes 1 -result {may not change a non-class object into a class object}
+test oo-13.3 {OO: changing an object's class} -body {
+    oo::class create foo
+    oo::objdefine foo class oo::object
+} -cleanup {
+    foo destroy
+} -returnCodes 1 -result {may not change a class object into a non-class object}
+test oo-13.4 {OO: changing an object's class} -body {
+    oo::class create foo {
+	method m {} {
+	    set result [list [self class] [info object class [self]]]
+	    oo::objdefine [self] class ::bar
+	    lappend result [self class] [info object class [self]]
+	}
+    }
+    oo::class create bar
+    [foo new] m
+} -cleanup {
+    foo destroy
+    bar destroy
+} -result {::foo ::foo ::foo ::bar}
+# todo: changing a class subtype (metaclass) to another class subtype
+
+test oo-14.1 {OO: mixins} {
+    oo::class create Aclass
+    oo::define Aclass method bar {} {lappend ::result "[self object] in bar"}
+    oo::class create Bclass
+    oo::define Bclass method boo {} {lappend ::result "[self object] in boo"}
+    oo::objdefine [Aclass create fooTest] mixin Bclass
+    oo::objdefine [Aclass create fooTest2] mixin Bclass
+    set result [list [catch {fooTest ?} msg] $msg]
+    fooTest bar
+    fooTest boo
+    fooTest2 bar
+    fooTest2 boo
+    oo::objdefine fooTest2 mixin
+    lappend result [Bclass destroy] [info command fooTest*] [Aclass destroy]
+} {1 {unknown method "?": must be bar, boo or destroy} {::fooTest in bar} {::fooTest in boo} {::fooTest2 in bar} {::fooTest2 in boo} {} fooTest2 {}}
+test oo-14.2 {OO: mixins} {
+    oo::class create Aclass {
+	method bar {} {return "[self object] in bar"}
+    }
+    oo::class create Bclass {
+	method boo {} {return "[self object] in boo"}
+    }
+    oo::define Aclass mixin Bclass
+    Aclass create fooTest
+    set result [list [catch {fooTest ?} msg] $msg]
+    lappend result [catch {fooTest bar} msg] $msg
+    lappend result [catch {fooTest boo} msg] $msg
+    lappend result [Bclass destroy] [info commands Aclass]
+} {1 {unknown method "?": must be bar, boo or destroy} 0 {::fooTest in bar} 0 {::fooTest in boo} {} {}}
+test oo-14.3 {OO and mixins and filters - advanced case} -setup {
+    oo::class create mix
+    oo::class create c {
+	mixin mix
+    }
+    c create i
+} -body {
+    oo::define mix {
+	method foo {} {return >>[next]<<}
+	filter foo
+    }
+    oo::objdefine i method bar {} {return foobar}
+    i bar
+} -cleanup {
+    mix destroy
+    if {[info object isa object i]} {
+	error "mixin deletion failed to destroy dependent instance"
+    }
+} -result >>foobar<<
+test oo-14.4 {OO: mixin error case} -setup {
+    oo::class create c
+} -body {
+    oo::define c mixin c
+} -returnCodes error -cleanup {
+    c destroy
+} -result {may not mix a class into itself}
+test oo-14.5 {OO and mixins and filters - advanced case} -setup {
+    oo::class create mix
+    oo::class create c {
+	mixin mix
+    }
+    c create i
+} -body {
+    oo::define mix {
+	method foo {} {return >>[next]<<}
+	filter foo
+    }
+    oo::objdefine i method bar {} {return foobar}
+    i bar
+} -cleanup {
+    c destroy
+    mix destroy
+} -result >>foobar<<
+test oo-14.6 {OO and mixins of mixins - Bug 1960703} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create A {
+	superclass master
+	method egg {} {
+	    return chicken
+	}
+    }
+    oo::class create B {
+	superclass master
+	mixin A
+	method bar {} {
+	    # mixin from A
+	    my egg
+	}
+    }
+    oo::class create C {
+	superclass master
+	mixin B
+	method foo {} {
+	    # mixin from B
+	    my bar
+	}
+    }
+    [C new] foo
+} -result chicken
+test oo-14.7 {OO and filters from mixins of mixins} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create A {
+	superclass master
+	method egg {} {
+	    return chicken
+	}
+	filter f
+	method f args {
+	    set m [lindex [self target] 1]
+	    return "($m) [next {*}$args] ($m)"
+	}
+    }
+    oo::class create B {
+	superclass master
+	mixin A
+	filter f
+	method bar {} {
+	    # mixin from A
+	    my egg
+	}
+    }
+    oo::class create C {
+	superclass master
+	mixin B
+	filter f
+	method foo {} {
+	    # mixin from B
+	    my bar
+	}
+    }
+    [C new] foo
+} -result {(foo) (bar) (egg) chicken (egg) (bar) (foo)}
+test oo-14.8 {OO: class mixin order - Bug 1998221} -setup {
+    set ::result {}
+    oo::class create master {
+	method test {} {}
+    }
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create mix {
+	superclass master
+	method test {} {lappend ::result mix; next; return $::result}
+    }
+    oo::class create cls {
+	superclass master
+	mixin mix
+	method test {} {lappend ::result cls; next; return $::result}
+    }
+    [cls new] test
+} -result {mix cls}
+
+test oo-15.1 {OO: object cloning} {
+    oo::class create Aclass
+    oo::define Aclass method test {} {lappend ::result [self object]->test}
+    Aclass create Ainstance
+    set result {}
+    Ainstance test
+    oo::copy Ainstance Binstance
+    Binstance test
+    Ainstance test
+    Ainstance destroy
+    namespace eval foo {
+	oo::copy Binstance Cinstance
+	Cinstance test
+    }
+    Aclass destroy
+    namespace delete foo
+    lappend result [info commands Binstance]
+} {::Ainstance->test ::Binstance->test ::Ainstance->test ::foo::Cinstance->test {}}
+test oo-15.2 {OO: object cloning} {
+    oo::object create foo
+    oo::objdefine foo {
+	method m x {lappend ::result [self object] >$x<}
+	forward f ::lappend ::result fwd
+    }
+    set result {}
+    foo m 1
+    foo f 2
+    lappend result [oo::copy foo bar]
+    foo m 3
+    foo f 4
+    bar m 5
+    bar f 6
+    lappend result [foo destroy]
+    bar m 7
+    bar f 8
+    lappend result [bar destroy]
+} {::foo >1< fwd 2 ::bar ::foo >3< fwd 4 ::bar >5< fwd 6 {} ::bar >7< fwd 8 {}}
+catch {foo destroy}
+catch {bar destroy}
+test oo-15.3 {OO: class cloning} {
+    oo::class create foo {
+	method testme {} {lappend ::result [self class]->[self object]}
+    }
+    set result {}
+    foo create baseline
+    baseline testme
+    oo::copy foo bar
+    baseline testme
+    bar create tester
+    tester testme
+    foo destroy
+    tester testme
+    bar destroy
+    return $result
+} {::foo->::baseline ::foo->::baseline ::bar->::tester ::bar->::tester}
+test oo-15.4 {OO: object cloning - Bug 3474460} -setup {
+    oo::class create ArbitraryClass
+} -body {
+    ArbitraryClass create foo
+    oo::objdefine foo variable a b c
+    oo::copy foo bar
+    info object variable bar
+} -cleanup {
+    ArbitraryClass destroy
+} -result {a b c}
+test oo-15.5 {OO: class cloning - Bug 3474460} -setup {
+    oo::class create ArbitraryClass
+} -body {
+    oo::class create Foo {
+	superclass ArbitraryClass
+	variable a b c
+    }
+    oo::copy Foo Bar
+    info class variable Bar
+} -cleanup {
+    ArbitraryClass destroy
+} -result {a b c}
+test oo-15.6 {OO: object cloning copies namespace contents} -setup {
+    oo::class create ArbitraryClass {export eval}
+} -body {
+    ArbitraryClass create a
+    a eval {proc foo x {
+	variable y
+	return [string repeat $x [incr y]]
+    }}
+    set result [list [a eval {foo 2}] [a eval {foo 3}]]
+    oo::copy a b
+    a eval {rename foo bar}
+    lappend result [b eval {foo 2}] [b eval {foo 3}] [a eval {bar 4}]
+} -cleanup {
+    ArbitraryClass destroy
+} -result {2 33 222 3333 444}
+test oo-15.7 {OO: classes can be cloned anonymously} -setup {
+    oo::class create ArbitraryClassA
+    oo::class create ArbitraryClassB {superclass ArbitraryClassA}
+} -body {
+    info object isa class [oo::copy ArbitraryClassB]
+} -cleanup {
+    ArbitraryClassA destroy
+} -result 1
+test oo-15.8 {OO: intercept object cloning} -setup {
+    oo::class create Foo
+    set result {}
+} -body {
+    oo::define Foo {
+	constructor {msg} {
+	    variable v $msg
+	}
+	method <cloned> {from} {
+	    next $from
+	    lappend ::result cloned $from [self]
+	}
+	method check {} {
+	    variable v
+	    lappend ::result check [self] $v
+	}
+    }
+    Foo create foo ok
+    oo::copy foo bar
+    foo check
+    bar check
+} -cleanup {
+    Foo destroy
+} -result {cloned ::foo ::bar check ::foo ok check ::bar ok}
+test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup {
+    oo::class create Foo
+} -body {
+    oo::define Foo {
+	method <cloned> {a b} {}
+    }
+    interp alias {} Bar {} oo::copy [Foo create foo]
+    Bar bar
+} -returnCodes error -cleanup {
+    Foo destroy
+} -result {wrong # args: should be "::bar <cloned> a b"}
+test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
+    oo::class create FooClass
+    set result {}
+} -body {
+    set obj1 [FooClass new]
+    oo::objdefine $obj1 {
+	variable var 
+	method m {} {
+	    set var foo
+	}
+	method get {} {
+	    return $var
+	}
+	export eval
+    }
+
+    $obj1 m
+    lappend result [$obj1 get]
+    set obj2 [oo::copy $obj1]
+    $obj2 eval {
+	set var bar
+    }
+    lappend result [$obj2 get]
+    $obj1 eval {
+	set var grill
+    }
+    lappend result [$obj1 get] [$obj2 get]
+} -cleanup {
+    FooClass destroy
+} -result {foo bar grill bar}
+
+test oo-16.1 {OO: object introspection} -body {
+    info object
+} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
+test oo-16.2 {OO: object introspection} -body {
+    info object class NOTANOBJECT
+} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
+test oo-16.3 {OO: object introspection} -body {
+    info object gorp oo::object
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
+test oo-16.4 {OO: object introspection} -setup {
+    oo::class create meta { superclass oo::class }
+    [meta create instance1] create instance2
+} -body {
+    list [list [info object class oo::object] \
+	      [info object class oo::class] \
+	      [info object class meta] \
+	      [info object class instance1] \
+	      [info object class instance2]] \
+	[list [info object isa class oo::object] \
+	     [info object isa class meta] \
+	     [info object isa class instance1] \
+	     [info object isa class instance2]] \
+	[list [info object isa metaclass oo::object] \
+	     [info object isa metaclass oo::class] \
+	     [info object isa metaclass meta] \
+	     [info object isa metaclass instance1] \
+	     [info object isa metaclass instance2]] \
+	[list [info object isa object oo::object] \
+	     [info object isa object oo::class] \
+	     [info object isa object meta] \
+	     [info object isa object instance1] \
+	     [info object isa object instance2] \
+	     [info object isa object oo::define] \
+	     [info object isa object NOTANOBJECT]]
+} -cleanup {
+    meta destroy
+} -result {{::oo::class ::oo::class ::oo::class ::meta ::instance1} {1 1 1 0} {0 1 1 0 0} {1 1 1 1 1 0 0}}
+test oo-16.5 {OO: object introspection} {info object methods oo::object} {}
+test oo-16.6 {OO: object introspection} {
+    oo::object create foo
+    set result [list [info object methods foo]]
+    oo::objdefine foo method bar {} {...}
+    lappend result [info object methods foo] [foo destroy]
+} {{} bar {}}
+test oo-16.7 {OO: object introspection} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo method bar {a {b c} args} {the body}
+    set result [info object methods foo]
+    lappend result [info object methodtype foo bar] \
+	[info object definition foo bar]
+} -cleanup {
+    foo destroy
+} -result {bar method {{a {b c} args} {the body}}}
+test oo-16.8 {OO: object introspection} {
+    oo::object create foo
+    oo::class create bar
+    oo::objdefine foo mixin bar
+    set result [list [info object mixins foo] \
+		    [info object isa mixin foo bar] \
+		    [info object isa mixin foo oo::class]]
+    foo destroy
+    bar destroy
+    return $result
+} {::bar 1 0}
+test oo-16.9 {OO: object introspection} -body {
+    oo::class create Ac
+    oo::class create Bc; oo::define Bc superclass Ac
+    oo::class create Cc; oo::define Cc superclass Bc
+    oo::class create Dc; oo::define Dc mixin Cc
+    Cc create E
+    Dc create F
+    list [info object isa    typeof E oo::class] \
+	    [info object isa typeof E Ac] \
+	    [info object isa typeof F Bc] \
+	    [info object isa typeof F Cc]
+} -cleanup {
+    catch {Ac destroy}
+} -result {0 1 1 1}
+test oo-16.10 {OO: object introspection} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo export eval
+    foo eval {variable c 3 a 1 b 2 ddd 4 e}
+    lsort [info object vars foo ?]
+} -cleanup {
+    foo destroy
+} -result {a b c}
+test oo-16.11 {OO: object introspection} -setup {
+    oo::class create foo
+    foo create bar
+} -body {
+    oo::define foo method spong {} {...}
+    oo::objdefine bar method boo {a {b c} args} {the body}
+    list [lsort [info object methods bar -all]] [lsort [info object methods bar -all -private]]
+} -cleanup {
+    foo destroy
+} -result {{boo destroy spong} {<cloned> boo destroy eval spong unknown variable varname}}
+test oo-16.12 {OO: object introspection} -setup {
+    oo::object create foo
+} -cleanup {
+    rename foo {}
+} -body {
+    oo::objdefine foo unexport {*}[info object methods foo -all]
+    info object methods foo -all
+} -result {}
+test oo-16.13 {OO: object introspection} -setup {
+    oo::object create foo
+} -cleanup {
+    rename foo {}
+} -body {
+    oo::objdefine foo method Bar {} {return "ok in foo"}
+    [info object namespace foo]::my Bar
+} -result "ok in foo"
+
+test oo-17.1 {OO: class introspection} -body {
+    info class
+} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\""
+test oo-17.2 {OO: class introspection} -body {
+    info class superclass NOTANOBJECT
+} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
+test oo-17.3 {OO: class introspection} -setup {
+    oo::object create foo
+} -body {
+    info class superclass foo
+} -returnCodes 1 -cleanup {
+    foo destroy
+} -result {"foo" is not a class}
+test oo-17.4 {OO: class introspection} -body {
+    info class gorp oo::object
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
+test oo-17.5 {OO: class introspection} -setup {
+    oo::class create testClass
+} -body {
+    testClass create foo
+    testClass create bar
+    testClass create spong
+    lsort [info class instances testClass]
+} -cleanup {
+    testClass destroy
+} -result {::bar ::foo ::spong}
+test oo-17.6 {OO: class introspection} -setup {
+    oo::class create foo
+} -body {
+    oo::define foo method bar {a {b c} args} {the body}
+    set result [info class methods foo]
+    lappend result [info class methodtype foo bar] \
+	[info class definition foo bar]
+} -cleanup {
+    foo destroy
+} -result {bar method {{a {b c} args} {the body}}}
+test oo-17.7 {OO: class introspection} {
+    info class superclasses oo::class
+} ::oo::object
+test oo-17.8 {OO: class introspection} -setup {
+    oo::class create testClass
+    oo::class create superClass1
+    oo::class create superClass2
+} -body {
+    oo::define testClass superclass superClass1 superClass2
+    list [info class superclasses testClass] \
+	[lsort [info class subclass oo::object ::superClass?]]
+} -cleanup {
+    testClass destroy
+    superClass1 destroy
+    superClass2 destroy
+} -result {{::superClass1 ::superClass2} {::superClass1 ::superClass2}}
+test oo-17.9 {OO: class introspection} -setup {
+    oo::class create foo
+    oo::class create subfoo {superclass foo}
+} -body {
+    oo::define foo {
+	method bar {a {b c} args} {the body}
+	self {
+	    method bad {} {...}
+	}
+    }
+    oo::define subfoo method boo {a {b c} args} {the body}
+    list [lsort [info class methods subfoo -all]] \
+	[lsort [info class methods subfoo -all -private]]
+} -cleanup {
+    foo destroy
+} -result {{bar boo destroy} {<cloned> bar boo destroy eval unknown variable varname}}
+test oo-17.10 {OO: class introspection} -setup {
+    oo::class create foo
+} -cleanup {
+    rename foo {}
+} -body {
+    oo::define foo unexport {*}[info class methods foo -all]
+    info class methods foo -all
+} -result {}
+
+test oo-18.1 {OO: define command support} {
+    list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo
+} {1 foo {foo
+    while executing
+"error foo"
+    (in definition script for class "::oo::object" line 1)
+    invoked from within
+"oo::define oo::object {error foo}"}}
+test oo-18.2 {OO: define command support} {
+    list [catch {oo::define oo::object error foo} msg] $msg $errorInfo
+} {1 foo {foo
+    while executing
+"oo::define oo::object error foo"}}
+test oo-18.3 {OO: define command support} {
+    list [catch {oo::class create foo {error bar}} msg] $msg $errorInfo
+} {1 bar {bar
+    while executing
+"error bar"
+    (in definition script for class "::foo" line 1)
+    invoked from within
+"oo::class create foo {error bar}"}}
+test oo-18.3a {OO: define command support} {
+    list [catch {oo::class create foo {
+    error bar
+}} msg] $msg $errorInfo
+} {1 bar {bar
+    while executing
+"error bar"
+    (in definition script for class "::foo" line 2)
+    invoked from within
+"oo::class create foo {
+    error bar
+}"}}
+test oo-18.3b {OO: define command support} {
+    list [catch {oo::class create foo {
+    eval eval error bar
+}} msg] $msg $errorInfo
+} {1 bar {bar
+    while executing
+"error bar"
+    ("eval" body line 1)
+    invoked from within
+"eval error bar"
+    ("eval" body line 1)
+    invoked from within
+"eval eval error bar"
+    (in definition script for class "::foo" line 2)
+    invoked from within
+"oo::class create foo {
+    eval eval error bar
+}"}}
+test oo-18.4 {OO: more error traces from the guts} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj method bar {} {my eval {error foo}}
+    list [catch {obj bar} msg] $msg $errorInfo
+} -cleanup {
+    obj destroy
+} -result {1 foo {foo
+    while executing
+"error foo"
+    (in "my eval" script line 1)
+    invoked from within
+"my eval {error foo}"
+    (object "::obj" method "bar" line 1)
+    invoked from within
+"obj bar"}}
+test oo-18.5 {OO: more error traces from the guts} -setup {
+    [oo::class create cls] create obj
+    set errorInfo {}
+} -body {
+    oo::define cls {
+	method eval script {next $script}
+	export eval
+    }
+    oo::objdefine obj method bar {} {my eval {error foo}}
+    set result {}
+    lappend result [catch {obj bar} msg] $msg $errorInfo
+    lappend result [catch {obj eval {error bar}} msg] $msg $errorInfo
+} -cleanup {
+    cls destroy
+} -result {1 foo {foo
+    while executing
+"error foo"
+    (in "my eval" script line 1)
+    invoked from within
+"next $script"
+    (class "::cls" method "eval" line 1)
+    invoked from within
+"my eval {error foo}"
+    (object "::obj" method "bar" line 1)
+    invoked from within
+"obj bar"} 1 bar {bar
+    while executing
+"error bar"
+    (in "::obj eval" script line 1)
+    invoked from within
+"next $script"
+    (class "::cls" method "eval" line 1)
+    invoked from within
+"obj eval {error bar}"}}
+test oo-18.6 {class construction reference management and errors} -setup {
+    oo::class create super_abc
+} -body {
+    catch {
+oo::class create abc {
+    superclass super_abc
+    ::rename abc ::def
+    ::error foo
+}
+    } msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    super_abc destroy
+} -result {foo
+    while executing
+"::error foo"
+    (in definition script for class "::def" line 4)
+    invoked from within
+"oo::class create abc {
+    superclass super_abc
+    ::rename abc ::def
+    ::error foo
+}"}
+test oo-18.7 {OO: objdefine command support} -setup {
+    oo::object create ::inst
+} -body {
+    list [catch {oo::objdefine inst {rename ::inst ::INST;error foo}} msg] $msg $errorInfo
+} -cleanup {
+    catch {::inst destroy}
+    catch {::INST destroy}
+} -result {1 foo {foo
+    while executing
+"error foo"
+    (in definition script for object "::INST" line 1)
+    invoked from within
+"oo::objdefine inst {rename ::inst ::INST;error foo}"}}
+test oo-18.8 {OO: define/self command support} -setup {
+    oo::class create master
+    oo::class create ::foo {superclass master}
+} -body {
+    catch {oo::define foo {rename ::foo ::bar; self {error foobar}}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {foobar
+    while executing
+"error foobar"
+    (in definition script for class object "::bar" line 1)
+    invoked from within
+"self {error foobar}"
+    (in definition script for class "::bar" line 1)
+    invoked from within
+"oo::define foo {rename ::foo ::bar; self {error foobar}}"}
+test oo-18.9 {OO: define/self command support} -setup {
+    oo::class create master
+    set c [oo::class create now_this_is_a_very_very_long_class_name_indeed {
+        superclass master
+    }]
+} -body {
+    catch {oo::define $c {error err}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {err
+    while executing
+"error err"
+    (in definition script for class "::now_this_is_a_very_very_long..." line 1)
+    invoked from within
+"oo::define $c {error err}"}
+test oo-18.10 {OO: define/self command support} -setup {
+    oo::class create master
+    oo::class create ::foo {superclass master}
+} -body {
+    catch {oo::define foo {self {rename ::foo {}; error foobar}}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {foobar
+    while executing
+"error foobar"
+    (in definition script for class object "::foo" line 1)
+    invoked from within
+"self {rename ::foo {}; error foobar}"
+    (in definition script for class "::foo" line 1)
+    invoked from within
+"oo::define foo {self {rename ::foo {}; error foobar}}"}
+test oo-18.11 {OO: define/self command support} -setup {
+    oo::class create master
+    oo::class create ::foo {superclass master}
+} -body {
+    catch {oo::define foo {rename ::foo {}; self {error foobar}}} msg opt
+    dict get $opt -errorinfo
+} -cleanup {
+    master destroy
+} -result {this command cannot be called when the object has been deleted
+    while executing
+"self {error foobar}"
+    (in definition script for class "::foo" line 1)
+    invoked from within
+"oo::define foo {rename ::foo {}; self {error foobar}}"}
+
+test oo-19.1 {OO: varname method} -setup {
+    oo::object create inst
+    oo::objdefine inst export eval
+    set result {}
+    inst eval { variable x }
+} -body {
+    inst eval {trace add variable x write foo}
+    set ns [inst eval namespace current]
+    proc foo args {
+	global ns result
+	set context [uplevel 1 namespace current]
+	lappend result $args [expr {
+	    $ns eq $context ? "ok" : [list $ns ne $context]
+	}] [expr {
+	    "${ns}::x" eq [uplevel 1 my varname x] ? "ok" : [list ${ns}::x ne [uplevel 1 my varname x]]
+	}]
+    }
+    lappend result [inst eval set x 0]
+} -cleanup {
+    inst destroy
+    rename foo {}
+} -result {{x {} write} ok ok 0}
+test oo-19.2 {OO: varname method: Bug 2883857} -setup {
+    oo::class create SpecialClass
+    oo::objdefine SpecialClass export createWithNamespace
+    SpecialClass createWithNamespace inst ::oo_test
+    oo::objdefine inst export varname eval
+} -body {
+    inst eval { variable x; array set x {y z} }
+    inst varname x(y)
+} -cleanup {
+    SpecialClass destroy
+} -result ::oo_test::x(y)
+test oo-19.3 {OO: varname method and variable decl: Bug 3603695} -setup {
+    oo::class create testClass {
+	variable foo
+	export varname
+	constructor {} {
+	    variable foo x
+	}
+	method bar {obj} {
+	    my varname foo
+	    $obj varname foo
+	}
+    }
+} -body {
+    testClass create A
+    testClass create B
+    lsearch [list [A varname foo] [B varname foo]] [B bar A]
+} -cleanup {
+    testClass destroy
+} -result 0
+
+test oo-20.1 {OO: variable method} -body {
+    oo::class create testClass {
+	constructor {} {
+	    my variable ok
+	    set ok {}
+	}
+    }
+    lsort [info object vars [testClass new]]
+} -cleanup {
+    catch {testClass destroy}
+} -result ok
+test oo-20.2 {OO: variable method} -body {
+    oo::class create testClass {
+	constructor {} {
+	    my variable a b c
+	    set a [set b [set c {}]]
+	}
+    }
+    lsort [info object vars [testClass new]]
+} -cleanup {
+    catch {testClass destroy}
+} -result {a b c}
+test oo-20.3 {OO: variable method} -body {
+    oo::class create testClass {
+	export varname
+	method bar {} {
+	    my variable a(b)
+	}
+    }
+    testClass create foo
+    array set [foo varname a] {b c}
+    foo bar
+} -returnCodes 1 -cleanup {
+    catch {testClass destroy}
+} -result {can't define "a(b)": name refers to an element in an array}
+test oo-20.4 {OO: variable method} -body {
+    oo::class create testClass {
+	export varname
+	method bar {} {
+	    my variable a(b)
+	}
+    }
+    testClass create foo
+    set [foo varname a] b
+    foo bar
+} -returnCodes 1 -cleanup {
+    catch {testClass destroy}
+} -result {can't define "a(b)": name refers to an element in an array}
+test oo-20.5 {OO: variable method} -body {
+    oo::class create testClass {
+	method bar {} {
+	    my variable a::b
+	}
+    }
+    testClass create foo
+    foo bar
+} -returnCodes 1 -cleanup {
+    catch {testClass destroy}
+} -result {variable name "a::b" illegal: must not contain namespace separator}
+test oo-20.6 {OO: variable method} -setup {
+    oo::class create testClass {
+	export varname
+	self export eval
+    }
+} -body {
+    testClass eval variable a 0
+    oo::objdefine [testClass create foo] method bar {other} {
+	$other variable a
+	set a 3
+    }
+    oo::objdefine [testClass create boo] export variable
+    set [foo varname a] 1
+    set [boo varname a] 2
+    foo bar boo
+    list [testClass eval set a] [set [foo varname a]] [set [boo varname a]]
+} -cleanup {
+    testClass destroy
+} -result {0 1 3}
+test oo-20.7 {OO: variable method} -setup {
+    oo::class create cls
+} -body {
+    oo::define cls {
+	method a {} {
+	    my variable d b
+	    lappend b $d
+	}
+	method e {} {
+	    my variable b d
+	    return [list $b $d]
+	}
+	method f {x y} {
+	    my variable b d
+	    set b $x
+	    set d $y
+	}
+    }
+    cls create obj
+    obj f p q
+    obj a
+    obj a
+    obj e
+} -cleanup {
+    cls destroy
+} -result {{p q q} q}
+# oo-20.8 tested explicitly for functionality removed due to [Bug 1959457]
+test oo-20.9 {OO: variable method} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj {
+	method a {} {
+	    my variable ::b
+	}
+    }
+    obj a
+} -returnCodes 1 -cleanup {
+    obj destroy
+} -result {variable name "::b" illegal: must not contain namespace separator}
+test oo-20.10 {OO: variable and varname methods refer to same things} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj {
+	method a {} {
+	    my variable b
+	    set b [self]
+	    return [my varname b]
+	}
+    }
+    list [set [obj a]] [namespace tail [obj a]]
+} -cleanup {
+    obj destroy
+} -result {::obj b}
+test oo-20.11 {OO: variable mustn't crash when recursing} -body {
+    oo::class create A {
+	constructor {name} {
+	    my variable np_name 
+	    set np_name $name
+	}
+	method copy {nm} {
+	    set cpy [[info object class [self]] new $nm]
+	    foreach var [info object vars [self]] {
+		my variable $var
+		set val [set $var]
+		if {[string match o_* $var]} {
+		    set objs {}
+		    foreach ref $val {
+			# call to "copy" crashes
+			lappend objs [$ref copy {}]
+		    }
+		    $cpy prop $var $objs
+		} else { 
+		    $cpy prop $var $val
+		}
+	    }
+	    return $cpy
+	}
+	method prop {name val} {
+	    my variable $name
+	    set $name $val
+	}
+    }
+    set o1 [A new {}]
+    set o2 [A new {}]
+    $o1 prop o_object $o2
+    $o1 copy aa
+} -cleanup {
+    catch {A destroy}
+} -match glob -result *
+test oo-20.12 {OO: variable method accept zero args (TIP 323)} -setup {
+    oo::object create foo
+} -cleanup {
+    foo destroy
+} -body {
+    oo::objdefine foo method demo {} {
+	my variable
+    }
+    foo demo
+} -result {}
+test oo-20.13 {OO: variable method use in non-methods [Bug 2903811]} -setup {
+    oo::object create fooObj
+    oo::objdefine fooObj export variable
+} -cleanup {
+    fooObj destroy
+} -body {
+    apply {{} {fooObj variable x; set x ok; return}}
+    apply {{} {fooObj variable x; return $x}}
+} -result ok
+test oo-20.14 {OO: variable method use in non-methods [Bug 2903811]} -setup {
+    oo::object create fooObj
+    oo::objdefine fooObj export variable
+    namespace eval ns1 {}
+    namespace eval ns2 {}
+    set x bad
+} -cleanup {
+    fooObj destroy
+    namespace delete ns1 ns2
+    unset x
+} -body {
+    namespace eval ns1 {fooObj variable x; set x ok; subst ""}
+    set x bad
+    namespace eval ns2 {fooObj variable x; return $x}
+} -result ok
+test oo-20.15 {OO: variable method use in non-methods [Bug 2903811]} -setup {
+    oo::object create fooObj
+    oo::objdefine fooObj export variable varname
+} -cleanup {
+    fooObj destroy
+} -body {
+    apply {{} {fooObj variable x; set x ok; return}}
+    return [set [fooObj varname x]]
+} -result ok
+test oo-20.16 {variable method: leak per instance} -setup {
+    oo::class create foo
+} -constraints memory -body {
+    oo::define foo {
+	constructor {} {
+	    set [my variable v] 0
+	}
+    }
+    leaktest {[foo new] destroy}
+} -cleanup {
+    foo destroy
+} -result 0
+
+test oo-21.1 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+    }
+    D create o
+    oo::objdefine o method m {} {lappend ::result o;next}
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {o D B C A}
+test oo-21.2 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+    }
+    oo::class create Emix {
+	superclass C
+	method m {} {lappend ::result Emix;next}
+    }
+    oo::class create Fmix {
+	superclass Emix
+	method m {} {lappend ::result Fmix;next}
+    }
+    D create o
+    oo::objdefine o {
+	method m {} {lappend ::result o;next}
+	mixin Fmix
+    }
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {Fmix Emix o D B C A}
+test oo-21.3 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+	method f {} {lappend ::result B-filt;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+    }
+    oo::class create Emix {
+	superclass C
+	method m {} {lappend ::result Emix;next}
+	method f {} {lappend ::result Emix-filt;next}
+    }
+    oo::class create Fmix {
+	superclass Emix
+	method m {} {lappend ::result Fmix;next}
+    }
+    D create o
+    oo::objdefine o {
+	method m {} {lappend ::result o;next}
+	mixin Fmix
+	filter f
+    }
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {Emix-filt B-filt Fmix Emix o D B C A}
+test oo-21.4 {OO: inheritance ordering} -setup {
+    oo::class create A
+} -body {
+    oo::define A method m {} {lappend ::result A}
+    oo::class create B {
+	superclass A
+	method m {} {lappend ::result B;next}
+	method f {} {lappend ::result B-filt;next}
+	method g {} {lappend ::result B-cfilt;next}
+    }
+    oo::class create C {
+	superclass A
+	method m {} {lappend ::result C;next}
+    }
+    oo::class create D {
+	superclass B C
+	method m {} {lappend ::result D;next}
+	method g {} {lappend ::result D-cfilt;next}
+	filter g
+    }
+    oo::class create Emix {
+	superclass C
+	method m {} {lappend ::result Emix;next}
+	method f {} {lappend ::result Emix-filt;next}
+    }
+    oo::class create Fmix {
+	superclass Emix
+	method m {} {lappend ::result Fmix;next}
+    }
+    D create o
+    oo::objdefine o {
+	method m {} {lappend ::result o;next}
+	mixin Fmix
+	filter f
+    }
+    set result {}
+    o m
+    return $result
+} -cleanup {
+    A destroy
+} -result {Emix-filt B-filt D-cfilt B-cfilt Fmix Emix o D B C A}
+
+test oo-22.1 {OO and info frame} -setup {
+    oo::class create c
+    c create i
+} -match glob -body {
+    oo::define c self method frame {} {
+	info frame 0
+    }
+    oo::define c {
+	method frames {} {
+	    info frame 0
+	}
+	method level {} {
+	    info frame
+	}
+    }
+    oo::objdefine i {
+	method frames {} {
+	    list [next] [info frame 0]
+	}
+	method level {} {
+	    expr {[next] - [info frame]}
+	}
+    }
+    list [i level] [i frames] [dict get [c frame] object]
+} -cleanup {
+    c destroy
+} -result {1 {{* cmd {info frame 0} method frames class ::c level 0} {* cmd {info frame 0} method frames object ::i level 0}} ::c}
+test oo-22.2 {OO and info frame: Bug 3001438} -setup {
+    oo::class create c
+} -body {
+    oo::define c method test {{x 1}} {
+	if {$x} {my test 0}
+	lsort {q w e r t y u i o p}; # Overwrite the Tcl stack
+	info frame 0
+    }
+    [c new] test
+} -match glob -cleanup {
+    c destroy
+} -result {* cmd {info frame 0} method test class ::c level 0}
+
+# Prove that the issue in [Bug 1865054] isn't an issue any more
+test oo-23.1 {Self-like derivation; complex case!} -setup {
+    oo::class create SELF {
+	superclass oo::class
+	unexport create new
+	# Next is just a convenience
+	method method args {oo::define [self] method {*}$args}
+	method derive {name} {
+	    set o [my new [list superclass [self]]]
+	    oo::objdefine $o mixin $o
+	    uplevel 1 [list rename $o $name]\;[list namespace which $name]
+	}
+	self mixin SELF
+    }
+    set result {}
+} -body {
+    [SELF derive foo1] method bar1 {} {return 1}
+    lappend result [foo1 bar1]
+    [foo1 derive foo2] method bar2 {} {return [my bar1],2}
+    lappend result [foo2 bar2]
+    [foo2 derive foo3] method bar3 {} {return [my bar2],3}
+    lappend result [foo3 bar3]
+    [foo3 derive foo4] method bar4 {} {return [my bar3],4}
+    lappend result [foo4 bar4]
+    foo2 method bar2 {} {return [my bar1],x}
+    lappend result [foo4 bar4]
+} -cleanup {
+    SELF destroy
+} -result {1 1,2 1,2,3 1,2,3,4 1,x,3,4}
+
+test oo-24.1 {unknown method method - Bug 1965063} -setup {
+    oo::class create cls
+} -cleanup {
+    cls destroy
+} -returnCodes error -body {
+    oo::define cls {
+	method dummy {} {}
+	method unknown args {next {*}$args}
+    }
+    [cls new] foo bar
+} -result {unknown method "foo": must be destroy, dummy or unknown}
+test oo-24.2 {unknown method method - Bug 1965063} -setup {
+    oo::class create cls
+} -cleanup {
+    cls destroy
+} -returnCodes error -body {
+    oo::define cls {
+	method dummy {} {}
+	method unknown args {next {*}$args}
+    }
+    cls create obj
+    oo::objdefine obj {
+	method dummy2 {} {}
+	method unknown args {next {*}$args}
+    }
+    obj foo bar
+} -result {unknown method "foo": must be destroy, dummy, dummy2 or unknown}
+test oo-24.3 {unknown method method - absent method name} -setup {
+    set o [oo::object new]
+} -cleanup {
+    $o destroy
+} -body {
+    oo::objdefine $o method unknown args {
+	return "unknown: >>$args<<"
+    }
+    list [$o] [$o foobar] [$o foo bar]
+} -result {{unknown: >><<} {unknown: >>foobar<<} {unknown: >>foo bar<<}}
+
+# Probably need a better set of tests, but this is quite difficult to devise
+test oo-25.1 {call chain caching} -setup {
+    oo::class create cls {
+	method ab {} {return ok}
+    }
+    set result {}
+} -cleanup {
+    cls destroy
+} -body {
+    cls create foo
+    cls create bar
+    set m1 ab
+    set m2 a; append m2 b ;# different object!
+    lappend result [foo $m1] [foo $m1] [bar $m1] [foo $m1]
+    lappend result [foo $m2] [bar $m2]
+    oo::objdefine foo method ab {} {return good}
+    lappend result [foo $m1] [bar $m2]
+} -result {ok ok ok ok ok ok good ok}
+test oo-25.2 {call chain caching - Bug #2120903} -setup {
+    set c [oo::class create MyClass]
+    set o [$c new]
+} -body {
+    oo::define MyClass {
+	method name {} {return ok}
+	method isa o {MyClass name $o}
+	self method name o {$o name}
+    }
+    list [$o name] [$c name $o] [$o isa $o]
+} -cleanup {
+    $c destroy
+} -result {ok ok ok}
+
+test oo-26.1 {Bug 2037727} -setup {
+    proc succeed args {}
+    oo::object create example
+} -body {
+    oo::objdefine example method foo {} {succeed}
+    example foo
+    proc succeed {} {return succeed}
+    example foo
+} -cleanup {
+    example destroy
+    rename succeed {}
+} -result succeed
+test oo-26.2 {Bug 2037727} -setup {
+    oo::class create example {
+	method localProc {args body} {proc called $args $body}
+	method run {} { called }
+    }
+    example create i1
+    example create i2
+} -body {
+    i1 localProc args {}
+    i2 localProc args {return nonempty}
+    list [i1 run] [i2 run]
+} -cleanup {
+    example destroy
+} -result {{} nonempty}
+test oo-26.3 {Bug 2037727} -setup {
+    oo::class create example {
+	method subProc {args body} {
+	    namespace eval subns [list proc called $args $body]
+	}
+	method run {} { subns::called }
+    }
+    example create i1
+    example create i2
+} -body {
+    i1 subProc args {}
+    i2 subProc args {return nonempty}
+    list [i1 run] [i2 run]
+} -cleanup {
+    example destroy
+} -result {{} nonempty}
+
+test oo-27.1 {variables declaration - class introspection} -setup {
+    oo::class create foo
+} -cleanup {
+    foo destroy
+} -body {
+    oo::define foo variable a b c
+    info class variables foo
+} -result {a b c}
+test oo-27.2 {variables declaration - object introspection} -setup {
+    oo::object create foo
+} -cleanup {
+    foo destroy
+} -body {
+    oo::objdefine foo variable a b c
+    info object variables foo
+} -result {a b c}
+test oo-27.3 {variables declaration - basic behaviour} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable x!
+	constructor {} {set x! 1}
+	method y {} {incr x!}
+    }
+    foo create bar
+    bar y
+    bar y
+} -result 3
+test oo-27.4 {variables declaration - destructors too} -setup {
+    oo::class create master
+    set result bad!
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable x!
+	constructor {} {set x! 1}
+	method y {} {incr x!}
+	destructor {set ::result ${x!}}
+    }
+    foo create bar
+    bar y
+    bar y
+    bar destroy
+    return $result
+} -result 3
+test oo-27.5 {variables declaration - object-bound variables} -setup {
+    oo::object create foo
+} -cleanup {
+    foo destroy
+} -body {
+    oo::objdefine foo {
+	variable x!
+	method y {} {incr x!}
+    }
+    foo y
+    foo y
+} -result 2
+test oo-27.6 {variables declaration - non-interference of levels} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable x!
+	constructor {} {set x! 1}
+	method y {} {incr x!}
+    }
+    foo create bar
+    oo::objdefine bar {
+	variable y!
+	method y {} {list [next] [incr y!] [info var] [info local]}
+	export eval
+    }
+    bar y
+    list [bar y] [lsort [info object vars bar]] [bar eval {info vars *!}]
+} -result {{3 2 y! {}} {x! y!} {x! y!}}
+test oo-27.7 {variables declaration - one underlying variable space} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable x!
+	constructor {} {set x! 1}
+	method y {} {incr x!}
+    }
+    oo::class create foo2 {
+	superclass foo
+	variable y!
+	constructor {} {set y! 42; next}
+	method x {} {incr y! -1}
+    }
+    foo2 create bar
+    oo::objdefine bar {
+	variable x! y!
+	method z {} {list ${x!} ${y!}}
+    }
+    bar y
+    bar x
+    list [bar y] [bar x] [bar z]
+} -result {3 40 {3 40}}
+test oo-27.8 {variables declaration - error cases - ns separators} -body {
+    oo::define oo::object variable bad::var
+} -returnCodes error -result {invalid declared variable name "bad::var": must not contain namespace separators}
+test oo-27.9 {variables declaration - error cases - arrays} -body {
+    oo::define oo::object variable bad(var)
+} -returnCodes error -result {invalid declared variable name "bad(var)": must not refer to an array element}
+test oo-27.10 {variables declaration - no instance var leaks with class resolvers} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable clsvar
+	constructor {} {
+	    set clsvar 0
+	}
+	method step {} {
+	    incr clsvar
+	    return
+	}
+	method value {} {
+	    return $clsvar
+	}
+    }
+    foo create inst1
+    inst1 step
+    foo create inst2
+    inst2 step
+    inst1 step
+    inst2 step
+    inst1 step
+    list [inst1 value] [inst2 value]
+} -result {3 2}
+test oo-27.11 {variables declaration - no instance var leaks with class resolvers} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable clsvar
+	constructor {} {
+	    set clsvar 0
+	}
+	method step {} {
+	    incr clsvar
+	    return
+	}
+	method value {} {
+	    return $clsvar
+	}
+    }
+    foo create inst1
+    oo::objdefine inst1 {
+	variable clsvar
+	method reinit {} {
+	    set clsvar 0
+	}
+    }
+    foo create inst2
+    oo::objdefine inst2 {
+	variable clsvar
+	method reinit {} {
+	    set clsvar 0
+	}
+    }
+    inst1 step
+    inst2 step
+    inst1 reinit
+    inst2 reinit
+    inst1 step
+    inst2 step
+    inst1 step
+    inst2 step
+    inst1 step
+    list [inst1 value] [inst2 value]
+} -result {3 2}
+test oo-27.12 {variables declaration: leak per instance} -setup {
+    oo::class create foo
+} -constraints memory -body {
+    oo::define foo {
+	variable v
+	constructor {} {
+	    set v 0
+	}
+    }
+    leaktest {[foo new] destroy}
+} -cleanup {
+    foo destroy
+} -result 0
+# This test will actually (normally) crash if it fails!
+test oo-27.13 {variables declaration: Bug 3185009: require refcount management} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo {
+	variable x
+	method set v {set x $v}
+	method unset {} {unset x}
+	method exists {} {info exists x}
+	method get {} {return $x}
+    }
+    list [foo exists] [foo set 7] [foo exists] [foo get] [foo unset] \
+	[foo exists] [catch {foo get} msg] $msg
+} -cleanup {
+    foo destroy
+} -result {0 7 1 7 {} 0 1 {can't read "x": no such variable}}
+test oo-27.14 {variables declaration - multiple use} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable x
+	variable y
+	method boo {} {
+	    return [incr x],[incr y]
+	}
+    }
+    foo create bar
+    list [bar boo] [bar boo]
+} -result {1,1 2,2}
+test oo-27.15 {variables declaration - multiple use} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable
+	variable x y
+	method boo {} {
+	    return [incr x],[incr y]
+	}
+    }
+    foo create bar
+    list [bar boo] [bar boo]
+} -result {1,1 2,2}
+test oo-27.16 {variables declaration - multiple use} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable x
+	variable -clear
+	variable y
+	method boo {} {
+	    return [incr x],[incr y]
+	}
+    }
+    foo create bar
+    list [bar boo] [bar boo]
+} -result {1,1 1,2}
+test oo-27.17 {variables declaration - multiple use} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable x
+	variable -set y
+	method boo {} {
+	    return [incr x],[incr y]
+	}
+    }
+    foo create bar
+    list [bar boo] [bar boo]
+} -result {1,1 1,2}
+test oo-27.18 {variables declaration - multiple use} -setup {
+    oo::class create master
+} -cleanup {
+    master destroy
+} -body {
+    oo::class create foo {
+	superclass master
+	variable x
+	variable -? y
+	method boo {} {
+	    return [incr x],[incr y]
+	}
+    }
+    foo create bar
+    list [bar boo] [bar boo]
+} -returnCodes error -match glob -result {unknown method "-?": must be *}
+test oo-27.19 {variables declaration and [info vars]: Bug 2712377} -setup {
+    oo::class create Foo
+    set result {}
+} -body {
+    # This is really a test of problems to do with Tcl's introspection when a
+    # variable resolver is present...
+    oo::define Foo {
+	variable foo bar
+	method setvars {f b} {
+	    set foo $f
+	    set bar $b
+	}
+	method dump1 {} {
+	    lappend ::result <1>
+	    foreach v [lsort [info vars *]] {
+		lappend ::result $v=[set $v]
+	    }
+	    lappend ::result [info locals] [info locals *]
+	}
+	method dump2 {} {
+	    lappend ::result <2>
+	    foreach v [lsort [info vars *]] {
+		lappend ::result $v=[set $v]
+	    }
+	    lappend ::result | foo=$foo [info locals] [info locals *]
+	}
+    }
+    Foo create stuff
+    stuff setvars what ever
+    stuff dump1
+    stuff dump2
+    return $result
+} -cleanup {
+    Foo destroy
+} -result {<1> bar=ever foo=what v v <2> bar=ever foo=what | foo=what v v}
+test oo-27.20 {variables declaration and [info vars]: Bug 2712377} -setup {
+    oo::class create Foo
+    set result {}
+} -body {
+    # This is really a test of problems to do with Tcl's introspection when a
+    # variable resolver is present...
+    oo::define Foo {
+	variable foo bar
+	method setvars {f b} {
+	    set foo $f
+	    set bar $b
+	}
+	method dump1 {} {
+	    lappend ::result <1>
+	    foreach v [lsort [info vars *o]] {
+		lappend ::result $v=[set $v]
+	    }
+	    lappend ::result [info locals] [info locals *]
+	}
+	method dump2 {} {
+	    lappend ::result <2>
+	    foreach v [lsort [info vars *o]] {
+		lappend ::result $v=[set $v]
+	    }
+	    lappend ::result | foo=$foo [info locals] [info locals *]
+	}
+    }
+    Foo create stuff
+    stuff setvars what ever
+    stuff dump1
+    stuff dump2
+    return $result
+} -cleanup {
+    Foo destroy
+} -result {<1> foo=what v v <2> foo=what | foo=what v v}
+test oo-27.21 {variables declaration uniqueifies: Bug 3396896} -setup {
+    oo::class create Foo
+} -body {
+    oo::define Foo variable v v v t t v t
+    info class variable Foo
+} -cleanup {
+    Foo destroy
+} -result {v t}
+test oo-27.22 {variables declaration uniqueifies: Bug 3396896} -setup {
+    oo::object create foo
+} -body {
+    oo::objdefine foo variable v v v t t v t
+    info object variable foo
+} -cleanup {
+    foo destroy
+} -result {v t}
+
+# A feature that's not supported because the mechanism may change without
+# warning, but is supposed to work...
+test oo-28.1 {scripted extensions to oo::define} -setup {
+    interp create foo
+    foo eval {oo::class create cls {export eval}}
+} -cleanup {
+    interp delete foo
+} -body {
+    foo eval {
+	proc oo::define::privateMethod {name arguments body} {
+	    uplevel 1 [list method $name $arguments $body]
+	    uplevel 1 [list unexport $name]
+	}
+	oo::define cls privateMethod m {x y} {return $x,$y}
+	cls create obj
+	list [catch {obj m 1 2}] [obj eval my m 3 4]
+    }
+} -result {1 3,4}
+
+test oo-29.1 {self class with object-defined methods} -setup {
+    oo::object create obj
+} -body {
+    oo::objdefine obj method demo {} {
+	self class
+    }
+    obj demo
+} -returnCodes error -cleanup {
+    obj destroy
+} -result {method not defined by a class}
+
+test oo-30.1 {Bug 2903011: deleting an object in a constructor} -setup {
+    oo::class create cls
+} -body {
+    oo::define cls {constructor {} {[self] destroy}}
+    cls new
+} -returnCodes error -cleanup {
+    cls destroy
+} -result {object deleted in constructor}
+test oo-30.2 {Bug 2903011: deleting an object in a constructor} -setup {
+    oo::class create cls
+} -body {
+    oo::define cls {constructor {} {my destroy}}
+    cls new
+} -returnCodes error -cleanup {
+    cls destroy
+} -result {object deleted in constructor}
+
+test oo-31.1 {Bug 3111059: when objects and coroutines entangle} -setup {
+    oo::class create cls
+} -constraints memory -body {
+    oo::define cls {
+	method justyield {} {
+	    yield
+	}
+	constructor {} {
+	    coroutine coro my justyield
+	}
+    }
+    list [leaktest {[cls new] destroy}] [info class instances cls]
+} -cleanup {
+    cls destroy
+} -result {0 {}}
+test oo-31.2 {Bug 3111059: when objects and coroutines entangle} -setup {
+    oo::class create cls
+} -constraints memory -body {
+    oo::define cls {
+	method justyield {} {
+	    yield
+	}
+	constructor {} {
+	    coroutine coro my justyield
+	}
+	destructor {
+	    rename coro {}
+	}
+    }
+    list [leaktest {[cls new] destroy}] [info class instances cls]
+} -cleanup {
+    cls destroy
+} -result {0 {}}
+
+oo::class create SampleSlot {
+    superclass oo::Slot
+    constructor {} {
+	variable contents {a b c} ops {}
+    }
+    method contents {} {variable contents; return $contents}
+    method ops {} {variable ops; return $ops}
+    method Get {} {
+	variable contents
+	variable ops
+	lappend ops [info level] Get
+	return $contents
+    }
+    method Set {lst} {
+	variable contents $lst
+	variable ops
+	lappend ops [info level] Set $lst
+	return
+    }
+}
+
+test oo-32.1 {TIP 380: slots - class test} -setup {
+    SampleSlot create sampleSlot
+} -body {
+    list [info level] [sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+    rename sampleSlot {}
+} -result {0 {a b c} {}}
+test oo-32.2 {TIP 380: slots - class test} -setup {
+    SampleSlot create sampleSlot
+} -body {
+    list [info level] [sampleSlot -clear] \
+	[sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+    rename sampleSlot {}
+} -result {0 {} {} {1 Set {}}}
+test oo-32.3 {TIP 380: slots - class test} -setup {
+    SampleSlot create sampleSlot
+} -body {
+    list [info level] [sampleSlot -append g h i] \
+	[sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+    rename sampleSlot {}
+} -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
+test oo-32.4 {TIP 380: slots - class test} -setup {
+    SampleSlot create sampleSlot
+} -body {
+    list [info level] [sampleSlot -set d e f] \
+	[sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+    rename sampleSlot {}
+} -result {0 {} {d e f} {1 Set {d e f}}}
+test oo-32.5 {TIP 380: slots - class test} -setup {
+    SampleSlot create sampleSlot
+} -body {
+    list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \
+	[sampleSlot contents] [sampleSlot ops]
+} -cleanup {
+    rename sampleSlot {}
+} -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}
+
+test oo-33.1 {TIP 380: slots - defaulting} -setup {
+    set s [SampleSlot new]
+} -body {
+    list [$s x y] [$s contents]
+} -cleanup {
+    rename $s {}
+} -result {{} {a b c x y}}
+test oo-33.2 {TIP 380: slots - defaulting} -setup {
+    set s [SampleSlot new]
+} -body {
+    list [$s destroy; $s unknown] [$s contents]
+} -cleanup {
+    rename $s {}
+} -result {{} {a b c destroy unknown}}
+test oo-33.3 {TIP 380: slots - defaulting} -setup {
+    set s [SampleSlot new]
+} -body {
+    oo::objdefine $s forward --default-operation  my -set
+    list [$s destroy; $s unknown] [$s contents] [$s ops]
+} -cleanup {
+    rename $s {}
+} -result {{} unknown {1 Set destroy 1 Set unknown}}
+test oo-33.4 {TIP 380: slots - errors} -setup {
+    set s [SampleSlot new]
+} -body {
+    # Method names beginning with "-" are special to slots
+    $s -grill q
+} -returnCodes error -cleanup {
+    rename $s {}
+} -result {unknown method "-grill": must be -append, -clear, -set, contents or ops}
+
+SampleSlot destroy
+
+test oo-34.1 {TIP 380: slots - presence} -setup {
+    set obj [oo::object new]
+    set result {}
+} -body {
+    oo::define oo::object {
+	::lappend ::result [::info object class filter]
+	::lappend ::result [::info object class mixin]
+	::lappend ::result [::info object class superclass]
+	::lappend ::result [::info object class variable]
+    }
+    oo::objdefine $obj {
+	::lappend ::result [::info object class filter]
+	::lappend ::result [::info object class mixin]
+	::lappend ::result [::info object class variable]
+    }
+    return $result
+} -cleanup {
+    $obj destroy
+} -result {::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot}
+test oo-34.2 {TIP 380: slots - presence} {
+    lsort [info class instances oo::Slot]
+} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
+proc getMethods obj {
+    list [lsort [info object methods $obj -all]] \
+	[lsort [info object methods $obj -private]]
+}
+test oo-34.3 {TIP 380: slots - presence} {
+    getMethods oo::define::filter
+} {{-append -clear -set} {Get Set}}
+test oo-34.4 {TIP 380: slots - presence} {
+    getMethods oo::define::mixin
+} {{-append -clear -set} {--default-operation Get Set}}
+test oo-34.5 {TIP 380: slots - presence} {
+    getMethods oo::define::superclass
+} {{-append -clear -set} {--default-operation Get Set}}
+test oo-34.6 {TIP 380: slots - presence} {
+    getMethods oo::define::variable
+} {{-append -clear -set} {Get Set}}
+test oo-34.7 {TIP 380: slots - presence} {
+    getMethods oo::objdefine::filter
+} {{-append -clear -set} {Get Set}}
+test oo-34.8 {TIP 380: slots - presence} {
+    getMethods oo::objdefine::mixin
+} {{-append -clear -set} {--default-operation Get Set}}
+test oo-34.9 {TIP 380: slots - presence} {
+    getMethods oo::objdefine::variable
+} {{-append -clear -set} {Get Set}}
+
+test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+    oo::class create fruit {
+	method eat {} {}
+    }
+    set result {}
+} -body {
+    lappend result [fruit create ::apple] [info class superclasses fruit]
+    oo::define fruit superclass
+    lappend result [info class superclasses fruit] \
+	[info object class apple oo::object] \
+	[info class call fruit destroy] \
+	[catch { apple }]
+} -cleanup {
+    unset -nocomplain result
+    fruit destroy
+} -result {::apple ::oo::object ::oo::object 1 {{method destroy ::oo::object {core method: "destroy"}}} 1}
+test oo-35.2 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
+    oo::class create fruitMetaclass {
+	superclass oo::class
+	method eat {} {}
+    }
+    set result {}
+} -body {
+    lappend result [fruitMetaclass create ::appleClass] \
+	[appleClass create orange] \
+	[info class superclasses fruitMetaclass]
+    oo::define fruitMetaclass superclass
+    lappend result [info class superclasses fruitMetaclass] \
+	[info object class appleClass oo::class] \
+	[catch { orange }] [info object class orange] \
+	[appleClass create pear]
+} -cleanup {
+    unset -nocomplain result
+    fruitMetaclass destroy
+} -result {::appleClass ::orange ::oo::class ::oo::class 1 1 ::appleClass ::pear}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/ooNext2.test b/tests/ooNext2.test
new file mode 100644
index 0000000..a47aa91
--- /dev/null
+++ b/tests/ooNext2.test
@@ -0,0 +1,788 @@
+# This file contains a collection of tests for Tcl's built-in object system.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 2006-2011 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require TclOO 1.0.1
+package require tcltest 2
+if {"::tcltest" in [namespace children]} {
+    namespace import -force ::tcltest::*
+}
+
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
+
+test oo-nextto-1.1 {basic nextto functionality} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x args {
+	    lappend ::result ==A== $args
+	}
+    }
+    oo::class create B {
+	superclass A
+	method x args {
+	    lappend ::result ==B== $args
+	    nextto A B -> A {*}$args
+	}
+    }
+    oo::class create C {
+	superclass A
+	method x args {
+	    lappend ::result ==C== $args
+	    nextto A C -> A {*}$args
+	}
+    }
+    oo::class create D {
+	superclass B C
+	method x args {
+	    lappend ::result ==D== $args
+	    next foo
+	    nextto C bar
+	}
+    }
+    set ::result {}
+    [D new] x
+    return $::result
+} -cleanup {
+    root destroy
+} -result {==D== {} ==B== foo ==A== {B -> A foo} ==C== bar ==A== {C -> A bar}}
+test oo-nextto-1.2 {basic nextto functionality} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x args {
+	    lappend ::result ==A== $args
+	}
+    }
+    oo::class create B {
+	superclass A
+	method x args {
+	    lappend ::result ==B== $args
+	    nextto A B -> A {*}$args
+	}
+    }
+    oo::class create C {
+	superclass A
+	method x args {
+	    lappend ::result ==C== $args
+	    nextto A C -> A {*}$args
+	}
+    }
+    oo::class create D {
+	superclass B C
+	method x args {
+	    lappend ::result ==D== $args
+	    nextto B foo {*}$args
+	    nextto C bar {*}$args
+	}
+    }
+    set ::result {}
+    [D new] x 123
+    return $::result
+} -cleanup {
+    root destroy
+} -result {==D== 123 ==B== {foo 123} ==A== {B -> A foo 123} ==C== {bar 123} ==A== {C -> A bar 123}}
+test oo-nextto-1.3 {basic nextto functionality: constructors} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	variable result
+	constructor {a c} {
+	    lappend result ==A== a=$a,c=$c
+	}
+    }
+    oo::class create B {
+	superclass root
+	variable result
+	constructor {b} {
+	    lappend result ==B== b=$b
+	}
+    }
+    oo::class create C {
+	superclass A B
+	variable result
+	constructor {p q r} {
+	    lappend result ==C== p=$p,q=$q,r=$r
+	    # Route arguments to superclasses, in non-trival pattern
+	    nextto B $q
+	    nextto A $p $r
+	}
+	method result {} {return $result}
+    }
+    [C new x y z] result
+} -cleanup {
+    root destroy
+} -result {==C== p=x,q=y,r=z ==B== b=y ==A== a=x,c=z}
+test oo-nextto-1.4 {basic nextto functionality: destructors} -setup {
+    oo::class create root {destructor return}
+} -body {
+    oo::class create A {
+	superclass root
+	destructor {
+	    lappend ::result ==A==
+	    next
+	}
+    }
+    oo::class create B {
+	superclass root
+	destructor {
+	    lappend ::result ==B==
+	    next
+	}
+    }
+    oo::class create C {
+	superclass A B
+	destructor {
+	    lappend ::result ==C==
+	    lappend ::result |
+	    nextto B
+	    lappend ::result |
+	    nextto A
+	    lappend ::result |
+	    next
+	}
+    }
+    set ::result ""
+    [C new] destroy
+    return $::result
+} -cleanup {
+    root destroy
+} -result {==C== | ==B== | ==A== ==B== | ==A== ==B==}
+
+test oo-nextto-2.1 {errors in nextto} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x y {error $y}
+    }
+    oo::class create B {
+	superclass A
+	method x y {nextto A $y}
+    }
+    [B new] x boom
+} -cleanup {
+    root destroy
+} -result boom -returnCodes error
+test oo-nextto-2.2 {errors in nextto} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x y {error $y}
+    }
+    oo::class create B {
+	superclass root
+	method x y {nextto A $y}
+    }
+    [B new] x boom
+} -returnCodes error -cleanup {
+    root destroy
+} -result {method has no non-filter implementation by "A"}
+test oo-nextto-2.3 {errors in nextto} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x y {nextto $y}
+    }
+    oo::class create B {
+	superclass A
+	method x y {nextto A $y}
+    }
+    [B new] x B
+} -returnCodes error -cleanup {
+    root destroy
+} -result {method implementation by "B" not reachable from here}
+test oo-nextto-2.4 {errors in nextto} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x y {nextto $y}
+    }
+    oo::class create B {
+	superclass A
+	method x y {nextto}
+    }
+    [B new] x B
+} -returnCodes error -cleanup {
+    root destroy
+} -result {wrong # args: should be "nextto class ?arg...?"}
+test oo-nextto-2.5 {errors in nextto} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x y {nextto $y}
+    }
+    oo::class create B {
+	superclass A
+	method x y {nextto $y $y $y}
+    }
+    [B new] x A
+} -cleanup {
+    root destroy
+} -result {wrong # args: should be "nextto A y"} -returnCodes error
+test oo-nextto-2.6 {errors in nextto} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x y {nextto $y}
+    }
+    oo::class create B {
+	superclass A
+	method x y {nextto $y $y $y}
+    }
+    [B new] x [root create notAClass]
+} -cleanup {
+    root destroy
+} -result {"::notAClass" is not a class} -returnCodes error
+test oo-nextto-2.7 {errors in nextto} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x y {nextto $y}
+    }
+    oo::class create B {
+	superclass A
+	filter Y
+	method Y args {next {*}$args}
+    }
+    oo::class create C {
+	superclass B
+	method x y {nextto $y $y $y}
+    }
+    [C new] x B
+} -returnCodes error -cleanup {
+    root destroy
+} -result {method has no non-filter implementation by "B"}
+
+test oo-call-1.1 {object call introspection} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    A create y
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{method x ::A method}}
+test oo-call-1.2 {object call introspection} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+    }
+    B create y
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{method x ::B method} {method x ::A method}}
+test oo-call-1.3 {object call introspection} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    A create y
+    oo::objdefine y method x {} {}
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{method x object method} {method x ::A method}}
+test oo-call-1.4 {object object call introspection - unknown} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    A create y
+    info object call y z
+} -cleanup {
+    root destroy
+} -result {{unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-1.5 {object call introspection - filters} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+	method y {} {}
+	filter y
+    }
+    A create y
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{filter y ::A method} {method x ::A method}}
+test oo-call-1.6 {object call introspection - filters} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+	method y {} {}
+	filter y
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+    }
+    B create y
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{filter y ::A method} {method x ::B method} {method x ::A method}}
+test oo-call-1.7 {object call introspection - filters} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+	method y {} {}
+	filter y
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+	method y {} {}
+    }
+    B create y
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}}
+test oo-call-1.8 {object call introspection - filters} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+	method y {} {}
+	filter y
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+	method y {} {}
+	method z {} {}
+	filter z
+    }
+    B create y
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method x ::B method} {method x ::A method}}
+test oo-call-1.9 {object call introspection - filters} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+	method y {} {}
+	filter y
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+	method y {} {}
+	method z {} {}
+	filter z
+    }
+    B create y
+    info object call y y
+} -cleanup {
+    root destroy
+} -result {{filter z ::B method} {filter y ::B method} {filter y ::A method} {method y ::B method} {method y ::A method}}
+test oo-call-1.10 {object call introspection - filters + unknown} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method y {} {}
+	filter y
+    }
+    oo::class create ::B {
+	superclass A
+	method y {} {}
+	method unknown {} {}
+    }
+    B create y
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{filter y ::B method} {filter y ::A method} {unknown unknown ::B method} {unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-1.11 {object call introspection - filters + unknown} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method y {} {}
+	filter y
+    }
+    A create y
+    oo::objdefine y method unknown {} {}
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-1.12 {object call introspection - filters + unknown} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method y {} {}
+    }
+    A create y
+    oo::objdefine y {
+	method unknown {} {}
+	filter y
+    }
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{filter y ::A method} {unknown unknown object method} {unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-1.13 {object call introspection - filters + unknown} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method y {} {}
+    }
+    A create y
+    oo::objdefine y {
+	method unknown {} {}
+	method x {} {}
+	filter y
+    }
+    info object call y x
+} -cleanup {
+    root destroy
+} -result {{filter y ::A method} {method x object method}}
+test oo-call-1.14 {object call introspection - errors} -body {
+    info object call
+} -returnCodes error -result {wrong # args: should be "info object call objName methodName"}
+test oo-call-1.15 {object call introspection - errors} -body {
+    info object call a
+} -returnCodes error -result {wrong # args: should be "info object call objName methodName"}
+test oo-call-1.16 {object call introspection - errors} -body {
+    info object call a b c
+} -returnCodes error -result {wrong # args: should be "info object call objName methodName"}
+test oo-call-1.17 {object call introspection - errors} -body {
+    info object call notanobject x
+} -returnCodes error -result {notanobject does not refer to an object}
+test oo-call-1.18 {object call introspection - memory leaks} -body {
+    leaktest {
+	info object call oo::object destroy
+    }
+} -constraints memory -result 0
+test oo-call-1.19 {object call introspection - memory leaks} -setup {
+    oo::class create leaktester { method foo {} {dummy} }
+} -body {
+    leaktest {
+	set lt [leaktester new]
+	oo::objdefine $lt method foobar {} {dummy}
+	list [info object call $lt destroy] \
+	    [info object call $lt foo] \
+	    [info object call $lt bar] \
+	    [info object call $lt foobar] \
+	    [$lt destroy]
+    }
+} -cleanup {
+    leaktester destroy
+} -constraints memory -result 0
+
+test oo-call-2.1 {class call introspection} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    info class call A x
+} -cleanup {
+    root destroy
+} -result {{method x ::A method}}
+test oo-call-2.2 {class call introspection} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+    }
+    list [info class call A x] [info class call B x]
+} -cleanup {
+    root destroy
+} -result {{{method x ::A method}} {{method x ::B method} {method x ::A method}}}
+test oo-call-2.3 {class call introspection} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+    }
+    oo::class create ::C {
+	superclass A
+	method x {} {}
+    }
+    oo::class create ::D {
+	superclass C B
+	method x {} {}
+    }
+    info class call D x
+} -cleanup {
+    root destroy
+} -result {{method x ::D method} {method x ::C method} {method x ::B method} {method x ::A method}}
+test oo-call-2.4 {class call introspection - mixin} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+    }
+    oo::class create ::C {
+	superclass A
+	method x {} {}
+    }
+    oo::class create ::D {
+	superclass C
+	mixin B
+	method x {} {}
+    }
+    info class call D x
+} -cleanup {
+    root destroy
+} -result {{method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}}
+test oo-call-2.5 {class call introspection - mixin + filter} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+	method y {} {}
+	filter y
+    }
+    oo::class create ::C {
+	superclass A
+	method x {} {}
+	method y {} {}
+    }
+    oo::class create ::D {
+	superclass C
+	mixin B
+	method x {} {}
+    }
+    info class call D x
+} -cleanup {
+    root destroy
+} -result {{filter y ::B method} {filter y ::C method} {method x ::B method} {method x ::D method} {method x ::C method} {method x ::A method}}
+test oo-call-2.6 {class call introspection - mixin + filter + unknown} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+	method unknown {} {}
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+	method y {} {}
+	filter y
+    }
+    oo::class create ::C {
+	superclass A
+	method x {} {}
+	method y {} {}
+    }
+    oo::class create ::D {
+	superclass C
+	mixin B
+	method x {} {}
+	method unknown {} {}
+    }
+    info class call D z
+} -cleanup {
+    root destroy
+} -result {{filter y ::B method} {filter y ::C method} {unknown unknown ::D method} {unknown unknown ::A method} {unknown unknown ::oo::object {core method: "unknown"}}}
+test oo-call-2.7 {class call introspection - mixin + filter + unknown} -setup {
+    oo::class create root
+} -body {
+    oo::class create ::A {
+	superclass root
+	method x {} {}
+    }
+    oo::class create ::B {
+	superclass A
+	method x {} {}
+	filter x
+    }
+    info class call B x
+} -cleanup {
+    root destroy
+} -result {{filter x ::B method} {filter x ::A method} {method x ::B method} {method x ::A method}}
+test oo-call-2.8 {class call introspection - errors} -body {
+    info class call
+} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
+test oo-call-2.9 {class call introspection - errors} -body {
+    info class call a
+} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
+test oo-call-2.10 {class call introspection - errors} -body {
+    info class call a b c
+} -returnCodes error -result {wrong # args: should be "info class call className methodName"}
+test oo-call-2.11 {class call introspection - errors} -body {
+    info class call notaclass x
+} -returnCodes error -result {notaclass does not refer to an object}
+test oo-call-2.12 {class call introspection - errors} -setup {
+    oo::class create root
+} -body {
+    root create notaclass
+    info class call notaclass x
+} -returnCodes error -cleanup {
+    root destroy
+} -result {"notaclass" is not a class}
+test oo-call-2.13 {class call introspection - memory leaks} -body {
+    leaktest {
+	info class call oo::class destroy
+    }
+} -constraints memory -result 0
+test oo-call-2.14 {class call introspection - memory leaks} -body {
+    leaktest {
+	oo::class create leaktester { method foo {} {dummy} }
+	[leaktester new] destroy
+	list [info class call leaktester destroy] \
+	    [info class call leaktester foo] \
+	    [info class call leaktester bar] \
+	    [leaktester destroy]
+    }
+} -constraints memory -result 0
+
+test oo-call-3.1 {current call introspection} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	method x {} {lappend ::result [self call]}
+    }
+    oo::class create B {
+	superclass A
+	method x {} {lappend ::result [self call];next}
+    }
+    B create y
+    oo::objdefine y method x {} {lappend ::result [self call];next}
+    set ::result {}
+    y x
+} -cleanup {
+    root destroy
+} -result {{{{method x object method} {method x ::B method} {method x ::A method}} 0} {{{method x object method} {method x ::B method} {method x ::A method}} 1} {{{method x object method} {method x ::B method} {method x ::A method}} 2}}
+test oo-call-3.2 {current call introspection} -setup {
+    oo::class create root
+} -constraints memory -body {
+    oo::class create A {
+	superclass root
+	method x {} {self call}
+    }
+    oo::class create B {
+	superclass A
+	method x {} {self call;next}
+    }
+    B create y
+    oo::objdefine y method x {} {self call;next}
+    leaktest {
+	y x
+    }
+} -cleanup {
+    root destroy
+} -result 0
+test oo-call-3.3 {current call introspection: in constructors} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	constructor {} {lappend ::result [self call]}
+    }
+    oo::class create B {
+	superclass A
+	constructor {} {lappend ::result [self call]; next}
+    }
+    set ::result {}
+    [B new] destroy
+    return $::result
+} -cleanup {
+    root destroy
+} -result {{{{method <constructor> ::B method} {method <constructor> ::A method}} 0} {{{method <constructor> ::B method} {method <constructor> ::A method}} 1}}
+test oo-call-3.4 {current call introspection: in destructors} -setup {
+    oo::class create root
+} -body {
+    oo::class create A {
+	superclass root
+	destructor {lappend ::result [self call]}
+    }
+    oo::class create B {
+	superclass A
+	destructor {lappend ::result [self call]; next}
+    }
+    set ::result {}
+    [B new] destroy
+    return $::result
+} -cleanup {
+    root destroy
+} -result {{{{method <destructor> ::B method} {method <destructor> ::A method}} 0} {{{method <destructor> ::B method} {method <destructor> ::A method}} 1}}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/opt.test b/tests/opt.test
index b7e3a55..2732d40 100644
--- a/tests/opt.test
+++ b/tests/opt.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: opt.test,v 1.9 2004/05/19 12:48:32 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -19,7 +17,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 # the package we are going to test
-package require opt 0.4.1
+package require opt 0.4.6
 
 # we are using implementation specifics to test the package
 
@@ -58,7 +56,7 @@ test opt-3.2 {OptParse / temp key is removed even on errors} {
 
 test opt-4.1 {OptProc} {
     ::tcl::OptProc optTest {} {}
-    optTest ;
+    optTest
     ::tcl::OptKeyDelete optTest
 } {}
 
@@ -74,12 +72,12 @@ test opt-5.1 {OptProcArgGiven} {
 } {0 1 1 1}
 
 test opt-6.1 {OptKeyParse} {
-    ::tcl::OptKeyRegister {} test;
+    ::tcl::OptKeyRegister {} test
     list [catch {::tcl::OptKeyParse test {-help}} msg] $msg
 } {1 {Usage information:
     Var/FlagName Type Value Help
     ------------ ---- ----- ----
-    ( -help                 gives this help )}}
+    (-help                  gives this help)}}
 
 test opt-7.1 {OptCheckType} {
     list \
@@ -161,9 +159,9 @@ test opt-10.1 {ambigous flags} {
     catch {optTest -fL} msg
     set msg
 } {ambigous option "-fL", choose from:
-    -fla      boolflag (false) 
-    -flag2xyz boolflag (false) 
-    -flag3xyz boolflag (false) }
+    -fla      boolflag (false)
+    -flag2xyz boolflag (false)
+    -flag3xyz boolflag (false)}
 test opt-10.2 {non ambigous flags} {
     ::tcl::OptProc optTest {{-flag1xyz} {-other} {-flag2xyz} {-flag3xyz}} {
 	return $flag2xyz
@@ -183,8 +181,8 @@ test opt-10.4 {ambigous flags, not exact match} {
     catch {optTest -fLag1X} msg
     set msg
 } {ambigous option "-fLag1X", choose from:
-    -flag1xy  boolflag (false) 
-    -flag1xyz boolflag (false) }
+    -flag1xy  boolflag (false)
+    -flag1xyz boolflag (false)}
 
 # medium size overall test example: (defined once)
 ::tcl::OptProc optTest {
@@ -206,12 +204,12 @@ test opt-10.6 {medium size overall test} {
 } {1 {Usage information:
     Var/FlagName Type     Value   Help
     ------------ ----     -----   ----
-    ( -help                       gives this help )
+    (-help                        gives this help)
     cmd          choice   (print save delete) sub command to choose
-    -allowBoing  boolean  (true)  
+    -allowBoing  boolean  (true)
     arg2         string   ()      this is help
     ?arg3?       int      (7)     optional number
-    -moreflags   boolflag (false) }}
+    -moreflags   boolflag (false)}}
 test opt-10.7 {medium size overall test} {
     optTest save tst
 } {save 1 tst 7 0}
@@ -232,8 +230,8 @@ test opt-11.1 {too many args test 2} {
 } {1 {too many arguments (unexpected argument(s): blah), usage:
     Var/FlagName Type     Value   Help
     ------------ ----     -----   ----
-    ( -help                       gives this help )
-    -foo         boolflag (false) } {}}
+    (-help                        gives this help)
+    -foo         boolflag (false)} {}}
 test opt-11.2 {default value for args} {
     set args {}
     set key [::tcl::OptKeyRegister {{args -list {a b c} "args..."}}]
diff --git a/tests/package.test b/tests/package.test
index eb24e99..da778f1 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -1,38 +1,51 @@
-# This file contains tests for the ::package::* commands.
+# This file contains tests for the package and ::pkg::* commands.
 # Note that the tests are limited to Tcl scripts only, there are no shared
 # libraries against which to 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) 1995-1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
+# Copyright (c) 2011 Donal K. Fellows
 #
-# RCS: @(#) $Id: package.test,v 1.3 2000/04/10 17:19:02 ericm Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.3.3
     namespace import -force ::tcltest::*
 }
 
-test package-1.1 {pkg::create gives error on insufficient args} {
-    catch {::pkg::create}
-} 1
-test package-1.2 {pkg::create gives error on bad args} {
-    catch {::pkg::create -foo bar -bar baz -baz boo}
-} 1
-test package-1.3 {pkg::create gives error on no value given} {
-    catch {::pkg::create -name foo -version 1.0 -source test.tcl -load}
-} 1
-test package-1.4 {pkg::create gives error on no name given} {
-    catch {::pkg::create -version 1.0 -source test.tcl -load foo.so}
-} 1
-test package-1.5 {pkg::create gives error on no version given} {
-    catch {::pkg::create -name foo -source test.tcl -load foo.so}
-} 1
-test package-1.6 {pkg::create gives error on no source or load options} {
-    catch {::pkg::create -name foo -version 1.0 -version 2.0}
-} 1
+# Do all this in a slave interp to avoid garbaging the package list
+set i [interp create]
+tcltest::loadIntoSlaveInterpreter $i {*}$argv
+interp eval $i {
+namespace import -force ::tcltest::*
+package forget {*}[package names]
+set oldPkgUnknown [package unknown]
+package unknown {}
+set oldPath $auto_path
+set auto_path ""
+
+test package-1.1 {pkg::create gives error on insufficient args} -body {
+    ::pkg::create
+} -returnCodes error -match glob -result {wrong # args: should be "*"}
+test package-1.2 {pkg::create gives error on bad args} -body {
+    ::pkg::create -foo bar -bar baz -baz boo
+} -returnCodes error -match glob -result {unknown option "bar": *}
+test package-1.3 {pkg::create gives error on no value given} -body {
+    ::pkg::create -name foo -version 1.0 -source test.tcl -load
+} -returnCodes error -match glob -result {value for "-load" missing: *}
+test package-1.4 {pkg::create gives error on no name given} -body {
+    ::pkg::create -version 1.0 -source test.tcl -load foo.so
+} -returnCodes error -match glob -result {value for "-name" missing: *}
+test package-1.5 {pkg::create gives error on no version given} -body {
+    ::pkg::create -name foo -source test.tcl -load foo.so
+} -returnCodes error -match glob -result {value for "-version" missing: *}
+test package-1.6 {pkg::create gives error on no source or load options} -body {
+    ::pkg::create -name foo -version 1.0 -version 2.0
+} -returnCodes error -result {at least one of -load and -source must be given}
 test package-1.7 {pkg::create gives correct output for 1 direct source} {
     ::pkg::create -name foo -version 1.0 -source test.tcl
 } {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]}
@@ -67,5 +80,1200 @@ test package-1.16 {pkg::create gives correct output for 1 direct, 1 lazy} {
 	    -source {test2.tcl {foo bar}}
 } {package ifneeded foo 1.0 [list source [file join $dir test.tcl]]\n[list tclPkgSetup $dir foo 1.0 {{test2.tcl source {foo bar}}}]}
 
+test package-2.1 {Tcl_PkgProvide procedure} {
+    package forget t
+    package provide t 2.3
+} {}
+test package-2.2 {Tcl_PkgProvide procedure} -returnCodes error -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package provide t 2.2
+} -result {conflicting versions provided for package "t": 2.3, then 2.2}
+test package-2.3 {Tcl_PkgProvide procedure} -returnCodes error -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package provide t 2.4
+} -result {conflicting versions provided for package "t": 2.3, then 2.4}
+test package-2.4 {Tcl_PkgProvide procedure} -returnCodes error -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package provide t 3.3
+} -result {conflicting versions provided for package "t": 2.3, then 3.3}
+test package-2.5 {Tcl_PkgProvide procedure} -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package provide t 2.3
+} -result {}
+test package-2.6 {Tcl_PkgProvide procedure} {
+    package forget t
+    package provide t 2.3a1
+} {}
+
+set n 0
+foreach v {
+    2.3k1 2a3a2 2ab3 2.a4 2.b4 2b.4 2a.4 2ba4 2a4b1
+    2b4a1 2b3b2
+} {
+    test package-2.7.$n {Tcl_PkgProvide procedure} -setup {
+	package forget t
+    } -returnCodes error -body "
+	package provide t $v
+    " -result "expected version number but got \"$v\""
+    incr n
+}
+
+test package-3.1 {Tcl_PkgRequire procedure, picking best version} -setup {
+    package forget t
+    set x xxx
+} -body {
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    package require t
+    return $x
+} -result {3.4}
+test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
+    package forget t
+    set x xxx
+} -body {
+    foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    package require t
+    return $x
+} -result {3.5}
+test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
+    package forget t
+    set x xxx
+} -body {
+    foreach i {3.5 2.1 2.3} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    package require t 2.2
+    return $x
+} -result {2.3}
+test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
+    package forget t
+    set x xxx
+} -body {
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    package require -exact t 2.3
+    return $x
+} -result {2.3}
+test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
+    package forget t
+    set x xxx
+} -body {
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    package require t 2.1
+    return $x
+} -result {2.4}
+test package-3.6 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
+    package forget t
+} -returnCodes error -body {
+    package unknown {}
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    package require t 2.5
+} -result {can't find package t 2.5}
+test package-3.7 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
+    package forget t
+} -returnCodes error -body {
+    package unknown {}
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    package require t 4.1
+} -result {can't find package t 4.1}
+test package-3.8 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
+    package forget t
+} -returnCodes error -body {
+    package unknown {}
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    package require -exact t 1.3
+} -result {can't find package t exactly 1.3}
+test package-3.9 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
+    package forget t
+} -returnCodes error -body {
+    package unknown {}
+    package require t
+} -result {can't find package t}
+test package-3.10 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
+    package forget t
+} -body {
+    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
+    list [catch {package require t 2.1} msg] $msg $::errorInfo
+} -match glob -result {1 {ifneeded test} {ifneeded test
+    while executing
+"error "ifneeded test""
+    ("package ifneeded*" script)
+    invoked from within
+"package require t 2.1"}}
+test package-3.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} -setup {
+    package forget t
+    set x xxx
+} -body {
+    package ifneeded t 2.1 "set x invoked"
+    list [catch {package require t 2.1} msg] $msg $x
+} -match glob -result {1 * invoked}
+test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup {
+    package forget t
+    set x xxx
+} -body {
+    package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
+    package require t 1.2
+    return $x
+} -result {1.2}
+test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
+    package forget t
+    set x xxx
+} -body {
+    proc pkgUnknown args {
+	# args = name requirement
+	# requirement = v-v (for exact version)
+	global x
+	set x $args
+	package provide [lindex $args 0] [lindex [split [lindex $args 1] -] 0]
+    }
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    package unknown pkgUnknown
+    package require -exact t 1.5
+    return $x
+} -cleanup {
+    package unknown {}
+} -result {t 1.5-1.5}
+test package-3.14 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
+    package forget t
+    set x xxx
+} -body {
+    proc pkgUnknown args {
+	package ifneeded t 1.2 "set x loaded; package provide t 1.2"
+    }
+    package unknown pkgUnknown
+    list [package require t] $x
+} -cleanup {
+    package unknown {}
+} -result {1.2 loaded}
+test package-3.15 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
+    package forget {a b}
+    package unknown pkgUnknown
+    set x xxx
+} -body {
+    proc pkgUnknown args {
+	global x
+	set x $args
+	package provide [lindex $args 0] 2.0
+    }
+    package require {a b}
+    return $x
+} -cleanup {
+    package unknown {}
+} -result {{a b} 0-}
+test package-3.16 {Tcl_PkgRequire procedure, "package unknown" error} -setup {
+    package forget t
+} -body {
+    proc pkgUnknown args {
+	error "testing package unknown"
+    }
+    package unknown pkgUnknown
+    list [catch {package require t} msg] $msg $::errorInfo
+} -cleanup {
+    package unknown {}
+} -result {1 {testing package unknown} {testing package unknown
+    while executing
+"error "testing package unknown""
+    (procedure "pkgUnknown" line 2)
+    invoked from within
+"pkgUnknown t 0-"
+    ("package unknown" script)
+    invoked from within
+"package require t"}}
+test package-3.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} -setup {
+    package forget t
+    set x xxx
+} -body {
+    proc pkgUnknown args {
+	global x
+	set x $args
+    }
+    foreach i {1.4 3.4 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i"
+    }
+    package unknown pkgUnknown
+    list [catch {package require -exact t 1.5} msg] $msg $x
+} -cleanup {
+    package unknown {}
+} -result {1 {can't find package t exactly 1.5} {t 1.5-1.5}}
+test package-3.18 {Tcl_PkgRequire procedure, version checks} -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package require t
+} -result {2.3}
+test package-3.19 {Tcl_PkgRequire procedure, version checks} -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package require t 2.1
+} -result {2.3}
+test package-3.20 {Tcl_PkgRequire procedure, version checks} -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package require t 2.3
+} -result {2.3}
+test package-3.21 {Tcl_PkgRequire procedure, version checks} -setup {
+    package forget t
+} -returnCodes error -body {
+    package provide t 2.3
+    package require t 2.4
+} -result {version conflict for package "t": have 2.3, need 2.4}
+test package-3.22 {Tcl_PkgRequire procedure, version checks} -setup {
+    package forget t
+} -returnCodes error -body {
+    package provide t 2.3
+    package require t 1.2
+} -result {version conflict for package "t": have 2.3, need 1.2}
+test package-3.23 {Tcl_PkgRequire procedure, version checks} -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package require -exact t 2.3
+} -result {2.3}
+test package-3.24 {Tcl_PkgRequire procedure, version checks} -setup {
+    package forget t
+} -returnCodes error -body {
+    package provide t 2.3
+    package require -exact t 2.2
+} -result {version conflict for package "t": have 2.3, need exactly 2.2}
+test package-3.25 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
+    package forget t
+} -body {
+    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
+    list [catch {package require t 2.1} msg] $msg $::errorInfo
+} -match glob -result {1 {ifneeded test} {EI
+    ("package ifneeded*" script)
+    invoked from within
+"package require t 2.1"}}
+test package-3.26 {Tcl_PkgRequire procedure, error in ifneeded script} -setup {
+    package forget t
+} -body {
+    package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
+    list [catch {package require t 2.1} msg] $msg $::errorInfo
+} -match glob -result {1 {ifneeded test} {EI
+    ("foreach" body line 1)
+    invoked from within
+"foreach x 1 {error "ifneeded test" EI}"
+    ("package ifneeded*" script)
+    invoked from within
+"package require t 2.1"}}
+test package-3.27 {Tcl_PkgRequire: circular dependency} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {package require foo 1}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob -result {circular package dependency:*}
+test package-3.28 {Tcl_PkgRequire: circular dependency} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {package require foo 2}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob -result {circular package dependency:*}
+test package-3.29 {Tcl_PkgRequire: circular dependency} -setup {
+    package forget foo
+    package forget bar
+} -body {
+    package ifneeded foo 1 {package require bar 1; package provide foo 1}
+    package ifneeded bar 1 {package require foo 1; package provide bar 1}
+    package require foo 1
+} -cleanup {
+    package forget foo
+    package forget bar
+} -returnCodes error -match glob -result {circular package dependency:*}
+test package-3.30 {Tcl_PkgRequire: circular dependency} -setup {
+    package forget foo
+    package forget bar
+} -body {
+    package ifneeded foo 1 {package require bar 1; package provide foo 1}
+    package ifneeded foo 2 {package provide foo 2}
+    package ifneeded bar 1 {package require foo 2; package provide bar 1}
+    package require foo 1
+} -cleanup {
+    package forget foo
+    package forget bar
+} -returnCodes error -match glob -result {circular package dependency:*}
+test package-3.31 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {package provide foo 1; error foo}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob -result foo
+test package-3.32 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {package provide foo 1; error foo}
+    catch {package require foo 1}
+    package provide foo
+} -cleanup {
+    package forget foo
+} -result {}
+test package-3.33 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {package provide foo 2}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.34 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {package provide foo 1.1}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.34.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1.1 {package provide foo 1}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.34.2 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1.1 {package provide foo 1}
+    package require foo 1.1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.35 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob -result {attempt to provide package * failed:*}
+test package-3.35.1 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {break}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test package-3.36 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {continue}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test package-3.37 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {return}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test package-3.38 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+} -body {
+    package ifneeded foo 1 {return -level 0 -code 10}
+    package require foo 1
+} -cleanup {
+    package forget foo
+} -returnCodes error -match glob \
+-result {attempt to provide package * failed: bad return code:*}
+test package-3.39 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+    set saveUnknown [package unknown]
+    package unknown {package provide foo 2 ;#}
+} -body {
+    package require foo 1
+} -cleanup {
+    package forget foo
+    package unknown $saveUnknown
+} -returnCodes error -match glob -result *
+test package-3.40 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+    set saveUnknown [package unknown]
+    package unknown {break ;#}
+} -body {
+    package require foo 1
+} -cleanup {
+    package forget foo
+    package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test package-3.41 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+    set saveUnknown [package unknown]
+    package unknown {continue ;#}
+} -body {
+    package require foo 1
+} -cleanup {
+    package forget foo
+    package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test package-3.42 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+    set saveUnknown [package unknown]
+    package unknown {return ;#}
+} -body {
+    package require foo 1
+} -cleanup {
+    package forget foo
+    package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test package-3.43 {Tcl_PkgRequire: consistent return values (1162286)} -setup {
+    package forget foo
+    set saveUnknown [package unknown]
+    package unknown {return -level 0 -code 10 ;#}
+} -body {
+    package require foo 1
+} -cleanup {
+    package forget foo
+    package unknown $saveUnknown
+} -returnCodes error -match glob -result {bad return code:*}
+test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
+    package provide demo 1.2.3
+} -body {
+    package require -exact demo 1.2
+} -returnCodes error -cleanup {
+    package forget demo
+} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
+test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -setup {
+    package forget t
+    set x xxx
+} -body {
+    foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    package require t
+    return $x
+} -result {3.4}
+test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup {
+    package forget t
+    set x xxx
+} -body {
+    foreach i {1.2b1 1.2 1.3a2 1.3} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    package require t
+    return $x
+} -result {1.3}
+test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup {
+    package forget t
+    set x xxx
+} -body {
+    foreach i {1.2b1 1.2 1.3 1.3a2} {
+	package ifneeded t $i "set x $i; package provide t $i"
+    }
+    package require t
+    return $x
+} -result {1.3}
+
+test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
+    package
+} -result {wrong # args: should be "package option ?arg ...?"}
+test package-4.2 {Tcl_PackageCmd procedure, "forget" option} {
+    package forget {*}[package names]
+    package names
+} {}
+test package-4.3 {Tcl_PackageCmd procedure, "forget" option} {
+    package forget {*}[package names]
+    package forget foo
+} {}
+test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup {
+    package forget {*}[package names]
+    set result {}
+} -body {
+    package ifneeded t 1.1 {first script}
+    package ifneeded t 2.3 {second script}
+    package ifneeded x 1.4 {x's script}
+    lappend result [lsort [package names]] [package versions t]
+    package forget t
+    lappend result [lsort [package names]] [package versions t]
+} -result {{t x} {1.1 2.3} x {}}
+test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {
+    package forget {*}[package names]
+} -body {
+    package ifneeded a 1.1 {first script}
+    package ifneeded b 2.3 {second script}
+    package ifneeded c 1.4 {third script}
+    package forget
+    set result [list [lsort [package names]]]
+    package forget a c
+    lappend result [lsort [package names]]
+} -result {{a b c} b}
+test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body {
+    # Test for Bug 415273
+    package ifneeded a 1 "I should have been forgotten"
+    package forget no-such-package a
+    package ifneeded a 1
+} -cleanup {
+    package forget a
+} -result {}
+test package-4.6 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
+    package ifneeded a
+} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
+test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
+    package ifneeded a b c d
+} -returnCodes error -result {wrong # args: should be "package ifneeded package version ?script?"}
+test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
+    package ifneeded t xyz
+} -returnCodes error -result {expected version number but got "xyz"}
+test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
+    package forget {*}[package names]
+    list [package ifneeded foo 1.1] [package names]
+} {{} {}}
+test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+    package forget t
+} -body {
+    package ifneeded t 1.4 "script for t 1.4"
+    list [package names] [package ifneeded t 1.4] [package versions t]
+} -result {t {script for t 1.4} 1.4}
+test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+    package forget t
+} -body {
+    package ifneeded t 1.4 "script for t 1.4"
+    list [package ifneeded t 1.5] [package names] [package versions t]
+} -result {{} t 1.4}
+test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+    package forget t
+} -body {
+    package ifneeded t 1.4 "script for t 1.4"
+    package ifneeded t 1.4 "second script for t 1.4"
+    list [package ifneeded t 1.4] [package names] [package versions t]
+} -result {{second script for t 1.4} t 1.4}
+test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+    package forget t
+} -body {
+    package ifneeded t 1.4 "script for t 1.4"
+    package ifneeded t 1.2 "second script"
+    package ifneeded t 3.1 "last script"
+    list [package ifneeded t 1.2] [package versions t]
+} -result {{second script} {1.4 1.2 3.1}}
+test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body {
+    package names a
+} -returnCodes error -result {wrong # args: should be "package names"}
+test package-4.15 {Tcl_PackageCmd procedure, "names" option} {
+    package forget {*}[package names]
+    package names
+} {}
+test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup {
+    package forget {*}[package names]
+} -body {
+    package ifneeded x 1.2 {dummy}
+    package provide x 1.3
+    package provide y 2.4
+    catch {package require z 47.16}
+    lsort [package names]
+} -result {x y}
+test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body {
+    package provide
+} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
+test package-4.18 {Tcl_PackageCmd procedure, "provide" option} -body {
+    package provide a b c
+} -returnCodes error -result {wrong # args: should be "package provide package ?version?"}
+test package-4.19 {Tcl_PackageCmd procedure, "provide" option} -setup {
+    package forget t
+} -body {
+    package provide t
+} -result {}
+test package-4.20 {Tcl_PackageCmd procedure, "provide" option} -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package provide t
+} -result {2.3}
+test package-4.21 {Tcl_PackageCmd procedure, "provide" option} -setup {
+    package forget t
+} -returnCodes error -body {
+    package provide t a.b
+} -result {expected version number but got "a.b"}
+test package-4.22 {Tcl_PackageCmd procedure, "require" option} -returnCodes error -body {
+    package require
+} -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
+test package-4.24 {Tcl_PackageCmd procedure, "require" option} -body {
+    package require -exact a b c
+    # Exact syntax: -exact name version
+    #              name ?requirement ...?
+} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
+test package-4.26 {Tcl_PackageCmd procedure, "require" option} -body {
+    package require x a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-4.27 {Tcl_PackageCmd procedure, "require" option} -body {
+    package require -exact x a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-4.28 {Tcl_PackageCmd procedure, "require" option} -body {
+    package require -exact x
+} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
+test package-4.29 {Tcl_PackageCmd procedure, "require" option} -body {
+    package require -exact
+} -returnCodes error -result {wrong # args: should be "package require ?-exact? package ?requirement ...?"}
+test package-4.30 {Tcl_PackageCmd procedure, "require" option} -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package require t 2.1
+} -result {2.3}
+test package-4.31 {Tcl_PackageCmd procedure, "require" option} -setup {
+    package forget t
+} -body {
+    package require t
+} -returnCodes error -result {can't find package t}
+test package-4.32 {Tcl_PackageCmd procedure, "require" option} -setup {
+    package forget t
+} -body {
+    package ifneeded t 2.3 "error {synthetic error}"
+    package require t 2.3
+} -returnCodes error -result {synthetic error}
+test package-4.33 {Tcl_PackageCmd procedure, "unknown" option} -body {
+    package unknown a b
+} -returnCodes error -result {wrong # args: should be "package unknown ?command?"}
+test package-4.34 {Tcl_PackageCmd procedure, "unknown" option} {
+    package unknown "test script"
+    package unknown
+} {test script}
+test package-4.35 {Tcl_PackageCmd procedure, "unknown" option} {
+    package unknown "test script"
+    package unknown {}
+    package unknown
+} {}
+test package-4.36 {Tcl_PackageCmd procedure, "vcompare" option} -body {
+    package vcompare a
+} -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"}
+test package-4.37 {Tcl_PackageCmd procedure, "vcompare" option} -body {
+    package vcompare a b c
+} -returnCodes error -result {wrong # args: should be "package vcompare version1 version2"}
+test package-4.38 {Tcl_PackageCmd procedure, "vcompare" option} -body {
+    package vcompare x.y 3.4
+} -returnCodes error -result {expected version number but got "x.y"}
+test package-4.39 {Tcl_PackageCmd procedure, "vcompare" option} -body {
+    package vcompare 2.1 a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-4.40 {Tcl_PackageCmd procedure, "vcompare" option} {
+    package vc 2.1 2.3
+} {-1}
+test package-4.41 {Tcl_PackageCmd procedure, "vcompare" option} {
+    package vc 2.2.4 2.2.4
+} {0}
+test package-4.42 {Tcl_PackageCmd procedure, "versions" option} -body {
+    package versions
+} -returnCodes error -result {wrong # args: should be "package versions package"}
+test package-4.43 {Tcl_PackageCmd procedure, "versions" option} -body {
+    package versions a b
+} -returnCodes error -result {wrong # args: should be "package versions package"}
+test package-4.44 {Tcl_PackageCmd procedure, "versions" option} -body {
+    package forget t
+    package versions t
+} -result {}
+test package-4.45 {Tcl_PackageCmd procedure, "versions" option} -setup {
+    package forget t
+} -body {
+    package provide t 2.3
+    package versions t
+} -result {}
+test package-4.46 {Tcl_PackageCmd procedure, "versions" option} -setup {
+    package forget t
+} -body {
+    package ifneeded t 2.3 x
+    package ifneeded t 2.4 y
+    package versions t
+} -result {2.3 2.4}
+test package-4.47 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+    package vsatisfies a
+} -returnCodes error -result {wrong # args: should be "package vsatisfies version ?requirement ...?"}
+test package-4.49 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+    package vsatisfies x.y 3.4
+} -returnCodes error -result {expected version number but got "x.y"}
+test package-4.50 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+    package vcompare 2.1 a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-4.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    package vs 2.3 2.1
+} {1}
+test package-4.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
+    package vs 2.3 1.2
+} {0}
+test package-4.53 {Tcl_PackageCmd procedure, "versions" option} -body {
+    package foo
+} -returnCodes error -result {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}
+test package-4.54 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+    package vsatisfies 2.1 2.1-3.2-4.5
+} -returnCodes error -result {expected versionMin-versionMax but got "2.1-3.2-4.5"}
+test package-4.55 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+    package vsatisfies 2.1 3.2-x.y
+} -returnCodes error -result {expected version number but got "x.y"}
+test package-4.56 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
+    package vsatisfies 2.1 x.y-3.2
+} -returnCodes error -result {expected version number but got "x.y"}
+
+# No tests for FindPackage; can't think up anything detectable errors.
+
+test package-5.1 {TclFreePackageInfo procedure} {
+    interp create slave
+    slave eval {
+	package ifneeded t 2.3 x
+	package ifneeded t 2.4 y
+	package ifneeded x 3.1 z
+	package provide q 4.3
+	package unknown "will this get freed?"
+    }
+    interp delete slave
+} {}
+test package-5.2 {TclFreePackageInfo procedure} -body {
+    interp create foo
+    foo eval {
+	package ifneeded t 2.3 x
+	package ifneeded t 2.4 y
+	package ifneeded x 3.1 z
+	package provide q 4.3
+    }
+    foo alias z kill
+    proc kill {} {
+	interp delete foo
+    }
+    foo eval package require x 3.1
+} -returnCodes error -match glob -result *
+
+test package-6.1 {CheckVersion procedure} {
+    package vcompare 1 2.1
+} -1
+test package-6.2 {CheckVersion procedure} -body {
+    package vcompare .1 2.1
+} -returnCodes error -result {expected version number but got ".1"}
+test package-6.3 {CheckVersion procedure} -body {
+    package vcompare 111.2a.3 2.1
+} -returnCodes error -result {expected version number but got "111.2a.3"}
+test package-6.4 {CheckVersion procedure} -body {
+    package vcompare 1.2.3. 2.1
+} -returnCodes error -result {expected version number but got "1.2.3."}
+test package-6.5 {CheckVersion procedure} -body {
+    package vcompare 1.2..3 2.1
+} -returnCodes error -result {expected version number but got "1.2..3"}
+
+test package-7.1 {ComparePkgVersions procedure} {
+    package vcompare 1.23 1.22
+} {1}
+test package-7.2 {ComparePkgVersions procedure} {
+    package vcompare 1.22.1.2.3 1.22.1.2.3
+} {0}
+test package-7.3 {ComparePkgVersions procedure} {
+    package vcompare 1.21 1.22
+} {-1}
+test package-7.4 {ComparePkgVersions procedure} {
+    package vcompare 1.21 1.21.2
+} {-1}
+test package-7.5 {ComparePkgVersions procedure} {
+    package vcompare 1.21.1 1.21
+} {1}
+test package-7.6 {ComparePkgVersions procedure} {
+    package vsatisfies 1.21.1 1.21
+} {1}
+test package-7.7 {ComparePkgVersions procedure} {
+    package vsatisfies 2.22.3 1.21
+} {0}
+test package-7.8 {ComparePkgVersions procedure} {
+    package vsatisfies 1 1
+} {1}
+test package-7.9 {ComparePkgVersions procedure} {
+    package vsatisfies 2 1
+} {0}
+
+test package-8.1 {Tcl_PkgPresent procedure, any version} -setup {
+    package forget t
+} -body {
+    package provide t 2.4
+    package present t
+} -result {2.4}
+test package-8.2 {Tcl_PkgPresent procedure, correct version} -setup {
+    package forget t
+} -body {
+    package provide t 2.4
+    package present t 2.4
+} -result {2.4}
+test package-8.3 {Tcl_PkgPresent procedure, satisfying version} -setup {
+    package forget t
+} -body {
+    package provide t 2.4
+    package present t 2.0
+} -result {2.4}
+test package-8.4 {Tcl_PkgPresent procedure, not satisfying version} -setup {
+    package forget t
+} -returnCodes error -body {
+    package provide t 2.4
+    package present t 2.6
+} -result {version conflict for package "t": have 2.4, need 2.6}
+test package-8.5 {Tcl_PkgPresent procedure, not satisfying version} -setup {
+    package forget t
+} -returnCodes error -body {
+    package provide t 2.4
+    package present t 1.0
+} -result {version conflict for package "t": have 2.4, need 1.0}
+test package-8.6 {Tcl_PkgPresent procedure, exact version} -setup {
+    package forget t
+} -body {
+    package provide t 2.4
+    package present -exact t 2.4
+} -result {2.4}
+test package-8.7 {Tcl_PkgPresent procedure, not exact version} -setup {
+    package forget t
+} -returnCodes error -body {
+    package provide t 2.4
+    package present -exact t 2.3
+} -result {version conflict for package "t": have 2.4, need exactly 2.3}
+test package-8.8 {Tcl_PkgPresent procedure, unknown package} -body {
+    package forget t
+    package present t
+} -returnCodes error -result {package t is not present}
+test package-8.9 {Tcl_PkgPresent procedure, unknown package} -body {
+    package forget t
+    package present t 2.4
+} -returnCodes error -result {package t 2.4 is not present}
+test package-8.10 {Tcl_PkgPresent procedure, unknown package} -body {
+    package forget t
+    package present -exact t 2.4
+} -returnCodes error -result {package t 2.4 is not present}
+test package-8.11 {Tcl_PackageCmd procedure, "present" option} -body {
+    package present
+} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
+test package-8.12 {Tcl_PackageCmd procedure, "present" option} -body {
+    package present a b c
+} -returnCodes error -result {expected version number but got "b"}
+test package-8.13 {Tcl_PackageCmd procedure, "present" option} -body {
+    package present -exact a b c
+} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
+test package-8.14 {Tcl_PackageCmd procedure, "present" option} -body {
+    package present -bs a b
+} -returnCodes error -result {expected version number but got "a"}
+test package-8.15 {Tcl_PackageCmd procedure, "present" option} -body {
+    package present x a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-8.16 {Tcl_PackageCmd procedure, "present" option} -body {
+    package present -exact x a.b
+} -returnCodes error -result {expected version number but got "a.b"}
+test package-8.17 {Tcl_PackageCmd procedure, "present" option} -body {
+    package present -exact x
+} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
+test package-8.18 {Tcl_PackageCmd procedure, "present" option} -body {
+    package present -exact
+} -returnCodes error -result {wrong # args: should be "package present ?-exact? package ?requirement ...?"}
+
+set n 0
+foreach {r p vs vc} {
+    8.5a0    8.5a5    1          -1
+    8.5a0    8.5b1    1          -1
+    8.5a0    8.5.1    1          -1
+    8.5a0    8.6a0    1          -1
+    8.5a0    8.6b0    1          -1
+    8.5a0    8.6.0    1          -1
+    8.5a6    8.5a5    0          1
+    8.5a6    8.5b1    1          -1
+    8.5a6    8.5.1    1          -1
+    8.5a6    8.6a0    1          -1
+    8.5a6    8.6b0    1          -1
+    8.5a6    8.6.0    1          -1
+    8.5b0    8.5a5    0          1
+    8.5b0    8.5b1    1          -1
+    8.5b0    8.5.1    1          -1
+    8.5b0    8.6a0    1          -1
+    8.5b0    8.6b0    1          -1
+    8.5b0    8.6.0    1          -1
+    8.5b2    8.5a5    0          1
+    8.5b2    8.5b1    0          1
+    8.5b2    8.5.1    1          -1
+    8.5b2    8.6a0    1          -1
+    8.5b2    8.6b0    1          -1
+    8.5b2    8.6.0    1          -1
+    8.5      8.5a5    1          1
+    8.5      8.5b1    1          1
+    8.5      8.5.1    1          -1
+    8.5      8.6a0    1          -1
+    8.5      8.6b0    1          -1
+    8.5      8.6.0    1          -1
+    8.5.0    8.5a5    0          1
+    8.5.0    8.5b1    0          1
+    8.5.0    8.5.1    1          -1
+    8.5.0    8.6a0    1          -1
+    8.5.0    8.6b0    1          -1
+    8.5.0    8.6.0    1          -1
+    10       8        0          1
+    8        10       0          -1
+    0.0.1.2  0.1.2    1          -1
+} {
+    test package-9.$n {package vsatisfies} {
+	package vsatisfies $p $r
+    } $vs
+    test package-10.$n {package vcompare} {
+	package vcompare $r $p
+    } $vc
+    incr n
+}
+
+test package-11.0.0 {package vcompare at 32bit boundary} {
+    package vcompare [expr {1<<31}] [expr {(1<<31)-1}]
+} 1
+
+# Note: It is correct that the result of the very first test, i.e. "5.0 5.0a0"
+# is 1, i.e. that version 5.0a0 satisfies a 5.0 requirement.
+
+# The requirement "5.0" internally translates first to "5.0-6", and then to
+# its final form of "5.0a0-6a0". These translations are explicitly specified
+# by the TIP (Search for "padded/extended internally with 'a0'"). This was
+# done intentionally for exactly the tested case, that an alpha package can
+# satisfy a requirement for the regular package. An example would be a package
+# FOO requiring Tcl 8.X for its operation. It can be used with Tcl 8.Xa0.
+# Without our translation that would not be possible.
+
+set n 0
+foreach {required provided satisfied} {
+    5.0 5.0a0 1
+    5.0a0 5.0 1
+
+    8.5a0-   8.5a5    1
+    8.5a0-   8.5b1    1
+    8.5a0-   8.5.1    1
+    8.5a0-   8.6a0    1
+    8.5a0-   8.6b0    1
+    8.5a0-   8.6.0    1
+    8.5a6-   8.5a5    0
+    8.5a6-   8.5b1    1
+    8.5a6-   8.5.1    1
+    8.5a6-   8.6a0    1
+    8.5a6-   8.6b0    1
+    8.5a6-   8.6.0    1
+    8.5b0-   8.5a5    0
+    8.5b0-   8.5b1    1
+    8.5b0-   8.5.1    1
+    8.5b0-   8.6a0    1
+    8.5b0-   8.6b0    1
+    8.5b0-   8.6.0    1
+    8.5b2-   8.5a5    0
+    8.5b2-   8.5b1    0
+    8.5b2-   8.5.1    1
+    8.5b2-   8.6a0    1
+    8.5b2-   8.6b0    1
+    8.5b2-   8.6.0    1
+    8.5-     8.5a5    1
+    8.5-     8.5b1    1
+    8.5-     8.5.1    1
+    8.5-     8.6a0    1
+    8.5-     8.6b0    1
+    8.5-     8.6.0    1
+    8.5.0-   8.5a5    0
+    8.5.0-   8.5b1    0
+    8.5.0-   8.5.1    1
+    8.5.0-   8.6a0    1
+    8.5.0-   8.6b0    1
+    8.5.0-   8.6.0    1
+    8.5a0-7  8.5a5    0
+    8.5a0-7  8.5b1    0
+    8.5a0-7  8.5.1    0
+    8.5a0-7  8.6a0    0
+    8.5a0-7  8.6b0    0
+    8.5a0-7  8.6.0    0
+    8.5a6-7  8.5a5    0
+    8.5a6-7  8.5b1    0
+    8.5a6-7  8.5.1    0
+    8.5a6-7  8.6a0    0
+    8.5a6-7  8.6b0    0
+    8.5a6-7  8.6.0    0
+    8.5b0-7  8.5a5    0
+    8.5b0-7  8.5b1    0
+    8.5b0-7  8.5.1    0
+    8.5b0-7  8.6a0    0
+    8.5b0-7  8.6b0    0
+    8.5b0-7  8.6.0    0
+    8.5b2-7  8.5a5    0
+    8.5b2-7  8.5b1    0
+    8.5b2-7  8.5.1    0
+    8.5b2-7  8.6a0    0
+    8.5b2-7  8.6b0    0
+    8.5b2-7  8.6.0    0
+    8.5-7    8.5a5    0
+    8.5-7    8.5b1    0
+    8.5-7    8.5.1    0
+    8.5-7    8.6a0    0
+    8.5-7    8.6b0    0
+    8.5-7    8.6.0    0
+    8.5.0-7  8.5a5    0
+    8.5.0-7  8.5b1    0
+    8.5.0-7  8.5.1    0
+    8.5.0-7  8.6a0    0
+    8.5.0-7  8.6b0    0
+    8.5.0-7  8.6.0    0
+    8.5a0-8.6.1 8.5a5    1
+    8.5a0-8.6.1 8.5b1    1
+    8.5a0-8.6.1 8.5.1    1
+    8.5a0-8.6.1 8.6a0    1
+    8.5a0-8.6.1 8.6b0    1
+    8.5a0-8.6.1 8.6.0    1
+    8.5a6-8.6.1 8.5a5    0
+    8.5a6-8.6.1 8.5b1    1
+    8.5a6-8.6.1 8.5.1    1
+    8.5a6-8.6.1 8.6a0    1
+    8.5a6-8.6.1 8.6b0    1
+    8.5a6-8.6.1 8.6.0    1
+    8.5b0-8.6.1 8.5a5    0
+    8.5b0-8.6.1 8.5b1    1
+    8.5b0-8.6.1 8.5.1    1
+    8.5b0-8.6.1 8.6a0    1
+    8.5b0-8.6.1 8.6b0    1
+    8.5b0-8.6.1 8.6.0    1
+    8.5b2-8.6.1 8.5a5    0
+    8.5b2-8.6.1 8.5b1    0
+    8.5b2-8.6.1 8.5.1    1
+    8.5b2-8.6.1 8.6a0    1
+    8.5b2-8.6.1 8.6b0    1
+    8.5b2-8.6.1 8.6.0    1
+    8.5-8.6.1 8.5a5    1
+    8.5-8.6.1 8.5b1    1
+    8.5-8.6.1 8.5.1    1
+    8.5-8.6.1 8.6a0    1
+    8.5-8.6.1 8.6b0    1
+    8.5-8.6.1 8.6.0    1
+    8.5.0-8.6.1 8.5a5    0
+    8.5.0-8.6.1 8.5b1    0
+    8.5.0-8.6.1 8.5.1    1
+    8.5.0-8.6.1 8.6a0    1
+    8.5.0-8.6.1 8.6b0    1
+    8.5.0-8.6.1 8.6.0    1
+    8.5a0-8.5a0 8.5a0    1
+    8.5a0-8.5a0 8.5b1    0
+    8.5a0-8.5a0 8.4      0
+    8.5b0-8.5b0 8.5a5    0
+    8.5b0-8.5b0 8.5b0    1
+    8.5b0-8.5b0 8.5.1    0
+    8.5-8.5  8.5a5    0
+    8.5-8.5  8.5b1    0
+    8.5-8.5  8.5      1
+    8.5-8.5  8.5.1    0
+    8.5.0-8.5.0 8.5a5    0
+    8.5.0-8.5.0 8.5b1    0
+    8.5.0-8.5.0 8.5.0    1
+    8.5.0-8.5.0 8.5.1    0
+    8.5.0-8.5.0 8.6a0    0
+    8.5.0-8.5.0 8.6b0    0
+    8.5.0-8.5.0 8.6.0    0
+    8.2      9        0
+    8.2-     9        1
+    8.2-8.5  9        0
+    8.2-9.1  9        1
+
+    8.5-8.5     8.5b1 0
+    8.5a0-8.5   8.5b1 0
+    8.5a0-8.5.1 8.5b1 1
+
+    8.5-8.5     8.5 1
+    8.5.0-8.5.0 8.5 1
+    8.5a0-8.5.0 8.5 0
+} {
+    test package-11.$n "package vsatisfies $provided $required" {
+	package vsatisfies $provided $required
+    } $satisfied
+    incr n
+}
+
+test package-12.0 "package vsatisfies multiple" {
+    #                      yes no
+    package vsatisfies 8.4 8.4 7.3
+} 1
+test package-12.1 "package vsatisfies multiple" {
+    #                      no  yes
+    package vsatisfies 8.4 7.3 8.4
+} 1
+test package-12.2 "package vsatisfies multiple" {
+    #                        yes  yes
+    package vsatisfies 8.4.2 8.4  8.4.1
+} 1
+test package-12.3 "package vsatisfies multiple" {
+    #                      no  no
+    package vsatisfies 8.4 7.3 6.1
+} 0
+
+proc prefer {args} {
+    set ip [interp create]
+    try {
+	lappend res [$ip eval {package prefer}]
+	foreach mode $args {
+	    lappend res [$ip eval [list package prefer $mode]]
+	}
+	return $res
+    } finally {
+	interp delete $ip
+    }
+}
+
+test package-13.0 {package prefer defaults} {
+    prefer
+} stable
+test package-13.1 {package prefer defaults} -body {
+    set ::env(TCL_PKG_PREFER_LATEST) stable	;# value not relevant!
+    prefer
+} -cleanup {
+    unset -nocomplain ::env(TCL_PKG_PREFER_LATEST)
+} -result latest
+
+test package-14.0 {wrong\#args} -returnCodes error -body {
+    package prefer foo bar
+} -result {wrong # args: should be "package prefer ?latest|stable?"}
+test package-14.1 {bogus argument} -returnCodes error -body {
+    package prefer foo
+} -result {bad preference "foo": must be latest or stable}
+
+test package-15.0 {set, keep} {package prefer stable} stable
+test package-15.1 {set stable, keep} {prefer stable} {stable stable}
+test package-15.2 {set latest, change} {prefer latest} {stable latest}
+test package-15.3 {set latest, keep} {
+    prefer latest latest
+} {stable latest latest}
+test package-15.4 {set stable, rejected} {
+    prefer latest stable
+} {stable latest latest}
+
+rename prefer {}
+
+set auto_path $oldPath
+package unknown $oldPkgUnknown
+
+cleanupTests
+}
+
+# cleanup
+interp delete $i
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/parse.test b/tests/parse.test
index 8481a6f..01443c9 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -7,8 +7,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: parse.test,v 1.21 2005/05/10 18:35:22 kennykb Exp $
 
 if {[catch {package require tcltest 2.0.2}]} {
     puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -16,18 +14,20 @@ if {[catch {package require tcltest 2.0.2}]} {
 }
 
 namespace eval ::tcl::test::parse {
-    namespace import ::tcltest::test
-    namespace import ::tcltest::testConstraint
-    namespace import ::tcltest::cleanupTests
-    namespace import ::tcltest::bytestring
-
-    testConstraint testparser [llength [info commands testparser]]
-    testConstraint testevalobjv [llength [info commands testevalobjv]]
-    testConstraint testevalex [llength [info commands testevalex]]
-    testConstraint testparsevarname [llength [info commands testparsevarname]]
-    testConstraint testparsevar [llength [info commands testparsevar]]
-    testConstraint testasync [llength [info commands testasync]]
-    testConstraint testcmdtrace [llength [info commands testcmdtrace]]
+    namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testparser [llength [info commands testparser]]
+testConstraint testevalobjv [llength [info commands testevalobjv]]
+testConstraint testevalex [llength [info commands testevalex]]
+testConstraint testparsevarname [llength [info commands testparsevarname]]
+testConstraint testparsevar [llength [info commands testparsevar]]
+testConstraint testasync [llength [info commands testasync]]
+testConstraint testcmdtrace [llength [info commands testcmdtrace]]
+testConstraint testevent [llength [info commands testevent]]
+testConstraint memory [llength [info commands memory]]
 
 test parse-1.1 {Tcl_ParseCommand procedure, computing string length} testparser {
     testparser [bytestring "foo\0 bar"] -1
@@ -53,6 +53,12 @@ test parse-1.7 {Tcl_ParseCommand procedure, missing continuation line in leading
 test parse-1.8 {Tcl_ParseCommand procedure, eof in leading space} testparser {
     testparser "      foo" 3
 } {- {} 0 {   foo}}
+test parse-1.9 {Tcl_ParseCommand procedure, backslash newline + newline} testparser {
+    testparser "cmd1\\\n\ncmd2" 0
+} {- cmd1\\\n\n 1 simple cmd1 1 text cmd1 0 cmd2}
+test parse-1.10 {Tcl_ParseCommand procedure, backslash newline + newline} testparser {
+    testparser "list \\\nA B\\\n\nlist C D" 0
+} {- list\ \\\nA\ B\\\n\n 3 simple list 1 text list 0 simple A 1 text A 0 simple B 1 text B 0 {list C D}}
 
 test parse-2.1 {Tcl_ParseCommand procedure, comments} testparser {
     testparser "# foo bar\n foo" 0
@@ -93,7 +99,7 @@ test parse-3.6 {Tcl_ParseCommand procedure, words in braces} testparser {
     testparser {foo {a $b [concat foo]} {c d}} 0
 } {- {foo {a $b [concat foo]} {c d}} 3 simple foo 1 text foo 0 simple {{a $b [concat foo]}} 1 text {a $b [concat foo]} 0 simple {{c d}} 1 text {c d} 0 {}}
 test parse-3.7 {Tcl_ParseCommand procedure, error in unquoted word} testparser {
-    list [catch {testparser "foo \$\{abc" 0} msg] $msg $errorInfo
+    list [catch {testparser "foo \$\{abc" 0} msg] $msg $::errorInfo
 } {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\$\\\{abc\"\ 0\"}
 
 test parse-4.1 {Tcl_ParseCommand procedure, simple words} testparser {
@@ -132,7 +138,7 @@ test parse-5.5 {Tcl_ParseCommand procedure, word terminator is end of string} te
     testparser "\"foo\" bar" 5
 } {- {"foo"} 1 simple {"foo"} 1 text foo 0 { bar}}
 test parse-5.6 {Tcl_ParseCommand procedure, junk after close quote} testparser {
-    list [catch {testparser {foo "bar"x} 0} msg] $msg $errorInfo
+    list [catch {testparser {foo "bar"x} 0} msg] $msg $::errorInfo
 } {1 {extra characters after close-quote} {extra characters after close-quote
     (remainder of script: "x")
     invoked from within
@@ -141,7 +147,7 @@ test parse-5.7 {Tcl_ParseCommand procedure, backslash-newline after close quote}
     testparser "foo \"bar\"\\\nx" 0
 } {- foo\ \"bar\"\\\nx 3 simple foo 1 text foo 0 simple {"bar"} 1 text bar 0 simple x 1 text x 0 {}}
 test parse-5.8 {Tcl_ParseCommand procedure, junk after close brace} testparser {
-    list [catch {testparser {foo {bar}x} 0} msg] $msg $errorInfo
+    list [catch {testparser {foo {bar}x} 0} msg] $msg $::errorInfo
 } {1 {extra characters after close-brace} {extra characters after close-brace
     (remainder of script: "x")
     invoked from within
@@ -151,81 +157,93 @@ test parse-5.9 {Tcl_ParseCommand procedure, backslash-newline after close brace}
 } {- foo\ \{bar\}\\\nx 3 simple foo 1 text foo 0 simple {{bar}} 1 text bar 0 simple x 1 text x 0 {}}
 test parse-5.10 {Tcl_ParseCommand procedure, multiple deletion of non-static buffer} testparser {
     # This test is designed to catch bug 1681.
-    list [catch {testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0} msg] $msg $errorInfo
+    list [catch {testparser "a \"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8" 0} msg] $msg $::errorInfo
 } "1 {missing \"} {missing \"
     (remainder of script: \"\"\\1\\2\\3\\4\\5\\6\\7\\8\\9\\1\\2\\3\\4\\5\\6\\7\\8\")
     invoked from within
 \"testparser \"a \\\"\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\\\\9\\\\1\\\\2\\\\3\\\\4\\\\5\\\\6\\\\7\\\\8\" 0\"}"
 
-test parse-5.11 {Tcl_ParseCommand: {expand} parsing} testparser {
+test parse-5.11 {Tcl_ParseCommand: {*} parsing} testparser {
     testparser {{expan}} 0
 } {- {{expan}} 1 simple {{expan}} 1 text expan 0 {}}
-test parse-5.12 {Tcl_ParseCommand: {expand} parsing} -constraints {
+test parse-5.12 {Tcl_ParseCommand: {*} parsing} -constraints {
     testparser
 } -body {
     testparser {{expan}x} 0
 } -returnCodes error  -result {extra characters after close-brace}
-test parse-5.13 {Tcl_ParseCommand: {expand} parsing} testparser {
-    testparser {{expandy}} 0
-} {- {{expandy}} 1 simple {{expandy}} 1 text expandy 0 {}}
-test parse-5.14 {Tcl_ParseCommand: {expand} parsing} -constraints {
+test parse-5.13 {Tcl_ParseCommand: {*} parsing} testparser {
+    testparser {{**}} 0
+} {- {{**}} 1 simple {{**}} 1 text ** 0 {}}
+test parse-5.14 {Tcl_ParseCommand: {*} parsing} -constraints {
     testparser
 } -body {
-    testparser {{expandy}x} 0
+    testparser {{**}x} 0
 } -returnCodes error  -result {extra characters after close-brace}
-test parse-5.15 {Tcl_ParseCommand: {expand} parsing} -constraints {
+test parse-5.15 {Tcl_ParseCommand: {*} parsing} -constraints {
     testparser
 } -body {
-    testparser {{expand}{123456}x} 0
+    testparser {{*}{123456}x} 0
 } -returnCodes error  -result {extra characters after close-brace}
-test parse-5.16 {Tcl_ParseCommand: {expand} parsing} testparser {
+test parse-5.16 {Tcl_ParseCommand: {*} parsing} testparser {
     testparser {{123456\
 			}} 0
 } {- {{123456 }} 1 simple {{123456 }} 1 text {123456 } 0 {}}
-test parse-5.17 {Tcl_ParseCommand: {expand} parsing} -constraints {
+test parse-5.17 {Tcl_ParseCommand: {*} parsing} -constraints {
     testparser
 } -body {
     testparser {{123456\
 			}x} 0
 } -returnCodes error  -result {extra characters after close-brace}
-test parse-5.18 {Tcl_ParseCommand: {expand} parsing} testparser {
-    testparser {{expand\
+test parse-5.18 {Tcl_ParseCommand: {*} parsing} testparser {
+    testparser {{*\
 			}} 0
-} {- {{expand }} 1 simple {{expand }} 1 text {expand } 0 {}}
-test parse-5.19 {Tcl_ParseCommand: {expand} parsing} -constraints {
+} {- {{* }} 1 simple {{* }} 1 text {* } 0 {}}
+test parse-5.19 {Tcl_ParseCommand: {*} parsing} -constraints {
     testparser
 } -body {
-    testparser {{expand\
+    testparser {{*\
 			}x} 0
 } -returnCodes error  -result {extra characters after close-brace}
-test parse-5.20 {Tcl_ParseCommand: {expand} parsing} testparser {
+test parse-5.20 {Tcl_ParseCommand: {*} parsing} testparser {
     testparser {{123456}} 0
 } {- {{123456}} 1 simple {{123456}} 1 text 123456 0 {}}
-test parse-5.21 {Tcl_ParseCommand: {expand} parsing} -constraints {
+test parse-5.21 {Tcl_ParseCommand: {*} parsing} -constraints {
     testparser
 } -body {
     testparser {{123456}x} 0
 } -returnCodes error  -result {extra characters after close-brace}
-test parse-5.22 {Tcl_ParseCommand: {expand} parsing} testparser {
-    testparser {{expand}} 0
-} {- {{expand}} 1 simple {{expand}} 1 text expand 0 {}}
-test parse-5.23 {Tcl_ParseCommand: {expand} parsing} testparser {
-    testparser {{expand} } 0
-} {- {{expand} } 1 simple {{expand}} 1 text expand 0 {}}
-test parse-5.24 {Tcl_ParseCommand: {expand} parsing} testparser {
-    testparser {{expand}x} 0
-} {- {{expand}x} 1 expand {{expand}x} 1 text x 0 {}}
-test parse-5.25 {Tcl_ParseCommand: {expand} parsing} testparser {
-    testparser {{expand}
+test parse-5.22 {Tcl_ParseCommand: {*} parsing} testparser {
+    testparser {{*}} 0
+} {- {{*}} 1 simple {{*}} 1 text * 0 {}}
+test parse-5.23 {Tcl_ParseCommand: {*} parsing} testparser {
+    testparser {{*} } 0
+} {- {{*} } 1 simple {{*}} 1 text * 0 {}}
+test parse-5.24 {Tcl_ParseCommand: {*} parsing} testparser {
+    testparser {{*}x} 0
+} {- {{*}x} 1 simple x 1 text x 0 {}}
+test parse-5.25 {Tcl_ParseCommand: {*} parsing} testparser {
+    testparser {{*}
 } 0
-} {- {{expand}
-} 1 simple {{expand}} 1 text expand 0 {}}
-test parse-5.26 {Tcl_ParseCommand: {expand} parsing} testparser {
-    testparser {{expand};} 0
-} {- {{expand};} 1 simple {{expand}} 1 text expand 0 {}}
-test parse-5.27 {Tcl_ParseCommand: {expand} parsing} testparser {
-    testparser "{expand}\\\n foo bar" 0
-} {- \{expand\}\\\n\ foo\ bar 3 simple {{expand}} 1 text expand 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
+} {- {{*}
+} 1 simple {{*}} 1 text * 0 {}}
+test parse-5.26 {Tcl_ParseCommand: {*} parsing} testparser {
+    testparser {{*};} 0
+} {- {{*};} 1 simple {{*}} 1 text * 0 {}}
+test parse-5.27 {Tcl_ParseCommand: {*} parsing} testparser {
+    testparser "{*}\\\n foo bar" 0
+} {- \{*\}\\\n\ foo\ bar 3 simple {{*}} 1 text * 0 simple foo 1 text foo 0 simple bar 1 text bar 0 {}}
+test parse-5.28 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser {
+    testparser {{*}{a b}} 0
+} {- {{*}{a b}} 2 simple a 1 text a 0 simple b 1 text b 0 {}}
+test parse-5.29 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser {
+    testparser {{*}{a \n b}} 0
+} {- {{*}{a \n b}} 1 expand {{*}{a \n b}} 1 text {a \n b} 0 {}}
+test parse-5.30 {Tcl_ParseCommand: {*} parsing, expanded literals} testparser {
+    testparser {{*}"a b"} 0
+} {- {{*}"a b"} 2 simple a 1 text a 0 simple b 1 text b 0 {}}
+test parse-5.31 {Tcl_ParseCommand: {*} parsing, expanded literals, naked backslashes} testparser {
+    testparser {{*}"a \n b"} 0
+} {- {{*}"a \n b"} 1 expand {{*}"a \n b"} 3 text {a } 0 backslash {\n} 0 text { b} 0 {}}
 
 test parse-6.1 {ParseTokens procedure, empty word} testparser {
     testparser {""} 0
@@ -246,7 +264,7 @@ test parse-6.6 {ParseTokens procedure, command substitution} testparser {
     testparser {[foo \] [a b]]} 0
 } {- {[foo \] [a b]]} 1 word {[foo \] [a b]]} 1 command {[foo \] [a b]]} 0 {}}
 test parse-6.7 {ParseTokens procedure, error in command substitution} testparser {
-    list [catch {testparser {a [b {}c d] e} 0} msg] $msg $errorInfo
+    list [catch {testparser {a [b {}c d] e} 0} msg] $msg $::errorInfo
 } {1 {extra characters after close-brace} {extra characters after close-brace
     (remainder of script: "c d] e")
     invoked from within
@@ -266,13 +284,13 @@ test parse-6.11 {ParseTokens procedure, memory allocation for big nested command
     testparser {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0
 } {- {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 word {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 1 command {[$a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b) $a(b)]} 0 {}}
 test parse-6.12 {ParseTokens procedure, missing close bracket} testparser {
-    list [catch {testparser {[foo $x bar} 0} msg] $msg $errorInfo
+    list [catch {testparser {[foo $x bar} 0} msg] $msg $::errorInfo
 } {1 {missing close-bracket} {missing close-bracket
     (remainder of script: "[foo $x bar")
     invoked from within
 "testparser {[foo $x bar} 0"}}
 test parse-6.13 {ParseTokens procedure, backslash-newline without continuation line} testparser {
-    list [catch {testparser "\"a b\\\n" 0} msg] $msg $errorInfo
+    list [catch {testparser "\"a b\\\n" 0} msg] $msg $::errorInfo
 } {1 {missing "} missing\ \"\n\ \ \ \ (remainder\ of\ script:\ \"\"a\ b\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\"a\ b\\\\\\n\"\ 0\"}
 test parse-6.14 {ParseTokens procedure, backslash-newline} testparser {
     testparser "b\\\nc" 0
@@ -365,15 +383,70 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints {
 test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv {
     list [catch {testevalobjv 0 error message} msg] $msg
 } {1 message}
+test parse-8.10 {Tcl_EvalObjv procedure, TCL_EVAL_GLOBAL} testevalobjv {
+    rename ::unknown unknown.save
+    proc ::unknown args {lappend ::info [info level]}
+    catch {rename ::noSuchCommand {}}
+    set ::info {}
+    namespace eval test_ns_1 {
+       testevalobjv 1 noSuchCommand
+       uplevel #0 noSuchCommand
+    }
+    namespace delete test_ns_1
+    rename ::unknown {}
+    rename unknown.save ::unknown
+    set ::info
+} {1 1}
+test parse-8.11 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} testevalobjv {
+    rename ::unknown unknown.save
+    proc ::unknown args {lappend ::info [info level]; uplevel 1 foo}
+    proc ::foo args {lappend ::info global}
+    catch {rename ::noSuchCommand {}}
+    set ::slave [interp create]
+    $::slave alias bar noSuchCommand
+    set ::info {}
+    namespace eval test_ns_1 {
+       proc foo args {lappend ::info namespace}
+       $::slave eval bar
+       testevalobjv 1 [list $::slave eval bar]
+       uplevel #0 [list $::slave eval bar]
+    }
+    namespace delete test_ns_1
+    rename ::foo {}
+    rename ::unknown {}
+    rename unknown.save ::unknown
+    set ::info
+} [subst {[set level 2; incr level [info level]] global 1 global 1 global}]
+test parse-8.12 {Tcl_EvalObjv procedure, TCL_EVAL_INVOKE} {
+    set ::auto_index(noSuchCommand) {
+        proc noSuchCommand {} {lappend ::info global}
+    }
+    set ::auto_index(::[string trimleft [namespace current]::test_ns_1::noSuchCommand :]) [list \
+        proc [namespace current]::test_ns_1::noSuchCommand {} {
+            lappend ::info ns
+        }]
+    catch {rename ::noSuchCommand {}}
+    set ::slave [interp create]
+    $::slave alias bar noSuchCommand
+    set ::info {}
+    namespace eval test_ns_1 {
+        $::slave eval bar
+    }
+    namespace delete test_ns_1
+    interp delete $::slave
+    catch {rename ::noSuchCommand {}}
+    set ::info
+} global
+
 
 test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex {
-    catch {unset x}
+    unset -nocomplain x
     list [catch {testevalex {for {} 1 {} {
 
 
 	# asdf
 	set x
-    }}}] $errorInfo
+    }}}] $::errorInfo
 } {1 {can't read "x": no such variable
     while executing
 "set x"
@@ -393,7 +466,7 @@ test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex {
 	set x
     }}"}}
 test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} {
-    list [catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}] $errorInfo
+    list [catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}] $::errorInfo
 } {1 {wrong # args: should be "set varName ?newValue?"
     while executing
 "set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd ee..."}}
@@ -408,7 +481,7 @@ test parse-10.3 {Tcl_EvalTokens, nested commands} testevalex {
     testevalex {concat [expr 2 + 6]}
 } {8}
 test parse-10.4 {Tcl_EvalTokens, nested commands} testevalex {
-    catch {unset a}
+    unset -nocomplain a
     list [catch {testevalex {concat xxx[expr $a]}} msg] $msg
 } {1 {can't read "a": no such variable}}
 test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
@@ -416,21 +489,21 @@ test parse-10.5 {Tcl_EvalTokens, simple variables} testevalex {
     testevalex {concat $a}
 } {hello}
 test parse-10.6 {Tcl_EvalTokens, array variables} testevalex {
-    catch {unset a}
+    unset -nocomplain a
     set a(12) 46
     testevalex {concat $a(12)}
 } {46}
 test parse-10.7 {Tcl_EvalTokens, array variables} testevalex {
-    catch {unset a}
+    unset -nocomplain a
     set a(12) 46
     testevalex {concat $a(1[expr 3 - 1])}
 } {46}
 test parse-10.8 {Tcl_EvalTokens, array variables} testevalex {
-    catch {unset a}
+    unset -nocomplain a
     list [catch {testevalex {concat $x($a)}} msg] $msg
 } {1 {can't read "a": no such variable}}
 test parse-10.9 {Tcl_EvalTokens, array variables} testevalex {
-    catch {unset a}
+    unset -nocomplain a
     list [catch {testevalex {concat xyz$a(1)}} msg] $msg
 } {1 {can't read "a(1)": no such variable}}
 test parse-10.10 {Tcl_EvalTokens, object values} testevalex {
@@ -470,11 +543,11 @@ test parse-11.2 {Tcl_EvalEx, error while parsing} testevalex {
     list [catch {testevalex {concat "abc}} msg] $msg
 } {1 {missing "}}
 test parse-11.3 {Tcl_EvalEx, error while collecting words} testevalex {
-    catch {unset a}
+    unset -nocomplain a
     list [catch {testevalex {concat xyz $a}} msg] $msg
 } {1 {can't read "a": no such variable}}
 test parse-11.4 {Tcl_EvalEx, error in Tcl_EvalObjv call} testevalex {
-    catch {unset a}
+    unset -nocomplain a
     list [catch {testevalex {_bogus_ a b c d}} msg] $msg
 } {1 {invalid command name "_bogus_"}}
 test parse-11.5 {Tcl_EvalEx, exceptional return} testevalex {
@@ -493,7 +566,7 @@ test parse-11.8 {Tcl_EvalEx, multiple commands in script} testevalex {
     }] $a $c
 } {d b d}
 test parse-11.9 {Tcl_EvalEx, freeing memory after error} testevalex {
-    catch {unset a}
+    unset -nocomplain a
     list [catch {testevalex {concat a b c d e f g h i j k l m n o p q r s t u v w x y z $a}} msg] $msg
 } {1 {can't read "a": no such variable}}
 test parse-11.10 {Tcl_EvalTokens, empty commands} testevalex {
@@ -528,7 +601,7 @@ test parse-12.7 {Tcl_ParseVarName procedure, braced variable name} testparser {
     testparser "\$\{\{\} " 0
 } {- \$\{\{\}\  1 word \$\{\{\} 2 variable \$\{\{\} 1 text \{ 0 {}}
 test parse-12.8 {Tcl_ParseVarName procedure, missing close brace} testparser {
-    list [catch {testparser "$\{abc" 0} msg] $msg $errorInfo
+    list [catch {testparser "$\{abc" 0} msg] $msg $::errorInfo
 } {1 {missing close-brace for variable name} missing\ close-brace\ for\ variable\ name\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\$\\\{abc\"\ 0\"}
 test parse-12.9 {Tcl_ParseVarName procedure, missing close brace} testparsevarname {
     list [catch {testparsevarname {${bcd}} 4 0} msg] $msg
@@ -573,13 +646,13 @@ test parse-12.22 {Tcl_ParseVarName procedure, array reference} testparser {
     testparser {$x([cmd arg]zz)} 0
 } {- {$x([cmd arg]zz)} 1 word {$x([cmd arg]zz)} 4 variable {$x([cmd arg]zz)} 3 text x 0 command {[cmd arg]} 0 text zz 0 {}}
 test parse-12.23 {Tcl_ParseVarName procedure, missing close paren in array reference} testparser {
-    list [catch {testparser {$x(poiu} 0} msg] $msg $errorInfo
+    list [catch {testparser {$x(poiu} 0} msg] $msg $::errorInfo
 } {1 {missing )} {missing )
     (remainder of script: "(poiu")
     invoked from within
 "testparser {$x(poiu} 0"}}
 test parse-12.24 {Tcl_ParseVarName procedure, missing close paren in array reference} testparsevarname {
-    list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $errorInfo
+    list [catch {testparsevarname {$ab(cd)} 6 0} msg] $msg $::errorInfo
 } {1 {missing )} {missing )
     (remainder of script: "(cd)")
     invoked from within
@@ -599,13 +672,33 @@ test parse-13.3 {Tcl_ParseVar procedure, no variable name} testparsevar {
     testparsevar {$.123}
 } {{$} .123}
 test parse-13.4 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
-    catch {unset abc}
+    unset -nocomplain abc
     list [catch {testparsevar {$abc}} msg] $msg
 } {1 {can't read "abc": no such variable}}
 test parse-13.5 {Tcl_ParseVar procedure, error looking up variable} testparsevar {
-    catch {unset abc}
+    unset -nocomplain abc
     list [catch {testparsevar {$abc([bogus x y z])}} msg] $msg
 } {1 {invalid command name "bogus"}}
+test parse-13.6 {Tcl_ParseVar memory leak} -constraints memory -setup {
+    proc getbytes {} {
+	return [lindex [split [memory info] \n] 3 3]
+    }
+} -body {
+    set a() foo
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	set vn {}
+	set res [testparsevar [append vn $ a([string repeat {[]} 19]) bar]]
+	if {$res ne {foo bar}} {error "Unexpected result: $res"}
+
+	set tmp $end
+	set end [getbytes]
+    }
+    expr {$end - $tmp}
+} -cleanup {
+    unset -nocomplain a end i vn res tmp
+    rename getbytes {}
+} -result 0
 
 test parse-14.1 {Tcl_ParseBraces procedure, computing string length} testparser {
     testparser [bytestring "foo\0 bar"] -1
@@ -626,7 +719,7 @@ test parse-14.6 {Tcl_ParseBraces procedure, backslashes in words in braces} test
     testparser "foo {a \\n\\\{}" 0
 } {- {foo {a \n\{}} 2 simple foo 1 text foo 0 simple {{a \n\{}} 1 text {a \n\{} 0 {}}
 test parse-14.7 {Tcl_ParseBraces procedure, missing continuation line in braces} testparser {
-    list [catch {testparser "\{abc\\\n" 0} msg] $msg $errorInfo
+    list [catch {testparser "\{abc\\\n" 0} msg] $msg $::errorInfo
 } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{abc\\\n\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"\\\{abc\\\\\\n\"\ 0\"}
 test parse-14.8 {Tcl_ParseBraces procedure, backslash-newline in braces} testparser {
     testparser "foo {\\\nx}" 0
@@ -641,7 +734,7 @@ test parse-14.11 {Tcl_ParseBraces procedure, empty braced string} testparser {
     testparser {foo {}} 0
 } {- {foo {}} 2 simple foo 1 text foo 0 simple {{}} 1 text {} 0 {}}
 test parse-14.12 {Tcl_ParseBraces procedure, missing close brace} testparser {
-    list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $errorInfo
+    list [catch {testparser "foo \{xy\\\nz" 0} msg] $msg $::errorInfo
 } {1 {missing close-brace} missing\ close-brace\n\ \ \ \ (remainder\ of\ script:\ \"\{xy\\\nz\")\n\ \ \ \ invoked\ from\ within\n\"testparser\ \"foo\ \\\{xy\\\\\\nz\"\ 0\"}
 
 test parse-15.1 {Tcl_ParseQuotedString procedure, computing string length} testparser {
@@ -654,7 +747,7 @@ test parse-15.3 {Tcl_ParseQuotedString procedure, word is quoted string} testpar
     testparser {foo "a b c" d "efg";} 0
 } {- {foo "a b c" d "efg";} 4 simple foo 1 text foo 0 simple {"a b c"} 1 text {a b c} 0 simple d 1 text d 0 simple {"efg"} 1 text efg 0 {}}
 test parse-15.4 {Tcl_ParseQuotedString procedure, garbage after quoted string} testparser {
-    list [catch {testparser {foo "a b c"d} 0} msg] $msg $errorInfo
+    list [catch {testparser {foo "a b c"d} 0} msg] $msg $::errorInfo
 } {1 {extra characters after close-quote} {extra characters after close-quote
     (remainder of script: "d")
     invoked from within
@@ -826,8 +919,12 @@ test parse-15.59 {CommandComplete procedure} {
     # Test for Tcl Bug 684744
     info complete [encoding convertfrom identity "\x00;if 1 \{"]
 } 0
+test parse-15.60 {CommandComplete procedure} {
+    # Test for Tcl Bug 1968882
+    info complete \\\n
+} 0
 
-test parse-16.1 {Tcl_EvalEx, check termOffset is set correctly for non TCL_OK cases, bug 2535} {
+test parse-16.1 {Bug 218885 (Scriptics bug 2535)} {
     subst {[eval {return foo}]bar}
 } foobar
 
@@ -963,34 +1060,72 @@ test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints {
     interp create i
     load {} Tcltest i
     i eval {proc {} args {}}
-    interp recursionlimit i 3
+    interp recursionlimit i 2
 } -body {
     i eval {testevalex {[[]]}}
 } -cleanup {
     interp delete i
 } -returnCodes error -match glob -result {too many nested*}
 
-test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup {
-    interp create i
-    i eval {proc {} args {}}
-    interp recursionlimit i 3
-} -body {
-    i eval {subst {[]}}
-} -cleanup {
-    interp delete i
-}
+test parse-19.3 {Bug 1115904: recursion limit in Tcl_EvalEx} emptyTest {
+    # Test no longer valid in Tcl 8.6
+} {}
+test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} emptyTest {
+    # Test no longer valid in Tcl 8.6
+} {}
 
-test parse-19.4 {Bug 1115904: recursion limit in Tcl_EvalEx} -setup {
-    interp create i
-    i eval {proc {} args {}}
-    interp recursionlimit i 3
-} -body {
-    i eval {subst {[[]]}}
-} -cleanup {
-    interp delete i
-} -returnCodes error -match glob -result {too many nested*}
+test parse-20.1 {TclParseBackslash: truncated escape} testparser {
+    testparser {\u12345} 1
+} {- \\ 1 simple \\ 1 text \\ 0 u12345}
+test parse-20.2 {TclParseBackslash: truncated escape} testparser {
+    testparser {\u12345} 2
+} {- {\u} 1 word {\u} 1 backslash {\u} 0 12345}
+test parse-20.3 {TclParseBackslash: truncated escape} testparser {
+    testparser {\u12345} 3
+} {- {\u1} 1 word {\u1} 1 backslash {\u1} 0 2345}
+test parse-20.4 {TclParseBackslash: truncated escape} testparser {
+    testparser {\u12345} 4
+} {- {\u12} 1 word {\u12} 1 backslash {\u12} 0 345}
+test parse-20.5 {TclParseBackslash: truncated escape} testparser {
+    testparser {\u12345} 5
+} {- {\u123} 1 word {\u123} 1 backslash {\u123} 0 45}
+test parse-20.6 {TclParseBackslash: truncated escape} testparser {
+    testparser {\u12345} 6
+} {- {\u1234} 1 word {\u1234} 1 backslash {\u1234} 0 5}
+test parse-20.7 {TclParseBackslash: truncated escape} testparser {
+    testparser {\u12345} 7
+} {- {\u12345} 1 word {\u12345} 2 backslash {\u1234} 0 text 5 0 {}}
+
+test parse-20.8 {TclParseBackslash: truncated escape} testparser {
+    testparser {\x12X} 1
+} {- \\ 1 simple \\ 1 text \\ 0 x12X}
+test parse-20.9 {TclParseBackslash: truncated escape} testparser {
+    testparser {\x12X} 2
+} {- {\x} 1 word {\x} 1 backslash {\x} 0 12X}
+test parse-20.10 {TclParseBackslash: truncated escape} testparser {
+    testparser {\x12X} 3
+} {- {\x1} 1 word {\x1} 1 backslash {\x1} 0 2X}
+test parse-20.11 {TclParseBackslash: truncated escape} testparser {
+    testparser {\x12X} 4
+} {- {\x12} 1 word {\x12} 1 backslash {\x12} 0 X}
+test parse-20.12 {TclParseBackslash: truncated escape} testparser {
+    testparser {\x12X} 5
+} {- {\x12X} 1 word {\x12X} 2 backslash {\x12} 0 text X 0 {}}
+
+test parse-21.0 {Bug 1884496} testevent {
+    set ::script {testevent delete a; set a [p]; set ::done $a}
+    proc ::p {} {string first s $::script}
+    testevent queue a head $::script
+    vwait done
+} {}
+test parse-21.1 {TCL_EVAL_DIRECT coverage} testevent {
+    testevent queue a head {testevent delete a; \
+	set ::done [dict get [info frame 0] line]}
+    vwait done
+    set ::done
+} 2
 
-    cleanupTests
+cleanupTests
 }
 
 namespace delete ::tcl::test::parse
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index d337ced..714c45b 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -1,5 +1,5 @@
 # This file contains a collection of tests for the procedures in the
-# file tclParseExpr.c.  Sourcing this file into Tcl runs the tests and
+# file tclCompExpr.c.  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.
@@ -7,26 +7,20 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: parseExpr.test,v 1.15 2005/07/28 18:42:32 dgp Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
 
-# Note that the Tcl expression parser (tclParseExpr.c) does not check
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+# Note that the Tcl expression parser (tclCompExpr.c) does not check
 # the semantic validity of the expressions it parses. It does not check,
 # for example, that a math function actually exists, or that the operands
 # of "<<" are integers.
 
 testConstraint testexprparser [llength [info commands testexprparser]]
 
-# Some tests only work if wide integers (>32bit) are not found to be
-# integers at all.
-
-testConstraint wideIs32bit [expr {0x80000000 < 0}]
-
 # Big test for correct ordering of data in [expr]
 
 proc testIEEE {} {
@@ -83,7 +77,7 @@ proc testIEEE {} {
 	}
     }
 }
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
 
 ######################################################################
 
@@ -93,193 +87,178 @@ test parseExpr-1.1 {Tcl_ParseExpr procedure, computing string length} testexprpa
 test parseExpr-1.2 {Tcl_ParseExpr procedure, computing string length} testexprparser {
     testexprparser "1  + 2" -1
 } {- {} 0 subexpr {1  + 2} 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-1.3 {Tcl_ParseExpr procedure, error getting initial lexeme} testexprparser {
+    testexprparser 12345678901234567890 -1
+} {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-1.4 {Tcl_ParseExpr procedure, error in conditional expression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {foo+} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "foo+": *preceding $*}}
-test parseExpr-1.5 {Tcl_ParseExpr procedure, lexemes after the expression} testexprparser {
-    list [catch {testexprparser {1+2 345} -1} msg] $msg
-} {1 {syntax error in expression "1+2 345": extra tokens at end of expression}}
+        testexprparser {foo+} -1
+    } -match glob -returnCodes error -result *
+test parseExpr-1.5 {Tcl_ParseExpr procedure, lexemes after the expression} -constraints testexprparser -body {
+    testexprparser {1+2 345} -1
+} -returnCodes error -match glob -result *
 
 test parseExpr-2.1 {ParseCondExpr procedure, valid test subexpr} testexprparser {
     testexprparser {2>3? 1 : 0} -1
 } {- {} 0 subexpr {2>3? 1 : 0} 11 operator ? 0 subexpr 2>3 5 operator > 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
 test parseExpr-2.2 {ParseCondExpr procedure, error in test subexpr} \
 	-constraints testexprparser -body {
-            list [catch {testexprparser {0 || foo} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "0 || foo": * preceding $*}}
+            testexprparser {0 || foo} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-2.3 {ParseCondExpr procedure, next lexeme isn't "?"} testexprparser {
     testexprparser {1+2} -1
 } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
 test parseExpr-2.4 {ParseCondExpr procedure, next lexeme is "?"} testexprparser {
     testexprparser {1+2 ? 3 : 4} -1
 } {- {} 0 subexpr {1+2 ? 3 : 4} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-2.5 {ParseCondExpr procedure, bad lexeme after "?"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1+2 ? 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-2.5 {ParseCondExpr procedure, bad lexeme after "?"} testexprparser {
+    testexprparser {1+2 ? 12345678901234567890 : 0} -1
+} {- {} 0 subexpr {1+2 ? 12345678901234567890 : 0} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 subexpr 0 1 text 0 0 {}}
 test parseExpr-2.6 {ParseCondExpr procedure, valid "then" subexpression} testexprparser {
     testexprparser {1? 3 : 4} -1
 } {- {} 0 subexpr {1? 3 : 4} 7 operator ? 0 subexpr 1 1 text 1 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-2.7 {ParseCondExpr procedure, error in "then" subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1? fred : martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1? fred : martha": *preceding $*}}
-test parseExpr-2.8 {ParseCondExpr procedure, lexeme after "then" subexpr isn't ":"} testexprparser {
-    list [catch {testexprparser {1? 2 martha 3} -1} msg] $msg
-} {1 {syntax error in expression "1? 2 martha 3": missing colon from ternary conditional}}
+        testexprparser {1? fred : martha} -1
+    } -match glob -returnCodes error -result *
+test parseExpr-2.8 {ParseCondExpr procedure, lexeme after "then" subexpr isn't ":"} -constraints testexprparser -body {
+    testexprparser {1? 2 martha 3} -1
+} -returnCodes error -match glob -result *
 test parseExpr-2.9 {ParseCondExpr procedure, valid "else" subexpression} testexprparser {
     testexprparser {27||3? 3 : 4&&9} -1
 } {- {} 0 subexpr {27||3? 3 : 4&&9} 15 operator ? 0 subexpr 27||3 5 operator || 0 subexpr 27 1 text 27 0 subexpr 3 1 text 3 0 subexpr 3 1 text 3 0 subexpr 4&&9 5 operator && 0 subexpr 4 1 text 4 0 subexpr 9 1 text 9 0 {}}
 test parseExpr-2.10 {ParseCondExpr procedure, error in "else" subexpression} \
-    -constraints  testexprparser -body {
-        list [catch {testexprparser {1? 2 : martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1? 2 : martha": * preceding $*}}
+    -constraints testexprparser -body {
+        testexprparser {1? 2 : martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-3.1 {ParseLorExpr procedure, valid logical and subexpr} testexprparser {
     testexprparser {1&&2 || 3} -1
 } {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-3.2 {ParseLorExpr procedure, error in logical and subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1&&foo || 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1&&foo || 3": * preceding $*}}
+        testexprparser {1&&foo || 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-3.3 {ParseLorExpr procedure, next lexeme isn't "||"} testexprparser {
     testexprparser {1&&2? 1 : 0} -1
 } {- {} 0 subexpr {1&&2? 1 : 0} 11 operator ? 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
 test parseExpr-3.4 {ParseLorExpr procedure, next lexeme is "||"} testexprparser {
     testexprparser {1&&2 || 3} -1
 } {- {} 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-3.5 {ParseLorExpr procedure, bad lexeme after "||"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1&&2 || 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-3.5 {ParseLorExpr procedure, bad lexeme after "||"} testexprparser {
+    testexprparser {1&&2 || 12345678901234567890} -1
+} {- {} 0 subexpr {1&&2 || 12345678901234567890} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-3.6 {ParseLorExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1&&2 || 3 || 4} -1
 } {- {} 0 subexpr {1&&2 || 3 || 4} 13 operator || 0 subexpr {1&&2 || 3} 9 operator || 0 subexpr 1&&2 5 operator && 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-3.7 {ParseLorExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1&&2 || 3 || martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1&&2 || 3 || martha": * preceding $*}}
+        testexprparser {1&&2 || 3 || martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-4.1 {ParseLandExpr procedure, valid LHS "|" subexpr} testexprparser {
     testexprparser {1|2 && 3} -1
 } {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-4.2 {ParseLandExpr procedure, error in LHS "|" subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1&&foo && 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1&&foo && 3": * preceding $*}}
+        testexprparser {1&&foo && 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-4.3 {ParseLandExpr procedure, next lexeme isn't "&&"} testexprparser {
     testexprparser {1|2? 1 : 0} -1
 } {- {} 0 subexpr {1|2? 1 : 0} 11 operator ? 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
 test parseExpr-4.4 {ParseLandExpr procedure, next lexeme is "&&"} testexprparser {
     testexprparser {1|2 && 3} -1
 } {- {} 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-4.5 {ParseLandExpr procedure, bad lexeme after "&&"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1|2 && 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-4.5 {ParseLandExpr procedure, bad lexeme after "&&"} testexprparser {
+    testexprparser {1|2 && 12345678901234567890} -1
+} {- {} 0 subexpr {1|2 && 12345678901234567890} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-4.6 {ParseLandExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1|2 && 3 && 4} -1
 } {- {} 0 subexpr {1|2 && 3 && 4} 13 operator && 0 subexpr {1|2 && 3} 9 operator && 0 subexpr 1|2 5 operator | 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-4.7 {ParseLandExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1|2 && 3 && martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1|2 && 3 && martha": * preceding $*}}
+        testexprparser {1|2 && 3 && martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-5.1 {ParseBitOrExpr procedure, valid LHS "^" subexpr} testexprparser {
     testexprparser {1^2 | 3} -1
 } {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-5.2 {ParseBitOrExpr procedure, error in LHS "^" subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1|foo | 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1|foo | 3": * preceding $*}}
+        testexprparser {1|foo | 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-5.3 {ParseBitOrExpr procedure, next lexeme isn't "|"} testexprparser {
     testexprparser {1^2? 1 : 0} -1
 } {- {} 0 subexpr {1^2? 1 : 0} 11 operator ? 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
 test parseExpr-5.4 {ParseBitOrExpr procedure, next lexeme is "|"} testexprparser {
     testexprparser {1^2 | 3} -1
 } {- {} 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-5.5 {ParseBitOrExpr procedure, bad lexeme after "|"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1^2 | 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-5.5 {ParseBitOrExpr procedure, bad lexeme after "|"} testexprparser {
+    testexprparser {1^2 | 12345678901234567890} -1
+} {- {} 0 subexpr {1^2 | 12345678901234567890} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-5.6 {ParseBitOrExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1^2 | 3 | 4} -1
 } {- {} 0 subexpr {1^2 | 3 | 4} 13 operator | 0 subexpr {1^2 | 3} 9 operator | 0 subexpr 1^2 5 operator ^ 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-5.7 {ParseBitOrExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1^2 | 3 | martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1^2 | 3 | martha": * preceding $*}}
+        testexprparser {1^2 | 3 | martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-6.1 {ParseBitXorExpr procedure, valid LHS "&" subexpr} testexprparser {
     testexprparser {1&2 ^ 3} -1
 } {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-6.2 {ParseBitXorExpr procedure, error in LHS "&" subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1^foo ^ 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1^foo ^ 3": * preceding $*}}
+        testexprparser {1^foo ^ 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-6.3 {ParseBitXorExpr procedure, next lexeme isn't "^"} testexprparser {
     testexprparser {1&2? 1 : 0} -1
 } {- {} 0 subexpr {1&2? 1 : 0} 11 operator ? 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
 test parseExpr-6.4 {ParseBitXorExpr procedure, next lexeme is "^"} testexprparser {
     testexprparser {1&2 ^ 3} -1
 } {- {} 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-6.5 {ParseBitXorExpr procedure, bad lexeme after "^"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1&2 ^ 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-6.5 {ParseBitXorExpr procedure, bad lexeme after "^"} testexprparser {
+    testexprparser {1&2 ^ 12345678901234567890} -1
+} {- {} 0 subexpr {1&2 ^ 12345678901234567890} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-6.6 {ParseBitXorExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1&2 ^ 3 ^ 4} -1
 } {- {} 0 subexpr {1&2 ^ 3 ^ 4} 13 operator ^ 0 subexpr {1&2 ^ 3} 9 operator ^ 0 subexpr 1&2 5 operator & 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-6.7 {ParseBitXorExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1&2 ^ 3 ^ martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1&2 ^ 3 ^ martha": * preceding $*}}
+        testexprparser {1&2 ^ 3 ^ martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-7.1 {ParseBitAndExpr procedure, valid LHS equality subexpr} testexprparser {
     testexprparser {1==2 & 3} -1
 } {- {} 0 subexpr {1==2 & 3} 9 operator & 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-7.2 {ParseBitAndExpr procedure, error in LHS equality subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1!=foo & 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1!=foo & 3": * preceding $*}}
+        testexprparser {1!=foo & 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-7.3 {ParseBitAndExpr procedure, next lexeme isn't "&"} testexprparser {
     testexprparser {1==2? 1 : 0} -1
 } {- {} 0 subexpr {1==2? 1 : 0} 11 operator ? 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
 test parseExpr-7.4 {ParseBitAndExpr procedure, next lexeme is "&"} testexprparser {
     testexprparser {1>2 & 3} -1
 } {- {} 0 subexpr {1>2 & 3} 9 operator & 0 subexpr 1>2 5 operator > 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-7.5 {ParseBitAndExpr procedure, bad lexeme after "&"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1==2 & 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-7.5 {ParseBitAndExpr procedure, bad lexeme after "&"} {testexprparser} {
+    testexprparser {1==2 & 12345678901234567890} -1
+} {- {} 0 subexpr {1==2 & 12345678901234567890} 9 operator & 0 subexpr 1==2 5 operator == 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-7.6 {ParseBitAndExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1<2 & 3 & 4} -1
 } {- {} 0 subexpr {1<2 & 3 & 4} 13 operator & 0 subexpr {1<2 & 3} 9 operator & 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-7.7 {ParseBitAndExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1==2 & 3>2 & martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1==2 & 3>2 & martha": * preceding $*}}
+        testexprparser {1==2 & 3>2 & martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-8.1 {ParseEqualityExpr procedure, valid LHS relational subexpr} testexprparser {
     testexprparser {1<2 == 3} -1
 } {- {} 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-8.2 {ParseEqualityExpr procedure, error in LHS relational subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1>=foo == 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1>=foo == 3": * preceding $*}}
+        testexprparser {1>=foo == 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-8.3 {ParseEqualityExpr procedure, next lexeme isn't "==" or "!="} testexprparser {
     testexprparser {1<2? 1 : 0} -1
 } {- {} 0 subexpr {1<2? 1 : 0} 11 operator ? 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
@@ -289,26 +268,24 @@ test parseExpr-8.4 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} te
 test parseExpr-8.5 {ParseEqualityExpr procedure, next lexeme is "==" or "!="} testexprparser {
     testexprparser {1<2 != 3} -1
 } {- {} 0 subexpr {1<2 != 3} 9 operator != 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-8.6 {ParseEqualityExpr procedure, bad lexeme after "==" or "!="} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1<2 == 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-8.6 {ParseEqualityExpr procedure, bad lexeme after "==" or "!="} testexprparser {
+    testexprparser {1<2 == 12345678901234567890} -1
+} {- {} 0 subexpr {1<2 == 12345678901234567890} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-8.7 {ParseEqualityExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1<2 == 3 == 4} -1
 } {- {} 0 subexpr {1<2 == 3 == 4} 13 operator == 0 subexpr {1<2 == 3} 9 operator == 0 subexpr 1<2 5 operator < 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-8.8 {ParseEqualityExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1<2 == 3 != martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1<2 == 3 != martha": * preceding $*}}
+        testexprparser {1<2 == 3 != martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-9.1 {ParseRelationalExpr procedure, valid LHS shift subexpr} testexprparser {
     testexprparser {1<<2 < 3} -1
 } {- {} 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-9.2 {ParseRelationalExpr procedure, error in LHS shift subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1>=foo < 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1>=foo < 3": * preceding $*}}
+        testexprparser {1>=foo < 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-9.3 {ParseRelationalExpr procedure, next lexeme isn't relational op} testexprparser {
     testexprparser {1<<2? 1 : 0} -1
 } {- {} 0 subexpr {1<<2? 1 : 0} 11 operator ? 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
@@ -324,26 +301,24 @@ test parseExpr-9.6 {ParseRelationalExpr procedure, next lexeme is relational op}
 test parseExpr-9.7 {ParseRelationalExpr procedure, next lexeme is relational op} testexprparser {
     testexprparser {1<<2 >= 3} -1
 } {- {} 0 subexpr {1<<2 >= 3} 9 operator >= 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-9.8 {ParseRelationalExpr procedure, bad lexeme after relational op} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1<<2 < 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-9.8 {ParseRelationalExpr procedure, bad lexeme after relational op} testexprparser {
+    testexprparser {1<<2 < 12345678901234567890} -1
+} {- {} 0 subexpr {1<<2 < 12345678901234567890} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-9.9 {ParseRelationalExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1<<2 < 3 < 4} -1
 } {- {} 0 subexpr {1<<2 < 3 < 4} 13 operator < 0 subexpr {1<<2 < 3} 9 operator < 0 subexpr 1<<2 5 operator << 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-9.10 {ParseRelationalExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1<<2 < 3 > martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1<<2 < 3 > martha": * preceding $*}}
+        testexprparser {1<<2 < 3 > martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-10.1 {ParseShiftExpr procedure, valid LHS add subexpr} testexprparser {
     testexprparser {1+2 << 3} -1
 } {- {} 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-10.2 {ParseShiftExpr procedure, error in LHS add subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1-foo << 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1-foo << 3": * preceding $*}}
+        testexprparser {1-foo << 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-10.3 {ParseShiftExpr procedure, next lexeme isn't "<<" or ">>"} testexprparser {
     testexprparser {1+2? 1 : 0} -1
 } {- {} 0 subexpr {1+2? 1 : 0} 11 operator ? 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
@@ -353,26 +328,24 @@ test parseExpr-10.4 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} test
 test parseExpr-10.5 {ParseShiftExpr procedure, next lexeme is "<<" or ">>"} testexprparser {
     testexprparser {1+2 >> 3} -1
 } {- {} 0 subexpr {1+2 >> 3} 9 operator >> 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-10.6 {ParseShiftExpr procedure, bad lexeme after "<<" or ">>"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1+2 << 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-10.6 {ParseShiftExpr procedure, bad lexeme after "<<" or ">>"} testexprparser {
+    testexprparser {1+2 << 12345678901234567890} -1
+} {- {} 0 subexpr {1+2 << 12345678901234567890} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-10.7 {ParseShiftExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1+2 << 3 << 4} -1
 } {- {} 0 subexpr {1+2 << 3 << 4} 13 operator << 0 subexpr {1+2 << 3} 9 operator << 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-10.8 {ParseShiftExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1+2 << 3 >> martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1+2 << 3 >> martha": * preceding $*}}
+        testexprparser {1+2 << 3 >> martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-11.1 {ParseAddExpr procedure, valid LHS multiply subexpr} testexprparser {
     testexprparser {1*2 + 3} -1
 } {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-11.2 {ParseAddExpr procedure, error in LHS multiply subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1/foo + 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1/foo + 3": * preceding $*}}
+        testexprparser {1/foo + 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-11.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} testexprparser {
     testexprparser {1*2? 1 : 0} -1
 } {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
@@ -382,26 +355,24 @@ test parseExpr-11.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexpr
 test parseExpr-11.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser {
     testexprparser {1*2 - 3} -1
 } {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-11.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1*2 + 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-11.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} testexprparser {
+    testexprparser {1*2 + 12345678901234567890} -1
+} {- {} 0 subexpr {1*2 + 12345678901234567890} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-11.7 {ParseAddExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1*2 + 3 + 4} -1
 } {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-11.8 {ParseAddExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1*2 + 3 - martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1*2 + 3 - martha": * preceding $*}}
+        testexprparser {1*2 + 3 - martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-12.1 {ParseAddExpr procedure, valid LHS multiply subexpr} testexprparser {
     testexprparser {1*2 + 3} -1
 } {- {} 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-12.2 {ParseAddExpr procedure, error in LHS multiply subexpr} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1/foo + 3} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1/foo + 3": * preceding $*}}
+        testexprparser {1/foo + 3} -1
+    } -match glob -returnCodes error -result *
 test parseExpr-12.3 {ParseAddExpr procedure, next lexeme isn't "+" or "-"} testexprparser {
     testexprparser {1*2? 1 : 0} -1
 } {- {} 0 subexpr {1*2? 1 : 0} 11 operator ? 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
@@ -411,24 +382,23 @@ test parseExpr-12.4 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexpr
 test parseExpr-12.5 {ParseAddExpr procedure, next lexeme is "+" or "-"} testexprparser {
     testexprparser {1*2 - 3} -1
 } {- {} 0 subexpr {1*2 - 3} 9 operator - 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-12.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {1*2 + 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-12.6 {ParseAddExpr procedure, bad lexeme after "+" or "-"} testexprparser {
+    testexprparser {1*2 + 12345678901234567890} -1
+} {- {} 0 subexpr {1*2 + 12345678901234567890} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-12.7 {ParseAddExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {1*2 + 3 + 4} -1
 } {- {} 0 subexpr {1*2 + 3 + 4} 13 operator + 0 subexpr {1*2 + 3} 9 operator + 0 subexpr 1*2 5 operator * 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-12.8 {ParseAddExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {1*2 + 3 - martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "1*2 + 3 - martha": * preceding $*}}
+        testexprparser {1*2 + 3 - martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-13.1 {ParseMultiplyExpr procedure, valid LHS unary subexpr} testexprparser {
     testexprparser {+2 * 3} -1
 } {- {} 0 subexpr {+2 * 3} 7 operator * 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-13.2 {ParseMultiplyExpr procedure, error in LHS unary subexpr} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {-12345678901234567890 * 3} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-13.2 {ParseMultiplyExpr procedure, error in LHS unary subexpr} testexprparser {
+    testexprparser {-12345678901234567890 * 3} -1
+} {- {} 0 subexpr {-12345678901234567890 * 3} 7 operator * 0 subexpr -12345678901234567890 3 operator - 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 subexpr 3 1 text 3 0 {}}
 test parseExpr-13.3 {ParseMultiplyExpr procedure, next lexeme isn't "*", "/", or "%"} testexprparser {
     testexprparser {+2? 1 : 0} -1
 } {- {} 0 subexpr {+2? 1 : 0} 9 operator ? 0 subexpr +2 3 operator + 0 subexpr 2 1 text 2 0 subexpr 1 1 text 1 0 subexpr 0 1 text 0 0 {}}
@@ -441,17 +411,16 @@ test parseExpr-13.5 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%
 test parseExpr-13.6 {ParseMultiplyExpr procedure, next lexeme is "*", "/", or "%"} testexprparser {
     testexprparser {+-456 % 3} -1
 } {- {} 0 subexpr {+-456 % 3} 9 operator % 0 subexpr +-456 5 operator + 0 subexpr -456 3 operator - 0 subexpr 456 1 text 456 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-13.7 {ParseMultiplyExpr procedure, bad lexeme after "*", "/", or "%"} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {--++5 / 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-13.7 {ParseMultiplyExpr procedure, bad lexeme after "*", "/", or "%"} testexprparser {
+    testexprparser {--++5 / 12345678901234567890} -1
+} {- {} 0 subexpr {--++5 / 12345678901234567890} 13 operator / 0 subexpr --++5 9 operator - 0 subexpr -++5 7 operator - 0 subexpr ++5 5 operator + 0 subexpr +5 3 operator + 0 subexpr 5 1 text 5 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-13.8 {ParseMultiplyExpr procedure, valid RHS subexpression} testexprparser {
     testexprparser {-2 / 3 % 4} -1
 } {- {} 0 subexpr {-2 / 3 % 4} 11 operator % 0 subexpr {-2 / 3} 7 operator / 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 subexpr 4 1 text 4 0 {}}
 test parseExpr-13.9 {ParseMultiplyExpr procedure, error in RHS subexpression} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {++2 / 3 * martha} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "++2 / 3 * martha": * preceding $*}}
+        testexprparser {++2 / 3 * martha} -1
+    } -match glob -returnCodes error -result *
 
 test parseExpr-14.1 {ParseUnaryExpr procedure, first token is unary operator} testexprparser {
     testexprparser {+2} -1
@@ -465,46 +434,46 @@ test parseExpr-14.3 {ParseUnaryExpr procedure, first token is unary operator} te
 test parseExpr-14.4 {ParseUnaryExpr procedure, first token is unary operator} testexprparser {
     testexprparser {!2} -1
 } {- {} 0 subexpr !2 3 operator ! 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.5 {ParseUnaryExpr procedure, error in lexeme after unary op} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {-12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-14.5 {ParseUnaryExpr procedure, error in lexeme after unary op} testexprparser {
+    testexprparser {-12345678901234567890} -1
+} {- {} 0 subexpr -12345678901234567890 3 operator - 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-14.6 {ParseUnaryExpr procedure, simple unary expr after unary op} testexprparser {
     testexprparser {+"1234"} -1
 } {- {} 0 subexpr +\"1234\" 3 operator + 0 subexpr {"1234"} 1 text 1234 0 {}}
 test parseExpr-14.7 {ParseUnaryExpr procedure, another unary expr after unary op} testexprparser {
     testexprparser {~!{fred}} -1
 } {- {} 0 subexpr ~!{fred} 5 operator ~ 0 subexpr !{fred} 3 operator ! 0 subexpr {{fred}} 1 text fred 0 {}}
-test parseExpr-14.8 {ParseUnaryExpr procedure, error in unary expr after unary op} testexprparser {
-    list [catch {testexprparser {+-||27} -1} msg] $msg
-} {1 {syntax error in expression "+-||27": unexpected operator ||}}
-test parseExpr-14.9 {ParseUnaryExpr procedure, error in unary expr after unary op} testexprparser {
-    list [catch {testexprparser {+-||27} -1} msg] $msg
-} {1 {syntax error in expression "+-||27": unexpected operator ||}}
+test parseExpr-14.8 {ParseUnaryExpr procedure, error in unary expr after unary op} -constraints testexprparser -body {
+    testexprparser {+-||27} -1
+} -returnCodes error -match glob -result *
+test parseExpr-14.9 {ParseUnaryExpr procedure, error in unary expr after unary op} -constraints testexprparser -body {
+    testexprparser {+-||27} -1
+} -returnCodes error -match glob -result *
 test parseExpr-14.10 {ParseUnaryExpr procedure, first token is not unary op} testexprparser {
     testexprparser {123} -1
 } {- {} 0 subexpr 123 1 text 123 0 {}}
 test parseExpr-14.11 {ParseUnaryExpr procedure, not unary expr, complex primary expr} testexprparser {
     testexprparser {(1+2)} -1
 } {- {} 0 subexpr 1+2 5 operator + 0 subexpr 1 1 text 1 0 subexpr 2 1 text 2 0 {}}
-test parseExpr-14.12 {ParseUnaryExpr procedure, not unary expr, error in primary expr} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {(12345678901234567890)} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-14.12 {ParseUnaryExpr procedure, not unary expr, error in primary expr} testexprparser {
+    testexprparser {(12345678901234567890)} -1
+} {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 
 test parseExpr-15.1 {ParsePrimaryExpr procedure, just parenthesized subexpr} testexprparser {
     testexprparser {({abc}/{def})} -1
 } {- {} 0 subexpr {{abc}/{def}} 5 operator / 0 subexpr {{abc}} 1 text abc 0 subexpr {{def}} 1 text def 0 {}}
-test parseExpr-15.2 {ParsePrimaryExpr procedure, bad lexeme after "("} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {(12345678901234567890)} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-15.2 {ParsePrimaryExpr procedure, bad lexeme after "("} {testexprparser} {
+    testexprparser {(12345678901234567890)} -1
+} {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-15.3 {ParsePrimaryExpr procedure, valid parenthesized subexpr} testexprparser {
     testexprparser {({abc}? 2*4 : -6)} -1
 } {- {} 0 subexpr {{abc}? 2*4 : -6} 13 operator ? 0 subexpr {{abc}} 1 text abc 0 subexpr 2*4 5 operator * 0 subexpr 2 1 text 2 0 subexpr 4 1 text 4 0 subexpr -6 3 operator - 0 subexpr 6 1 text 6 0 {}}
-test parseExpr-15.4 {ParsePrimaryExpr procedure, error in parenthesized subexpr} testexprparser {
-    list [catch {testexprparser {(? 123 : 456)} -1} msg] $msg
-} {1 {syntax error in expression "(? 123 : 456)": unexpected ternary 'then' separator}}
-test parseExpr-15.5 {ParsePrimaryExpr procedure, missing ")" after in parenthesized subexpr} testexprparser {
-    list [catch {testexprparser {({abc}/{def}} -1} msg] $msg
-} {1 {syntax error in expression "({abc}/{def}": looking for close parenthesis}}
+test parseExpr-15.4 {ParsePrimaryExpr procedure, error in parenthesized subexpr} -constraints testexprparser -body {
+    testexprparser {(? 123 : 456)} -1
+} -returnCodes error -match glob -result *
+test parseExpr-15.5 {ParsePrimaryExpr procedure, missing ")" after in parenthesized subexpr} -constraints testexprparser -body {
+    testexprparser {({abc}/{def}} -1
+} -returnCodes error -match glob -result *
 test parseExpr-15.6 {ParsePrimaryExpr procedure, primary is literal} testexprparser {
     testexprparser {12345} -1
 } {- {} 0 subexpr 12345 1 text 12345 0 {}}
@@ -520,15 +489,15 @@ test parseExpr-15.9 {ParsePrimaryExpr procedure, primary is var reference} teste
 test parseExpr-15.10 {ParsePrimaryExpr procedure, primary is var reference} testexprparser {
     testexprparser {$a()} -1
 } {- {} 0 subexpr {$a()} 3 variable {$a()} 2 text a 0 text {} 0 {}}
-test parseExpr-15.11 {ParsePrimaryExpr procedure, error in var reference} testexprparser {
-    list [catch {testexprparser {$a(} -1} msg] $msg
-} {1 {missing )}}
+test parseExpr-15.11 {ParsePrimaryExpr procedure, error in var reference} -constraints testexprparser -body {
+    testexprparser {$a(} -1
+} -returnCodes error -match glob -result *
 test parseExpr-15.12 {ParsePrimaryExpr procedure, primary is quoted string} testexprparser {
     testexprparser {"abc $xyz def"} -1
 } {- {} 0 subexpr {"abc $xyz def"} 5 word {"abc $xyz def"} 4 text {abc } 0 variable {$xyz} 1 text xyz 0 text { def} 0 {}}
-test parseExpr-15.13 {ParsePrimaryExpr procedure, error in quoted string} testexprparser {
-    list [catch {testexprparser {"$a(12"} -1} msg] $msg
-} {1 {missing )}}
+test parseExpr-15.13 {ParsePrimaryExpr procedure, error in quoted string} -constraints testexprparser -body {
+    testexprparser {"$a(12"} -1
+} -returnCodes error -match glob -result *
 test parseExpr-15.14 {ParsePrimaryExpr procedure, quoted string has multiple tokens} testexprparser {
     testexprparser {"abc [xyz] $def"} -1
 } {- {} 0 subexpr {"abc [xyz] $def"} 6 word {"abc [xyz] $def"} 5 text {abc } 0 command {[xyz]} 0 text { } 0 variable {$def} 1 text def 0 {}}
@@ -541,15 +510,15 @@ test parseExpr-15.16 {ParsePrimaryExpr procedure, primary is multiple commands}
 test parseExpr-15.17 {ParsePrimaryExpr procedure, primary is multiple commands} testexprparser {
     testexprparser {[one; two; three; four;]} -1
 } {- {} 0 subexpr {[one; two; three; four;]} 1 command {[one; two; three; four;]} 0 {}}
-test parseExpr-15.18 {ParsePrimaryExpr procedure, missing close bracket} testexprparser {
-    list [catch {testexprparser {[one} -1} msg] $msg
-} {1 {missing close-bracket}}
+test parseExpr-15.18 {ParsePrimaryExpr procedure, missing close bracket} -constraints testexprparser -body {
+    testexprparser {[one} -1
+} -returnCodes error -match glob -result *
 test parseExpr-15.19 {ParsePrimaryExpr procedure, primary is braced string} testexprparser {
     testexprparser {{hello world}} -1
 } {- {} 0 subexpr {{hello world}} 1 text {hello world} 0 {}}
-test parseExpr-15.20 {ParsePrimaryExpr procedure, error in primary, which is braced string} testexprparser {
-    list [catch {testexprparser "\{abc\\\n" -1} msg] $msg
-} {1 {missing close-brace}}
+test parseExpr-15.20 {ParsePrimaryExpr procedure, error in primary, which is braced string} -constraints testexprparser -body {
+    testexprparser "\{abc\\\n" -1
+} -returnCodes error -match glob -result *
 test parseExpr-15.21 {ParsePrimaryExpr procedure, primary is braced string with multiple tokens} testexprparser {
     testexprparser "\{  \\
  +123 \}" -1
@@ -557,51 +526,50 @@ test parseExpr-15.21 {ParsePrimaryExpr procedure, primary is braced string with
 test parseExpr-15.22 {ParsePrimaryExpr procedure, primary is function call} testexprparser {
     testexprparser {foo(123)} -1
 } {- {} 0 subexpr foo(123) 3 operator foo 0 subexpr 123 1 text 123 0 {}}
-test parseExpr-15.23 {ParsePrimaryExpr procedure, bad lexeme after function name} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {foo 12345678901234567890 123)} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-15.23 {ParsePrimaryExpr procedure, bad lexeme after function name} -constraints testexprparser -body {
+    testexprparser {foo 12345678901234567890 123)} -1
+} -returnCodes error -match glob -result *
 test parseExpr-15.24 {ParsePrimaryExpr procedure, lexeme after function name isn't "("} \
     -constraints testexprparser -body {
-        list [catch {testexprparser {foo 27.4 123)} -1} msg] $msg
-    } -match glob \
-    -result {1 {syntax error in expression "foo 27.4 123)": * preceding $*}}
-test parseExpr-15.25 {ParsePrimaryExpr procedure, bad lexeme after "("} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {foo(12345678901234567890)} -1} msg] $msg
-} {1 {integer value too large to represent}}
+        testexprparser {foo 27.4 123)} -1
+    } -match glob -returnCodes error -result *
+test parseExpr-15.25 {ParsePrimaryExpr procedure, bad lexeme after "("} testexprparser {
+    testexprparser {foo(12345678901234567890)} -1
+} {- {} 0 subexpr foo(12345678901234567890) 3 operator foo 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-15.26 {ParsePrimaryExpr procedure, function call, one arg} testexprparser {
     testexprparser {foo(27*4)} -1
 } {- {} 0 subexpr foo(27*4) 7 operator foo 0 subexpr 27*4 5 operator * 0 subexpr 27 1 text 27 0 subexpr 4 1 text 4 0 {}}
-test parseExpr-15.27 {ParsePrimaryExpr procedure, error in function arg} testexprparser {
-    list [catch {testexprparser {foo(*1-2)} -1} msg] $msg
-} {1 {syntax error in expression "foo(*1-2)": unexpected operator *}}
-test parseExpr-15.28 {ParsePrimaryExpr procedure, error in function arg} testexprparser {
-    list [catch {testexprparser {foo(*1-2)} -1} msg] $msg
-} {1 {syntax error in expression "foo(*1-2)": unexpected operator *}}
+test parseExpr-15.27 {ParsePrimaryExpr procedure, error in function arg} -constraints testexprparser -body {
+    testexprparser {foo(*1-2)} -1
+} -returnCodes error -match glob -result *
+test parseExpr-15.28 {ParsePrimaryExpr procedure, error in function arg} -constraints testexprparser -body {
+    testexprparser {foo(*1-2)} -1
+} -returnCodes error -match glob -result *
 test parseExpr-15.29 {ParsePrimaryExpr procedure, function call, comma after arg} testexprparser {
     testexprparser {foo(27-2, (-2*[foo]))} -1
 } {- {} 0 subexpr {foo(27-2, (-2*[foo]))} 15 operator foo 0 subexpr 27-2 5 operator - 0 subexpr 27 1 text 27 0 subexpr 2 1 text 2 0 subexpr {-2*[foo]} 7 operator * 0 subexpr -2 3 operator - 0 subexpr 2 1 text 2 0 subexpr {[foo]} 1 command {[foo]} 0 {}}
-test parseExpr-15.30 {ParsePrimaryExpr procedure, bad lexeme after comma} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {foo(123, 12345678901234567890)} -1} msg] $msg
-} {1 {integer value too large to represent}}
-test parseExpr-15.31 {ParsePrimaryExpr procedure, lexeme not "," or ")" after arg} testexprparser {
-    list [catch {testexprparser {foo(123 [foo])} -1} msg] $msg
-} {1 {syntax error in expression "foo(123 [foo])": missing close parenthesis at end of function call}}
-test parseExpr-15.32 {ParsePrimaryExpr procedure, bad lexeme after primary} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {123 12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
-test parseExpr-15.33 {ParsePrimaryExpr procedure, comma-specific message} testexprparser {
-    list [catch {testexprparser {123+,456} -1} msg] $msg
-} {1 {syntax error in expression "123+,456": commas can only separate function arguments}}
-test parseExpr-15.34 {ParsePrimaryExpr procedure, single equal-specific message} testexprparser {
-    list [catch {testexprparser {123+=456} -1} msg] $msg
-} {1 {syntax error in expression "123+=456": single equality character not legal in expressions}}
-test parseExpr-15.35 {ParsePrimaryExpr procedure, error in parenthesized subexpr} testexprparser {
-    list [catch {testexprparser {(: 123 : 456)} -1} msg] $msg
-} {1 {syntax error in expression "(: 123 : 456)": unexpected ternary 'else' separator}}
-test parseExpr-15.36 {ParsePrimaryExpr procedure, missing close-bracket} testexprparser {
+test parseExpr-15.30 {ParsePrimaryExpr procedure, bad lexeme after comma} testexprparser {
+    testexprparser {foo(123, 12345678901234567890)} -1
+} {- {} 0 subexpr {foo(123, 12345678901234567890)} 5 operator foo 0 subexpr 123 1 text 123 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
+test parseExpr-15.31 {ParsePrimaryExpr procedure, lexeme not "," or ")" after arg} -constraints  testexprparser -body {
+    testexprparser {foo(123 [foo])} -1
+} -returnCodes error -match glob -result *
+test parseExpr-15.32 {ParsePrimaryExpr procedure, bad lexeme after primary} -constraints testexprparser -body {
+    testexprparser {123 12345678901234567890} -1
+} -returnCodes error -match glob -result *
+test parseExpr-15.33 {ParsePrimaryExpr procedure, comma-specific message} -constraints testexprparser -body {
+    testexprparser {123+,456} -1
+} -returnCodes error -match glob -result *
+test parseExpr-15.34 {ParsePrimaryExpr procedure, single equal-specific message} -constraints testexprparser -body {
+    testexprparser {123+=456} -1
+} -returnCodes error -match glob -result *
+test parseExpr-15.35 {ParsePrimaryExpr procedure, error in parenthesized subexpr} -constraints testexprparser -body {
+    testexprparser {(: 123 : 456)} -1
+} -returnCodes error -match glob -result *
+test parseExpr-15.36 {ParsePrimaryExpr procedure, missing close-bracket} -constraints testexprparser -body {
     # Test for Bug 681841
-    list [catch {testexprparser {[set a [format bc]} -1} msg] $msg
-} {1 {missing close-bracket}}
+    testexprparser {[set a [format bc]} -1
+} -returnCodes error -match glob -result *
 
 test parseExpr-16.1 {GetLexeme procedure, whitespace before lexeme} testexprparser {
     testexprparser {   123} -1
@@ -617,11 +585,11 @@ test parseExpr-16.3 {GetLexeme procedure, no lexeme after whitespace} testexprpa
 test parseExpr-16.4 {GetLexeme procedure, integer lexeme} testexprparser {
     testexprparser {000} -1
 } {- {} 0 subexpr 000 1 text 000 0 {}}
-test parseExpr-16.5 {GetLexeme procedure, integer lexeme too big} {testexprparser wideIs32bit} {
-    list [catch {testexprparser {12345678901234567890} -1} msg] $msg
-} {1 {integer value too large to represent}}
+test parseExpr-16.5 {GetLexeme procedure, integer lexeme too big} testexprparser {
+    testexprparser {12345678901234567890} -1
+} {- {} 0 subexpr 12345678901234567890 1 text 12345678901234567890 0 {}}
 test parseExpr-16.6 {GetLexeme procedure, bad integer lexeme} -constraints testexprparser -body {
-    testexprparser {0999} -1
+    testexprparser {0o999} -1
 } -returnCodes error -match glob -result {*invalid octal number*}
 test parseExpr-16.7 {GetLexeme procedure, double lexeme} testexprparser {
     testexprparser {0.999} -1
@@ -641,9 +609,9 @@ test parseExpr-16.11a {GetLexeme procedure, bad double lexeme too big} {testexpr
 test parseExpr-16.11b {GetLexeme procedure, bad double lexeme too big} {testexprparser && ieeeFloatingPoint} {
     list [catch {testexprparser {123.e+99999999999999} -1} msg] $msg
 } {0 {- {} 0 subexpr 123.e+99999999999999 1 text 123.e+99999999999999 0 {}}}
-test parseExpr-16.12 {GetLexeme procedure, bad double lexeme} testexprparser {
-    list [catch {testexprparser {123.4x56} -1} msg] $msg
-} {1 {syntax error in expression "123.4x56": extra tokens at end of expression}}
+test parseExpr-16.12 {GetLexeme procedure, bad double lexeme} -constraints testexprparser -body {
+    testexprparser {123.4x56} -1
+} -returnCodes error -match glob -result *
 test parseExpr-16.13 {GetLexeme procedure, lexeme is "["} testexprparser {
     testexprparser {[foo]} -1
 } {- {} 0 subexpr {[foo]} 1 command {[foo]} 0 {}}
@@ -704,9 +672,9 @@ test parseExpr-16.31 {GetLexeme procedure, lexeme is ">="} testexprparser {
 test parseExpr-16.32 {GetLexeme procedure, lexeme is "=="} testexprparser {
     testexprparser {2==3} -1
 } {- {} 0 subexpr 2==3 5 operator == 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.33 {GetLexeme procedure, bad lexeme starting with "="} testexprparser {
-    list [catch {testexprparser {2=+3} -1} msg] $msg
-} {1 {syntax error in expression "2=+3": extra tokens at end of expression}}
+test parseExpr-16.33 {GetLexeme procedure, bad lexeme starting with "="} -constraints testexprparser -body {
+    testexprparser {2=+3} -1
+} -returnCodes error -match glob -result *
 test parseExpr-16.34 {GetLexeme procedure, lexeme is "!="} testexprparser {
     testexprparser {2!=3} -1
 } {- {} 0 subexpr 2!=3 5 operator != 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
@@ -737,25 +705,365 @@ test parseExpr-16.42 {GetLexeme procedure, lexeme is func name} testexprparser {
 test parseExpr-16.43 {GetLexeme procedure, lexeme is func name} testexprparser {
     testexprparser {harmonic_ratio(2,3)} -1
 } {- {} 0 subexpr harmonic_ratio(2,3) 5 operator harmonic_ratio 0 subexpr 2 1 text 2 0 subexpr 3 1 text 3 0 {}}
-test parseExpr-16.44 {GetLexeme procedure, unknown lexeme} testexprparser {
-    list [catch {testexprparser {@27} -1} msg] $msg
-} {1 {syntax error in expression "@27": character not legal in expressions}}
+test parseExpr-16.44 {GetLexeme procedure, unknown lexeme} -constraints testexprparser -body {
+    testexprparser {@27} -1
+} -returnCodes error -match glob -result *
 
 test parseExpr-17.1 {PrependSubExprTokens procedure, expand token array} testexprparser {
     testexprparser {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} -1
 } {- {} 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 13 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 9 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]&&[string compare [format %c $i] [string index $a $i]]} 5 operator && 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 subexpr {[string compare [format %c $i] [string index $a $i]]} 1 command {[string compare [format %c $i] [string index $a $i]]} 0 {}}
 
-test parseExpr-18.1 {LogSyntaxError procedure, error in expr longer than 60 chars} testexprparser {
-    list [catch {testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1} msg] $msg
-} {1 {syntax error in expression "(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+012...": premature end of expression}}
+test parseExpr-18.1 {LogSyntaxError procedure, error in expr longer than 60 chars} -constraints testexprparser -body {
+    testexprparser {(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)*(+0123456)/} -1
+} -returnCodes error -match glob -result *
 
-test parseExpr-19.1 {TclParseInteger: [Bug 648441]} {
+test parseExpr-19.1 {TclParseInteger: [Bug 648441]} -body {
     # Should see this as integer "0" followed by incomplete function "x"
     # Thus, syntax error.
     # If Bug 648441 is not fixed, "0x" will be seen as floating point 0.0
-    list [catch {expr 0x} result] $result
-} [list 1 {syntax error in expression "0x": extra tokens at end of expression}]
+    expr 0x
+} -returnCodes error -match glob -result *
+
+test parseExpr-20.1 {Bug 1451233} {
+    expr 1000000000000000000042
+} 1000000000000000000042
+test parseExpr-20.2 {Bug 1451233} {
+    expr 10000000000000000000420000000042
+} 10000000000000000000420000000042
+test parseExpr-20.3 {Bug 1451233} {
+    expr 10000000000000000000020000000002
+} 10000000000000000000020000000002
+
+test parseExpr-21.1 {error messages} -body {
+    expr @
+} -returnCodes error -result {invalid character "@"
+in expression "@"}
+test parseExpr-21.2 {error messages} -body {
+    expr =
+} -returnCodes error -result {incomplete operator "="
+in expression "="}
+test parseExpr-21.3 {error messages} -body {
+    expr x
+} -returnCodes error -result {invalid bareword "x"
+in expression "x";
+should be "$x" or "{x}" or "x(...)" or ...}
+test parseExpr-21.4 {error messages} -body {
+    expr abcdefghijklmnopqrstuvwxyz
+} -returnCodes error -result {invalid bareword "abcdefghijklmnopqrstuv..."
+in expression "abcdefghijklmnopqrstuv...";
+should be "$abcdefghijklmnopqrstuv..." or "{abcdefghijklmnopqrstuv...}" or "abcdefghijklmnopqrstuv...(...)" or ...}
+test parseExpr-21.5 {error messages} -body {
+    expr {[][]}
+} -returnCodes error -result {missing operator at _@_
+in expression "[]_@_[]"}
+test parseExpr-21.6 {error messages} -body {
+    expr {0 0}
+} -returnCodes error -result {missing operator at _@_
+in expression "0 _@_0"}
+test parseExpr-21.7 {error messages} -body {
+    expr {0o8}
+} -returnCodes error -match glob -result {*invalid octal number*}
+test parseExpr-21.8 {error messages} -body {
+    expr {0o8x}
+} -returnCodes error -match glob -result {*invalid octal number*}
+test parseExpr-21.9 {error messages} -body {
+    expr {"} 
+} -returnCodes error -result {missing "
+in expression """}
+test parseExpr-21.10 {error messages} -body {
+    expr \{ 
+} -returnCodes error -result "missing close-brace
+in expression \"\{\""
+test parseExpr-21.11 {error messages} -body {
+    expr $
+} -returnCodes error -result {invalid character "$"
+in expression "$"}
+test parseExpr-21.12 {error messages} -body {
+    expr {$(}
+} -returnCodes error -result {missing )
+in expression "$("}
+test parseExpr-21.13 {error messages} -body {
+    expr {[""x]}
+} -returnCodes error -result {extra characters after close-quote
+in expression "[""x]"}
+test parseExpr-21.14 {error messages} -body {
+    expr {[}
+} -returnCodes error -result {missing close-bracket
+in expression "["}
+test parseExpr-21.15 {error messages} -body {
+    expr 0~0
+} -returnCodes error -result {missing operator at _@_
+in expression "0_@_~0"}
+test parseExpr-21.16 {error messages} -body {
+    expr ()
+} -returnCodes error -result {empty subexpression at _@_
+in expression "(_@_)"}
+test parseExpr-21.17 {error messages} -body {
+    expr (
+} -returnCodes error -result {unbalanced open paren
+in expression "("}
+test parseExpr-21.18 {error messages} -body {
+    expr a(0,)
+} -returnCodes error -result {missing function argument at _@_
+in expression "a(0,_@_)"}
+test parseExpr-21.19 {error messages} -body {
+    expr {}
+} -returnCodes error -result {empty expression
+in expression ""}
+test parseExpr-21.20 {error messages} -body {
+    expr )
+} -returnCodes error -result {unbalanced close paren
+in expression ")"}
+test parseExpr-21.21 {error messages} -body {
+    expr a(,0)
+} -returnCodes error -result {missing function argument at _@_
+in expression "a(_@_,0)"}
+test parseExpr-21.22 {error messages} -body {
+    expr 0&|0
+} -returnCodes error -result {missing operand at _@_
+in expression "0&_@_|0"}
+test parseExpr-21.23 {error messages} -body {
+    expr 0^^0
+} -returnCodes error -result {missing operand at _@_
+in expression "0^_@_^0"}
+test parseExpr-21.24 {error messages} -body {
+    expr 0|&0
+} -returnCodes error -result {missing operand at _@_
+in expression "0|_@_&0"}
+test parseExpr-21.25 {error messages} -body {
+    expr a(1+,0)
+} -returnCodes error -result {missing operand at _@_
+in expression "a(1+_@_,0)"}
+test parseExpr-21.26 {error messages} -body {
+    expr (0
+} -returnCodes error -result {unbalanced open paren
+in expression "(0"}
+test parseExpr-21.27 {error messages} -body {
+    expr 0?0
+} -returnCodes error -result {missing operator ":" at _@_
+in expression "0?0_@_"}
+test parseExpr-21.28 {error messages} -body {
+    expr 0:0
+} -returnCodes error -result {unexpected operator ":" without preceding "?"
+in expression "0:0"}
+test parseExpr-21.29 {error messages} -body {
+    expr 0)
+} -returnCodes error -result {unbalanced close paren
+in expression "0)"}
+test parseExpr-21.30 {error messages} -body {
+    expr 0,
+} -returnCodes error -result {unexpected "," outside function argument list
+in expression "0,"}
+test parseExpr-21.31 {error messages} -body {
+    expr 0,0
+} -returnCodes error -result {unexpected "," outside function argument list
+in expression "0,0"}
+test parseExpr-21.32 {error messages} -body {
+    expr (0,0)
+} -returnCodes error -result {unexpected "," outside function argument list
+in expression "(0,0)"}
+test parseExpr-21.33 {error messages} -body {
+    expr a(0:0,0)
+} -returnCodes error -result {unexpected operator ":" without preceding "?"
+in expression "a(0:0,0)"}
+test parseExpr-21.34 {error messages} -body {
+    expr {"abcdefghijklmnopqrstuvwxyz"@0}
+} -returnCodes error -result {invalid character "@"
+in expression "...fghijklmnopqrstuvwxyz"@0"}
+test parseExpr-21.35 {error messages} -body {
+    expr {0@"abcdefghijklmnopqrstuvwxyz"}
+} -returnCodes error -result {invalid character "@"
+in expression "0@"abcdefghijklmnopqrstu..."}
+test parseExpr-21.36 {error messages} -body {
+    expr {"abcdefghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstuvwxyz"}
+} -returnCodes error -result {invalid character "@"
+in expression "...fghijklmnopqrstuvwxyz"@"abcdefghijklmnopqrstu..."}
+test parseExpr-21.37 {error messages} -body {
+    expr [format {"%s" @ 0} [string repeat \u00a7 25]]
+} -returnCodes error -result [format {invalid character "@"
+in expression "...%s" @ 0"} [string repeat \u00a7 10]]
+test parseExpr-21.38 {error messages} -body {
+    expr [format {0 @ "%s"} [string repeat \u00a7 25]]
+} -returnCodes error -result [format {invalid character "@"
+in expression "0 @ "%s..."} [string repeat \u00a7 10]]
+test parseExpr-21.39 {error messages} -body {
+    expr [format {"%s" @ "%s"} [string repeat \u00a7 25] [string repeat \u00a7 25]]
+} -returnCodes error -result [format {invalid character "@"
+in expression "...%s" @ "%s..."} [string repeat \u00a7 10] [string repeat \u00a7 10]]
+test parseExpr-21.40 {error messages} -body {
+    catch {expr {"abcdefghijklmnopqrstuvwxyz"@0}} m o
+    dict get $o -errorinfo
+} -result {invalid character "@"
+in expression "...fghijklmnopqrstuvwxyz"@0"
+    (parsing expression ""abcdefghijklmnopqrstu...")
+    invoked from within
+"expr {"abcdefghijklmnopqrstuvwxyz"@0}"}
+test parseExpr-21.41 {error messages} -body {
+    catch {expr [format {"%s" @ 0} [string repeat \u00a7 25]]} m o
+    dict get $o -errorinfo
+} -result [format {invalid character "@"
+in expression "...%s" @ 0"
+    (parsing expression ""%s...")
+    invoked from within
+"expr [format {"%%s" @ 0} [string repeat \u00a7 25]]"} [string repeat \u00a7 10] [string repeat \u00a7 10]]
+test parseExpr-21.42 {error message} -body {
+    expr {123456789012345678901234567890*"abcdefghijklmnopqrstuvwxyz}
+} -returnCodes error -result {missing "
+in expression "...012345678901234567890*"abcdefghijklmnopqrstuv..."}
+test parseExpr-21.43 {error message} -body {
+    expr "123456789012345678901234567890*\"foobar\$\{abcdefghijklmnopqrstuvwxyz\""
+} -returnCodes error -result "missing close-brace for variable name
+in expression \"...8901234567890*\"foobar\$\{abcdefghijklmnopqrstuv...\""
+test parseExpr-21.44 {error message} -body {
+    expr {123456789012345678901234567890*"foo$bar(abcdefghijklmnopqrstuvwxyz"}
+} -returnCodes error -result {missing )
+in expression "...8901234567890*"foo$bar(abcdefghijklmnopqrstuv..."}
+test parseExpr-21.45 {error message} -body {
+    expr {123456789012345678901234567890*"foo$bar([{}abcdefghijklmnopqrstuvwxyz])"}
+} -returnCodes error -result {extra characters after close-brace
+in expression "...234567890*"foo$bar([{}abcdefghijklmnopqrstuv..."}
+test parseExpr-21.46 {error message} -body {
+    expr {123456789012345678901234567890*"foo$bar([""abcdefghijklmnopqrstuvwxyz])"}
+} -returnCodes error -result {extra characters after close-quote
+in expression "...234567890*"foo$bar([""abcdefghijklmnopqrstuv..."}
+test parseExpr-21.47 {error message} -body {
+    expr {123456789012345678901234567890*"foo$bar([abcdefghijklmnopqrstuvwxyz)"}
+} -returnCodes error -result {missing close-bracket
+in expression "...901234567890*"foo$bar([abcdefghijklmnopqrstuv..."}
+test parseExpr-21.48 {error message} -body {
+    expr "123456789012345678901234567890*\"foo\$bar(\[\{abcdefghijklmnopqrstuvwxyz])\""
+} -returnCodes error -result "missing close-brace
+in expression \"...01234567890*\"foo\$bar(\[\{abcdefghijklmnopqrstuv...\""
+
+test parseExpr-21.49 {error message} -body {
+    expr "123456789012345678901234567890*\{abcdefghijklmnopqrstuvwxyz"
+} -returnCodes error -result "missing close-brace
+in expression \"...012345678901234567890*\{abcdefghijklmnopqrstuv...\""
+
+test parseExpr-21.50 {error message} -body {
+    expr {123456789012345678901234567890*$foo(["abcdefghijklmnopqrstuvwxyz])}
+} -returnCodes error -result {missing "
+in expression "...678901234567890*$foo(["abcdefghijklmnopqrstuv..."}
+test parseExpr-21.51 {error message} -body {
+    expr "123456789012345678901234567890*\$\{abcdefghijklmnopqrstuvwxyz"
+} -returnCodes error -result "missing close-brace for variable name
+in expression \"...12345678901234567890*\$\{abcdefghijklmnopqrstuv...\""
+test parseExpr-21.52 {error message} -body {
+    expr {123456789012345678901234567890*$bar(abcdefghijklmnopqrstuvwxyz}
+} -returnCodes error -result {missing )
+in expression "...45678901234567890*$bar(abcdefghijklmnopqrstuv..."}
+test parseExpr-21.53 {error message} -body {
+    expr {123456789012345678901234567890*$bar([{}abcdefghijklmnopqrstuvwxyz])"}
+} -returnCodes error -result {extra characters after close-brace
+in expression "...8901234567890*$bar([{}abcdefghijklmnopqrstuv..."}
+test parseExpr-21.54 {error message} -body {
+    expr {123456789012345678901234567890*$bar([""abcdefghijklmnopqrstuvwxyz])"}
+} -returnCodes error -result {extra characters after close-quote
+in expression "...8901234567890*$bar([""abcdefghijklmnopqrstuv..."}
+test parseExpr-21.55 {error message} -body {
+    expr {123456789012345678901234567890*$bar([abcdefghijklmnopqrstuvwxyz)"}
+} -returnCodes error -result {missing close-bracket
+in expression "...5678901234567890*$bar([abcdefghijklmnopqrstuv..."}
+test parseExpr-21.56 {error message} -body {
+    expr "123456789012345678901234567890*\$bar(\[\{abcdefghijklmnopqrstuvwxyz])"
+} -returnCodes error -result "missing close-brace
+in expression \"...678901234567890*\$bar(\[\{abcdefghijklmnopqrstuv...\""
+
+test parseExpr-21.57 {error message} -body {
+    expr {123456789012345678901234567890*["abcdefghijklmnopqrstuvwxyz]}
+} -returnCodes error -result {missing "
+in expression "...12345678901234567890*["abcdefghijklmnopqrstuv..."}
+test parseExpr-21.58 {error message} -body {
+    expr "123456789012345678901234567890*\[\$\{abcdefghijklmnopqrstuvwxyz]"
+} -returnCodes error -result "missing close-brace for variable name
+in expression \"...2345678901234567890*\[\$\{abcdefghijklmnopqrstuv...\""
+test parseExpr-21.59 {error message} -body {
+    expr {123456789012345678901234567890*[$bar(abcdefghijklmnopqrstuvwxyz]}
+} -returnCodes error -result {missing )
+in expression "...5678901234567890*[$bar(abcdefghijklmnopqrstuv..."}
+test parseExpr-21.60 {error message} -body {
+    expr {123456789012345678901234567890*[{}abcdefghijklmnopqrstuvwxyz]"}
+} -returnCodes error -result {extra characters after close-brace
+in expression "...345678901234567890*[{}abcdefghijklmnopqrstuv..."}
+test parseExpr-21.61 {error message} -body {
+    expr {123456789012345678901234567890*[""abcdefghijklmnopqrstuvwxyz]"}
+} -returnCodes error -result {extra characters after close-quote
+in expression "...345678901234567890*[""abcdefghijklmnopqrstuv..."}
+test parseExpr-21.62 {error message} -body {
+    expr {123456789012345678901234567890*[abcdefghijklmnopqrstuvwxyz"}
+} -returnCodes error -result {missing close-bracket
+in expression "...012345678901234567890*[abcdefghijklmnopqrstuv..."}
+test parseExpr-21.63 {error message} -body {
+    expr "123456789012345678901234567890*\[\{abcdefghijklmnopqrstuvwxyz]"
+} -returnCodes error -result "missing close-brace
+in expression \"...12345678901234567890*\[\{abcdefghijklmnopqrstuv...\""
+
+test parseExpr-22.1 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 2a() 1
+} -result {- {} 0 subexpr 2 1 text 2 0 {}}
+test parseExpr-22.2 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser nana() 3
+} -result {- {} 0 subexpr nan 1 text nan 0 {}}
+test parseExpr-22.3 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 2a() -1
+} -result {- {} 0 subexpr 2a() 1 operator 2a 0 {}}
+test parseExpr-22.4 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser nana() -1
+} -result {- {} 0 subexpr nana() 1 operator nana 0 {}}
+test parseExpr-22.5 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser nan9() -1
+} -result {- {} 0 subexpr nan9() 1 operator nan9 0 {}}
+test parseExpr-22.6 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 2_() -1
+} -result {- {} 0 subexpr 2_() 1 operator 2_ 0 {}}
+test parseExpr-22.7 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser nan_() -1
+} -result {- {} 0 subexpr nan_() 1 operator nan_ 0 {}}
+test parseExpr-22.8 {Bug 3401704} -constraints testexprparser -body {
+    catch {testexprparser nan!() -1} m o
+    dict get $o -errorcode
+} -result {TCL PARSE EXPR MISSING}
+test parseExpr-22.9 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser 1e3_() -1
+} -result {- {} 0 subexpr 1e3_() 1 operator 1e3_ 0 {}}
+test parseExpr-22.10 {Bug 3401704} -constraints testexprparser -body {
+    catch {testexprparser 1.3_() -1} m o
+    dict get $o -errorcode
+} -result {TCL PARSE EXPR BADCHAR}
+test parseExpr-22.11 {Bug 3401704} -constraints testexprparser -body {
+    catch {testexprparser 1e-3_() -1} m o
+    dict get $o -errorcode
+} -result {TCL PARSE EXPR BADCHAR}
+test parseExpr-22.12 {Bug 3401704} -constraints testexprparser -body {
+    catch {testexprparser naneq() -1} m o
+    dict get $o -errorcode
+} -result {TCL PARSE EXPR EMPTY}
+test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body {
+    testexprparser naner() -1
+} -result {- {} 0 subexpr naner() 1 operator naner 0 {}}
+
+test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body {
+    catch {testexprparser 08 -1} m o
+    dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER OCTAL}
+test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body {
+    catch {testexprparser 0o8 -1} m o
+    dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER OCTAL}
+test parseExpr-22.16 {Bug 3401704} -constraints testexprparser -body {
+    catch {testexprparser 0o08 -1} m o
+    dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER OCTAL}
+test parseExpr-22.17 {Bug 3401704} -constraints testexprparser -body {
+    catch {testexprparser 0b2 -1} m o
+    dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER BINARY}
+test parseExpr-22.18 {Bug 3401704} -constraints testexprparser -body {
+    catch {testexprparser 0b02 -1} m o
+    dict get $o -errorcode
+} -result {TCL PARSE EXPR BADNUMBER BINARY}
+
 
 # cleanup
-::tcltest::cleanupTests
+cleanupTests
 return
diff --git a/tests/parseOld.test b/tests/parseOld.test
index 40413db..f3b1591 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -12,16 +12,14 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: parseOld.test,v 1.12 2003/03/27 13:49:00 dkf Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
-tcltest::testConstraint testwordend \
-	[string equal "testwordend" [info commands testwordend]]
+testConstraint testwordend [llength [info commands testwordend]]
 
 # Save the argv value for restoration later
 set savedArgv $argv
@@ -166,25 +164,25 @@ test parseOld-5.6 {variable substitution} {
     set msg
 } {can't read "_non_existent_": no such variable}
 test parseOld-5.7 {array variable substitution} {
-    catch {unset a}
+    unset -nocomplain a
     set a(xyz) 123
     set b $a(xyz)foo
     set b
 } 123foo
 test parseOld-5.8 {array variable substitution} {
-    catch {unset a}
+    unset -nocomplain a
     set "a(x y z)" 123
     set b $a(x y z)foo
     set b
 } 123foo
 test parseOld-5.9 {array variable substitution} {
-    catch {unset a}; catch {unset qqq}
+    unset -nocomplain a qqq
     set "a(x y z)" qqq
     set $a([format x]\ y [format z]) foo
     set qqq
 } foo
 test parseOld-5.10 {array variable substitution} {
-    catch {unset a}
+    unset -nocomplain a
     list [catch {set b $a(22)} msg] $msg
 } {1 {can't read "a(22)": no such variable}}
 test parseOld-5.11 {array variable substitution} {
@@ -194,9 +192,9 @@ test parseOld-5.11 {array variable substitution} {
 test parseOld-5.12 {empty array name support} {
     list [catch {set b a$()} msg] $msg
 } {1 {can't read "()": no such variable}}
-catch {unset a}
+unset -nocomplain a
 test parseOld-5.13 {array variable substitution} {
-    catch {unset a}
+    unset -nocomplain a
     set long {This is a very long variable, long enough to cause storage \
 	allocation to occur in Tcl_ParseVar.  If that storage isn't getting \
 	freed up correctly, then a core leak will occur when this test is \
@@ -211,13 +209,13 @@ test parseOld-5.13 {array variable substitution} {
 	run.  This text is probably beginning to sound like drivel, but I've \
 	run out of things to say and I need more characters still.}}}
 test parseOld-5.14 {array variable substitution} {
-    catch {unset a}; catch {unset b}; catch {unset a1}
+    unset -nocomplain a b a1
     set a1(22) foo
     set a(foo) bar
     set b $a($a1(22))
     set b
 } bar
-catch {unset a}; catch {unset a1}
+unset -nocomplain a a1
 
 test parseOld-7.1 {backslash substitution} {
     set a "\a\c\n\]\}"
@@ -353,7 +351,7 @@ test parseOld-10.13 {syntax errors} {
 # since MetroWerks may some day fix this.
 
 test parseOld-10.14 {syntax errors} {
-    list [catch {eval \$x[format "%01000d" 0](} msg] $msg $errorInfo
+    list [catch {eval \$x[format "%01000d" 0](} msg] $msg $::errorInfo
 } {1 {missing )} {missing )
     while executing
 "$x0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000..."
diff --git a/tests/pid.test b/tests/pid.test
index 9734d51..d21dbaa 100644
--- a/tests/pid.test
+++ b/tests/pid.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: pid.test,v 1.12 2004/05/19 22:06:07 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
diff --git a/tests/pkg.test b/tests/pkg.test
deleted file mode 100644
index 7f3a9b5..0000000
--- a/tests/pkg.test
+++ /dev/null
@@ -1,673 +0,0 @@
-# Commands covered:  pkg
-#
-# 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) 1995-1996 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.
-#
-# RCS: @(#) $Id: pkg.test,v 1.13 2004/09/24 01:14:47 dgp Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
-
-# Do all this in a slave interp to avoid garbaging the
-# package list
-set i [interp create]
-interp eval $i [list set argv $argv]
-interp eval $i [list package require tcltest]
-interp eval $i [list namespace import -force ::tcltest::*]
-interp eval $i {
-
-package forget {expand}[package names]
-set oldPkgUnknown [package unknown]
-package unknown {}
-set oldPath $auto_path
-set auto_path ""
-
-test pkg-1.1 {Tcl_PkgProvide procedure} {
-    package forget t
-    package provide t 2.3
-} {}
-test pkg-1.2 {Tcl_PkgProvide procedure} {
-    package forget t
-    package provide t 2.3
-    list [catch {package provide t 2.2} msg] $msg
-} {1 {conflicting versions provided for package "t": 2.3, then 2.2}}
-test pkg-1.3 {Tcl_PkgProvide procedure} {
-    package forget t
-    package provide t 2.3
-    list [catch {package provide t 2.4} msg] $msg
-} {1 {conflicting versions provided for package "t": 2.3, then 2.4}}
-test pkg-1.4 {Tcl_PkgProvide procedure} {
-    package forget t
-    package provide t 2.3
-    list [catch {package provide t 3.3} msg] $msg
-} {1 {conflicting versions provided for package "t": 2.3, then 3.3}}
-test pkg-1.5 {Tcl_PkgProvide procedure} {
-    package forget t
-    package provide t 2.3
-    package provide t 2.3
-} {}
-
-test pkg-2.1 {Tcl_PkgRequire procedure, picking best version} {
-    package forget t
-    foreach i {1.4 3.4 2.3 2.4 2.2} {
-	package ifneeded t $i "set x $i; package provide t $i"
-    }
-    set x xxx
-    package require t
-    set x
-} {3.4}
-test pkg-2.2 {Tcl_PkgRequire procedure, picking best version} {
-    package forget t
-    foreach i {1.4 3.4 2.3 2.4 2.2 3.5 3.2} {
-	package ifneeded t $i "set x $i; package provide t $i"
-    }
-    set x xxx
-    package require t
-    set x
-} {3.5}
-test pkg-2.3 {Tcl_PkgRequire procedure, picking best version} {
-    package forget t
-    foreach i {3.5 2.1 2.3} {
-	package ifneeded t $i "set x $i; package provide t $i"
-    }
-    set x xxx
-    package require t 2.2
-    set x
-} {2.3}
-test pkg-2.4 {Tcl_PkgRequire procedure, picking best version} {
-    package forget t
-    foreach i {1.4 3.4 2.3 2.4 2.2} {
-	package ifneeded t $i "set x $i; package provide t $i"
-    }
-    set x xxx
-    package require -exact t 2.3
-    set x
-} {2.3}
-test pkg-2.5 {Tcl_PkgRequire procedure, picking best version} {
-    package forget t
-    foreach i {1.4 3.4 2.3 2.4 2.2} {
-	package ifneeded t $i "set x $i; package provide t $i"
-    }
-    set x xxx
-    package require t 2.1
-    set x
-} {2.4}
-test pkg-2.6 {Tcl_PkgRequire procedure, can't find suitable version} {
-    package forget t
-    package unknown {}
-    foreach i {1.4 3.4 2.3 2.4 2.2} {
-	package ifneeded t $i "set x $i"
-    }
-    list [catch {package require t 2.5} msg] $msg
-} {1 {can't find package t 2.5}}
-test pkg-2.7 {Tcl_PkgRequire procedure, can't find suitable version} {
-    package forget t
-    package unknown {}
-    foreach i {1.4 3.4 2.3 2.4 2.2} {
-	package ifneeded t $i "set x $i"
-    }
-    list [catch {package require t 4.1} msg] $msg
-} {1 {can't find package t 4.1}}
-test pkg-2.8 {Tcl_PkgRequire procedure, can't find suitable version} {
-    package forget t
-    package unknown {}
-    foreach i {1.4 3.4 2.3 2.4 2.2} {
-	package ifneeded t $i "set x $i"
-    }
-    list [catch {package require -exact t 1.3} msg] $msg
-} {1 {can't find package t 1.3}}
-test pkg-2.9 {Tcl_PkgRequire procedure, can't find suitable version} {
-    package forget t
-    package unknown {}
-    list [catch {package require t} msg] $msg
-} {1 {can't find package t}}
-test pkg-2.10 {Tcl_PkgRequire procedure, error in ifneeded script} {
-    package forget t
-    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test"}
-    list [catch {package require t 2.1} msg] $msg $errorInfo
-} {1 {ifneeded test} {ifneeded test
-    while executing
-"error "ifneeded test""
-    ("package ifneeded" script)
-    invoked from within
-"package require t 2.1"}}
-test pkg-2.11 {Tcl_PkgRequire procedure, ifneeded script doesn't provide package} {
-    package forget t
-    package ifneeded t 2.1 "set x invoked"
-    set x xxx
-    list [catch {package require t 2.1} msg] $msg $x
-} {1 {can't find package t 2.1} invoked}
-test pkg-2.12 {Tcl_PkgRequire procedure, self-deleting script} {
-    package forget t
-    package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
-    set x xxx
-    package require t 1.2
-    set x
-} {1.2}
-test pkg-2.13 {Tcl_PkgRequire procedure, "package unknown" support} {
-    proc pkgUnknown args {
-	global x
-	set x $args
-	package provide [lindex $args 0] [lindex $args 1]
-    }
-    package forget t
-    foreach i {1.4 3.4 2.3 2.4 2.2} {
-	package ifneeded t $i "set x $i"
-    }
-    package unknown pkgUnknown
-    set x xxx
-    package require -exact t 1.5
-    package unknown {}
-    set x
-} {t 1.5 -exact}
-test pkg-2.14 {Tcl_PkgRequire procedure, "package unknown" support} {
-    proc pkgUnknown args {
-	package ifneeded t 1.2 "set x loaded; package provide t 1.2"
-    }
-    package forget t
-    package unknown pkgUnknown
-    set x xxx
-    set result [list [package require t] $x]
-    package unknown {}
-    set result
-} {1.2 loaded}
-test pkg-2.15 {Tcl_PkgRequire procedure, "package unknown" support} {
-    proc pkgUnknown args {
-	global x
-	set x $args
-	package provide [lindex $args 0] 2.0
-    }
-    package forget {a b}
-    package unknown pkgUnknown
-    set x xxx
-    package require {a b}
-    package unknown {}
-    set x
-} {{a b} {}}
-test pkg-2.16 {Tcl_PkgRequire procedure, "package unknown" error} {
-    proc pkgUnknown args {
-	error "testing package unknown"
-    }
-    package forget t 
-    package unknown pkgUnknown
-    set result [list [catch {package require t} msg] $msg $errorInfo]
-    package unknown {}
-    set result
-} {1 {testing package unknown} {testing package unknown
-    while executing
-"error "testing package unknown""
-    (procedure "pkgUnknown" line 2)
-    invoked from within
-"pkgUnknown t {}"
-    ("package unknown" script)
-    invoked from within
-"package require t"}}
-test pkg-2.17 {Tcl_PkgRequire procedure, "package unknown" doesn't load package} {
-    proc pkgUnknown args {
-	global x
-	set x $args
-    }
-    package forget t
-    foreach i {1.4 3.4 2.3 2.4 2.2} {
-	package ifneeded t $i "set x $i"
-    }
-    package unknown pkgUnknown
-    set x xxx
-    set result [list [catch {package require -exact t 1.5} msg] $msg $x]
-    package unknown {}
-    set result
-} {1 {can't find package t 1.5} {t 1.5 -exact}}
-test pkg-2.18 {Tcl_PkgRequire procedure, version checks} {
-    package forget t
-    package provide t 2.3
-    package require t
-} {2.3}
-test pkg-2.19 {Tcl_PkgRequire procedure, version checks} {
-    package forget t
-    package provide t 2.3
-    package require t 2.1
-} {2.3}
-test pkg-2.20 {Tcl_PkgRequire procedure, version checks} {
-    package forget t
-    package provide t 2.3
-    package require t 2.3
-} {2.3}
-test pkg-2.21 {Tcl_PkgRequire procedure, version checks} {
-    package forget t
-    package provide t 2.3
-    list [catch {package require t 2.4} msg] $msg
-} {1 {version conflict for package "t": have 2.3, need 2.4}}
-test pkg-2.22 {Tcl_PkgRequire procedure, version checks} {
-    package forget t
-    package provide t 2.3
-    list [catch {package require t 1.2} msg] $msg
-} {1 {version conflict for package "t": have 2.3, need 1.2}}
-test pkg-2.23 {Tcl_PkgRequire procedure, version checks} {
-    package forget t
-    package provide t 2.3
-    package require -exact t 2.3
-} {2.3}
-test pkg-2.24 {Tcl_PkgRequire procedure, version checks} {
-    package forget t
-    package provide t 2.3
-    list [catch {package require -exact t 2.2} msg] $msg
-} {1 {version conflict for package "t": have 2.3, need 2.2}}
-test pkg-2.25 {Tcl_PkgRequire procedure, error in ifneeded script} {
-    package forget t
-    package ifneeded t 2.1 {package provide t 2.1; error "ifneeded test" EI}
-    list [catch {package require t 2.1} msg] $msg $errorInfo
-} {1 {ifneeded test} {EI
-    ("package ifneeded" script)
-    invoked from within
-"package require t 2.1"}}
-test pkg-2.26 {Tcl_PkgRequire procedure, error in ifneeded script} {
-    package forget t
-    package ifneeded t 2.1 {package provide t 2.1; foreach x 1 {error "ifneeded test" EI}}
-    list [catch {package require t 2.1} msg] $msg $errorInfo
-} {1 {ifneeded test} {EI
-    ("foreach" body line 1)
-    invoked from within
-"foreach x 1 {error "ifneeded test" EI}"
-    ("package ifneeded" script)
-    invoked from within
-"package require t 2.1"}}
-
-test pkg-3.1 {Tcl_PackageCmd procedure} {
-    list [catch {package} msg] $msg
-} {1 {wrong # args: should be "package option ?arg arg ...?"}}
-test pkg-3.2 {Tcl_PackageCmd procedure, "forget" option} {
-    foreach i [package names] {
-	package forget $i
-    }
-    package names
-} {}
-test pkg-3.3 {Tcl_PackageCmd procedure, "forget" option} {
-    foreach i [package names] {
-	package forget $i
-    }
-    package forget foo
-} {}
-test pkg-3.4 {Tcl_PackageCmd procedure, "forget" option} {
-    foreach i [package names] {
-	package forget $i
-    }
-    package ifneeded t 1.1 {first script}
-    package ifneeded t 2.3 {second script}
-    package ifneeded x 1.4 {x's script}
-    set result {}
-    lappend result [lsort [package names]] [package versions t]
-    package forget t
-    lappend result [lsort [package names]] [package versions t]
-} {{t x} {1.1 2.3} x {}}
-test pkg-3.5 {Tcl_PackageCmd procedure, "forget" option} {
-    foreach i [package names] {
-	package forget $i
-    }
-    package ifneeded a 1.1 {first script}
-    package ifneeded b 2.3 {second script}
-    package ifneeded c 1.4 {third script}
-    package forget
-    set result [list [lsort [package names]]]
-    package forget a c
-    lappend result [lsort [package names]]
-} {{a b c} b}
-test pkg-3.5.1 {Tcl_PackageCmd procedure, "forget" option} {
-    # Test for Bug 415273
-    package ifneeded a 1 "I should have been forgotten"
-    package forget no-such-package a
-    set x [package ifneeded a 1]
-    package forget a
-    set x
-} {}
-test pkg-3.6 {Tcl_PackageCmd procedure, "ifneeded" option} {
-    list [catch {package ifneeded a} msg] $msg
-} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
-test pkg-3.7 {Tcl_PackageCmd procedure, "ifneeded" option} {
-    list [catch {package ifneeded a b c d} msg] $msg
-} {1 {wrong # args: should be "package ifneeded package version ?script?"}}
-test pkg-3.8 {Tcl_PackageCmd procedure, "ifneeded" option} {
-    list [catch {package ifneeded t xyz} msg] $msg
-} {1 {expected version number but got "xyz"}}
-test pkg-3.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
-    foreach i [package names] {
-	package forget $i
-    }
-    list [package ifneeded foo 1.1] [package names]
-} {{} {}}
-test pkg-3.10 {Tcl_PackageCmd procedure, "ifneeded" option} {
-    package forget t
-    package ifneeded t 1.4 "script for t 1.4"
-    list [package names] [package ifneeded t 1.4] [package versions t]
-} {t {script for t 1.4} 1.4}
-test pkg-3.11 {Tcl_PackageCmd procedure, "ifneeded" option} {
-    package forget t
-    package ifneeded t 1.4 "script for t 1.4"
-    list [package ifneeded t 1.5] [package names] [package versions t]
-} {{} t 1.4}
-test pkg-3.12 {Tcl_PackageCmd procedure, "ifneeded" option} {
-    package forget t
-    package ifneeded t 1.4 "script for t 1.4"
-    package ifneeded t 1.4 "second script for t 1.4"
-    list [package ifneeded t 1.4] [package names] [package versions t]
-} {{second script for t 1.4} t 1.4}
-test pkg-3.13 {Tcl_PackageCmd procedure, "ifneeded" option} {
-    package forget t
-    package ifneeded t 1.4 "script for t 1.4"
-    package ifneeded t 1.2 "second script"
-    package ifneeded t 3.1 "last script"
-    list [package ifneeded t 1.2] [package versions t]
-} {{second script} {1.4 1.2 3.1}}
-test pkg-3.14 {Tcl_PackageCmd procedure, "names" option} {
-    list [catch {package names a} msg] $msg
-} {1 {wrong # args: should be "package names"}}
-test pkg-3.15 {Tcl_PackageCmd procedure, "names" option} {
-    foreach i [package names] {
-	package forget $i
-    }
-    package names
-} {}
-test pkg-3.16 {Tcl_PackageCmd procedure, "names" option} {
-    foreach i [package names] {
-	package forget $i
-    }
-    package ifneeded x 1.2 {dummy}
-    package provide x 1.3
-    package provide y 2.4
-    catch {package require z 47.16}
-    lsort [package names]
-} {x y}
-test pkg-3.17 {Tcl_PackageCmd procedure, "provide" option} {
-    list [catch {package provide} msg] $msg
-} {1 {wrong # args: should be "package provide package ?version?"}}
-test pkg-3.18 {Tcl_PackageCmd procedure, "provide" option} {
-    list [catch {package provide a b c} msg] $msg
-} {1 {wrong # args: should be "package provide package ?version?"}}
-test pkg-3.19 {Tcl_PackageCmd procedure, "provide" option} {
-    package forget t
-    package provide t
-} {}
-test pkg-3.20 {Tcl_PackageCmd procedure, "provide" option} {
-    package forget t
-    package provide t 2.3
-    package provide t
-} {2.3}
-test pkg-3.21 {Tcl_PackageCmd procedure, "provide" option} {
-    package forget t
-    list [catch {package provide t a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.22 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
-test pkg-3.23 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require a b c} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
-test pkg-3.24 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require -exact a b c} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
-test pkg-3.25 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require -bs a b} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
-test pkg-3.26 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require x a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.27 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require -exact x a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.28 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require -exact x} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
-test pkg-3.29 {Tcl_PackageCmd procedure, "require" option} {
-    list [catch {package require -exact} msg] $msg
-} {1 {wrong # args: should be "package require ?-exact? package ?version?"}}
-test pkg-3.30 {Tcl_PackageCmd procedure, "require" option} {
-    package forget t
-    package provide t 2.3
-    package require t 2.1
-} {2.3}
-test pkg-3.31 {Tcl_PackageCmd procedure, "require" option} {
-    package forget t
-    list [catch {package require t} msg] $msg
-} {1 {can't find package t}}
-test pkg-3.32 {Tcl_PackageCmd procedure, "require" option} {
-    package forget t
-    package ifneeded t 2.3 "error {synthetic error}"
-    list [catch {package require t 2.3} msg] $msg
-} {1 {synthetic error}}
-test pkg-3.33 {Tcl_PackageCmd procedure, "unknown" option} {
-    list [catch {package unknown a b} msg] $msg
-} {1 {wrong # args: should be "package unknown ?command?"}}
-test pkg-3.34 {Tcl_PackageCmd procedure, "unknown" option} {
-    package unknown "test script"
-    package unknown
-} {test script}
-test pkg-3.35 {Tcl_PackageCmd procedure, "unknown" option} {
-    package unknown "test script"
-    package unknown {}
-    package unknown
-} {}
-test pkg-3.36 {Tcl_PackageCmd procedure, "vcompare" option} {
-    list [catch {package vcompare a} msg] $msg
-} {1 {wrong # args: should be "package vcompare version1 version2"}}
-test pkg-3.37 {Tcl_PackageCmd procedure, "vcompare" option} {
-    list [catch {package vcompare a b c} msg] $msg
-} {1 {wrong # args: should be "package vcompare version1 version2"}}
-test pkg-3.38 {Tcl_PackageCmd procedure, "vcompare" option} {
-    list [catch {package vcompare x.y 3.4} msg] $msg
-} {1 {expected version number but got "x.y"}}
-test pkg-3.39 {Tcl_PackageCmd procedure, "vcompare" option} {
-    list [catch {package vcompare 2.1 a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.40 {Tcl_PackageCmd procedure, "vcompare" option} {
-    package vc 2.1 2.3
-} {-1}
-test pkg-3.41 {Tcl_PackageCmd procedure, "vcompare" option} {
-    package vc 2.2.4 2.2.4
-} {0}
-test pkg-3.42 {Tcl_PackageCmd procedure, "versions" option} {
-    list [catch {package versions} msg] $msg
-} {1 {wrong # args: should be "package versions package"}}
-test pkg-3.43 {Tcl_PackageCmd procedure, "versions" option} {
-    list [catch {package versions a b} msg] $msg
-} {1 {wrong # args: should be "package versions package"}}
-test pkg-3.44 {Tcl_PackageCmd procedure, "versions" option} {
-    package forget t
-    package versions t
-} {}
-test pkg-3.45 {Tcl_PackageCmd procedure, "versions" option} {
-    package forget t
-    package provide t 2.3
-    package versions t
-} {}
-test pkg-3.46 {Tcl_PackageCmd procedure, "versions" option} {
-    package forget t
-    package ifneeded t 2.3 x
-    package ifneeded t 2.4 y
-    package versions t
-} {2.3 2.4}
-test pkg-3.47 {Tcl_PackageCmd procedure, "vsatisfies" option} {
-    list [catch {package vsatisfies a} msg] $msg
-} {1 {wrong # args: should be "package vsatisfies version1 version2"}}
-test pkg-3.48 {Tcl_PackageCmd procedure, "vsatisfies" option} {
-    list [catch {package vsatisfies a b c} msg] $msg
-} {1 {wrong # args: should be "package vsatisfies version1 version2"}}
-test pkg-3.49 {Tcl_PackageCmd procedure, "vsatisfies" option} {
-    list [catch {package vsatisfies x.y 3.4} msg] $msg
-} {1 {expected version number but got "x.y"}}
-test pkg-3.50 {Tcl_PackageCmd procedure, "vsatisfies" option} {
-    list [catch {package vcompare 2.1 a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-3.51 {Tcl_PackageCmd procedure, "vsatisfies" option} {
-    package vs 2.3 2.1
-} {1}
-test pkg-3.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
-    package vs 2.3 1.2
-} {0}
-test pkg-3.53 {Tcl_PackageCmd procedure, "versions" option} {
-    list [catch {package foo} msg] $msg
-} {1 {bad option "foo": must be forget, ifneeded, names, present, provide, require, unknown, vcompare, versions, or vsatisfies}}
-
-# No tests for FindPackage;  can't think up anything detectable
-# errors.
-
-test pkg-4.1 {TclFreePackageInfo procedure} {
-    interp create foo
-    foo eval {
-	package ifneeded t 2.3 x
-	package ifneeded t 2.4 y
-	package ifneeded x 3.1 z
-	package provide q 4.3
-	package unknown "will this get freed?"
-    }
-    interp delete foo
-} {}
-test pkg-4.2 {TclFreePackageInfo procedure} {
-    interp create foo
-    foo eval {
-	package ifneeded t 2.3 x
-	package ifneeded t 2.4 y
-	package ifneeded x 3.1 z
-	package provide q 4.3
-    }
-    foo alias z kill
-    proc kill {} {
-	interp delete foo
-    }
-    list [catch {foo eval package require x 3.1} msg] $msg
-} {1 {can't find package x 3.1}}
-
-test pkg-5.1 {CheckVersion procedure} {
-    list [catch {package vcompare 1 2.1} msg] $msg
-} {0 -1}
-test pkg-5.2 {CheckVersion procedure} {
-    list [catch {package vcompare .1 2.1} msg] $msg
-} {1 {expected version number but got ".1"}}
-test pkg-5.3 {CheckVersion procedure} {
-    list [catch {package vcompare 111.2a.3 2.1} msg] $msg
-} {1 {expected version number but got "111.2a.3"}}
-test pkg-5.4 {CheckVersion procedure} {
-    list [catch {package vcompare 1.2.3. 2.1} msg] $msg
-} {1 {expected version number but got "1.2.3."}}
-test pkg-5.5 {CheckVersion procedure} {
-    list [catch {package vcompare 1.2..3 2.1} msg] $msg
-} {1 {expected version number but got "1.2..3"}}
-
-test pkg-6.1 {ComparePkgVersions procedure} {
-    package vcompare 1.23 1.22
-} {1}
-test pkg-6.2 {ComparePkgVersions procedure} {
-    package vcompare 1.22.1.2.3 1.22.1.2.3
-} {0}
-test pkg-6.3 {ComparePkgVersions procedure} {
-    package vcompare 1.21 1.22
-} {-1}
-test pkg-6.4 {ComparePkgVersions procedure} {
-    package vcompare 1.21 1.21.2
-} {-1}
-test pkg-6.5 {ComparePkgVersions procedure} {
-    package vcompare 1.21.1 1.21
-} {1}
-test pkg-6.6 {ComparePkgVersions procedure} {
-    package vsatisfies 1.21.1 1.21
-} {1}
-test pkg-6.7 {ComparePkgVersions procedure} {
-    package vsatisfies 2.22.3 1.21
-} {0}
-test pkg-6.8 {ComparePkgVersions procedure} {
-    package vsatisfies 1 1
-} {1}
-test pkg-6.9 {ComparePkgVersions procedure} {
-    package vsatisfies 2 1
-} {0}
-
-test pkg-7.1 {Tcl_PkgPresent procedure, any version} {
-    package forget t
-    package provide t 2.4
-    package present t
-} {2.4}
-test pkg-7.2 {Tcl_PkgPresent procedure, correct version} {
-    package forget t
-    package provide t 2.4
-    package present t 2.4
-} {2.4}
-test pkg-7.3 {Tcl_PkgPresent procedure, satisfying version} {
-    package forget t
-    package provide t 2.4
-    package present t 2.0
-} {2.4}
-test pkg-7.4 {Tcl_PkgPresent procedure, not satisfying version} {
-    package forget t
-    package provide t 2.4
-    list [catch {package present t 2.6} msg] $msg
-} {1 {version conflict for package "t": have 2.4, need 2.6}}
-test pkg-7.5 {Tcl_PkgPresent procedure, not satisfying version} {
-    package forget t
-    package provide t 2.4
-    list [catch {package present t 1.0} msg] $msg
-} {1 {version conflict for package "t": have 2.4, need 1.0}}
-test pkg-7.6 {Tcl_PkgPresent procedure, exact version} {
-    package forget t
-    package provide t 2.4
-    package present -exact t 2.4
-} {2.4}
-test pkg-7.7 {Tcl_PkgPresent procedure, not exact version} {
-    package forget t
-    package provide t 2.4
-    list [catch {package present -exact t 2.3} msg] $msg
-} {1 {version conflict for package "t": have 2.4, need 2.3}}
-test pkg-7.8 {Tcl_PkgPresent procedure, unknown package} {
-    package forget t
-    list [catch {package present t} msg] $msg
-} {1 {package t is not present}}
-test pkg-7.9 {Tcl_PkgPresent procedure, unknown package} {
-    package forget t
-    list [catch {package present t 2.4} msg] $msg
-} {1 {package t 2.4 is not present}}
-test pkg-7.10 {Tcl_PkgPresent procedure, unknown package} {
-    package forget t
-    list [catch {package present -exact t 2.4} msg] $msg
-} {1 {package t 2.4 is not present}}
-test pkg-7.11 {Tcl_PackageCmd procedure, "present" option} {
-    list [catch {package present} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
-test pkg-7.12 {Tcl_PackageCmd procedure, "present" option} {
-    list [catch {package present a b c} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
-test pkg-7.13 {Tcl_PackageCmd procedure, "present" option} {
-    list [catch {package present -exact a b c} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
-test pkg-7.14 {Tcl_PackageCmd procedure, "present" option} {
-    list [catch {package present -bs a b} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
-test pkg-7.15 {Tcl_PackageCmd procedure, "present" option} {
-    list [catch {package present x a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-7.16 {Tcl_PackageCmd procedure, "present" option} {
-    list [catch {package present -exact x a.b} msg] $msg
-} {1 {expected version number but got "a.b"}}
-test pkg-7.17 {Tcl_PackageCmd procedure, "present" option} {
-    list [catch {package present -exact x} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
-test pkg-7.18 {Tcl_PackageCmd procedure, "present" option} {
-    list [catch {package present -exact} msg] $msg
-} {1 {wrong # args: should be "package present ?-exact? package ?version?"}}
-
-set auto_path $oldPath
-package unknown $oldPkgUnknown
-concat
-
-cleanupTests
-}
-
-# cleanup
-interp delete $i
-::tcltest::cleanupTests
-return
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index b7bd664..84c82ce 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -2,22 +2,17 @@
 # Note that the tests are limited to Tcl scripts only, there are no shared
 # libraries against which to 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) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
-#
-# RCS: @(#) $Id: pkgMkIndex.test,v 1.27 2004/07/28 18:00:11 dgp Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
 
 set fullPkgPath [makeDirectory pkg]
 
-
 namespace eval pkgtest {
     # Namespace for procs we can discard
 }
@@ -27,8 +22,8 @@ namespace eval pkgtest {
 #  Parse an argument list.
 #
 # Arguments:
-#  <flags>	(optional) arguments starting with a dash are collected
-#		as options to pkg_mkIndex and passed to pkg_mkIndex.
+#  <flags>	(optional) arguments starting with a dash are collected as
+#		options to pkg_mkIndex and passed to pkg_mkIndex.
 #  dirPath	the directory to index
 #  pattern0	pattern to index
 #  ...		pattern to index
@@ -48,7 +43,7 @@ proc pkgtest::parseArgs { args } {
 	set a [lindex $args $iarg]
 	if {[regexp {^-} $a]} {
 	    lappend options $a
-	    if {[string compare -load $a] == 0} {
+	    if {$a eq "-load"} {
 		incr iarg
 		lappend options [lindex $args $iarg]
 	    }
@@ -84,12 +79,12 @@ proc pkgtest::parseIndex { filePath } {
 	$slave eval {
 	    rename package package_original
 	    proc package { args } {
-		if {[string compare [lindex $args 0] ifneeded] == 0} {
+		if {[lindex $args 0] eq "ifneeded"} {
 		    set pkg [lindex $args 1]
 		    set ver [lindex $args 2]
 		    set ::PKGS($pkg:$ver) [lindex $args 3]
 		} else {
-		    return [package_original {expand}$args]
+		    return [package_original {*}$args]
 		}
 	    }
 	    array set ::PKGS {}
@@ -114,9 +109,9 @@ proc pkgtest::parseIndex { filePath } {
 	foreach k [lsort [array names P]] {
 	    lappend PKGS $k $P($k)
 	}
-    } err]} {
-	set ei $::errorInfo
-	set ec $::errorCode
+    } err opts]} {
+	set ei [dict get $opts -errorinfo]
+	set ec [dict get $opts -errorcode]
 
 	catch {interp delete $slave}
 
@@ -130,13 +125,13 @@ proc pkgtest::parseIndex { filePath } {
 
 # pkgtest::createIndex --
 #
-#  Runs pkg_mkIndex for the given directory and set of patterns.
-#  This procedure deletes any pkgIndex.tcl file in the target directory,
-#  then runs pkg_mkIndex.
+#  Runs pkg_mkIndex for the given directory and set of patterns.  This
+#  procedure deletes any pkgIndex.tcl file in the target directory, then runs
+#  pkg_mkIndex.
 #
 # Arguments:
-#  <flags>	(optional) arguments starting with a dash are collected
-#		as options to pkg_mkIndex and passed to pkg_mkIndex.
+#  <flags>	(optional) arguments starting with a dash are collected as
+#		options to pkg_mkIndex and passed to pkg_mkIndex.
 #  dirPath	the directory to index
 #  pattern0	pattern to index
 #  ...		pattern to index
@@ -148,7 +143,7 @@ proc pkgtest::parseIndex { filePath } {
 #    1: the error result if element 0 was 1
 
 proc pkgtest::createIndex { args } {
-    set parsed [parseArgs {expand}$args]
+    set parsed [parseArgs {*}$args]
     set options [lindex $parsed 0]
     set dirPath [lindex $parsed 1]
     set patternList [lindex $parsed 2]
@@ -157,7 +152,7 @@ proc pkgtest::createIndex { args } {
 
     if {[catch {
 	file delete [file join $dirPath pkgIndex.tcl]
-	pkg_mkIndex {expand}$options $dirPath {expand}$patternList
+	pkg_mkIndex {*}$options $dirPath {*}$patternList
     } err]} {
 	return [list 1 $err]
     }
@@ -194,11 +189,9 @@ proc makePkgList { inList } {
 		    lappend l $s
 		}
 	    }
-
 	    source {
 		set l $v
 	    }
-
 	    default {
 		error "can't handle $k $v"
 	    }
@@ -215,8 +208,8 @@ proc makePkgList { inList } {
 #  Runs pkg_mkIndex, parses the generated index file.
 #
 # Arguments:
-#  <flags>	(optional) arguments starting with a dash are collected
-#		as options to pkg_mkIndex and passed to pkg_mkIndex.
+#  <flags>	(optional) arguments starting with a dash are collected as
+#		options to pkg_mkIndex and passed to pkg_mkIndex.
 #  dirPath	the directory to index
 #  pattern0	pattern to index
 #  ...		pattern to index
@@ -226,12 +219,11 @@ proc makePkgList { inList } {
 #  Returns a two element list:
 #    0: 1 if the procedure encountered an error, 0 otherwise.
 #    1: if no error, this is the parsed generated index file, in the format
-#	returned by pkgtest::parseIndex.
-#	If error, this is the error result.
+#	returned by pkgtest::parseIndex.  If error, this is the error result.
 
 proc pkgtest::runCreatedIndex {rv args} {
     if {[lindex $rv 0] == 0} {
-	set parsed [parseArgs {expand}$args]
+	set parsed [parseArgs {*}$args]
 	set dirPath [lindex $parsed 1]
 	set idxFile [file join $dirPath pkgIndex.tcl]
 
@@ -248,12 +240,12 @@ proc pkgtest::runCreatedIndex {rv args} {
     return $result
 }
 proc pkgtest::runIndex { args } {
-    set rv [createIndex {expand}$args]
-    return [runCreatedIndex $rv {expand}$args]
+    set rv [createIndex {*}$args]
+    return [runCreatedIndex $rv {*}$args]
 }
-
-# If there is no match to the patterns, make sure the directory hasn't
-# changed on us
+
+# If there is no match to the patterns, make sure the directory hasn't changed
+# on us
 
 test pkgMkIndex-1.1 {nothing matches pattern - current dir is the same} {
     list [pkgtest::runIndex -lazy $fullPkgPath nomatch.tcl] [pwd]
@@ -314,8 +306,8 @@ removeFile [file join pkg global.tcl]
 
 makeFile {
 #  This package is required by pkg1.
-#  This package is split into two files, to test packages that are split
-#  over multiple files.
+#  This package is split into two files, to test packages that are split over
+#  multiple files.
 package provide pkg2 1.0
 namespace eval pkg2 {
     namespace export p2-1
@@ -327,8 +319,8 @@ proc pkg2::p2-1 { num } {
 
 makeFile {
 #  This package is required by pkg1.
-#  This package is split into two files, to test packages that are split
-#  over multiple files.
+#  This package is split into two files, to test packages that are split over
+#  multiple files.
 package provide pkg2 1.0
 namespace eval pkg2 {
     namespace export p2-2
@@ -347,8 +339,8 @@ test pkgMkIndex-4.2 {split package - direct loading} {
 } "0 {{pkg2:1.0 {[list source [file join $fullPkgPath pkg2_a.tcl]]
 [list source [file join $fullPkgPath pkg2_b.tcl]]}}}"
 
-# Add the direct1 directory to auto_path, so that the direct1 package 
-# can be found.
+# Add the direct1 directory to auto_path, so that the direct1 package can be
+# found.
 set direct1 [makeDirectory direct1]
 lappend auto_path $direct1
 makeFile {
@@ -367,9 +359,9 @@ proc direct1::pd2 { stg } {
 pkg_mkIndex -direct $direct1 direct1.tcl
 
 makeFile {
-#  Does a package require of direct1, whose pkgIndex.tcl entry
-#  is created above with option -direct.  This tests that pkg_mkIndex
-#  can handle code that is sourced in pkgIndex.tcl files.
+#  Does a package require of direct1, whose pkgIndex.tcl entry is created
+#  above with option -direct.  This tests that pkg_mkIndex can handle code
+#  that is sourced in pkgIndex.tcl files.
 package require direct1
 package provide std 1.0
 namespace eval std {
@@ -393,9 +385,9 @@ removeDirectory direct1
 removeFile [file join pkg std.tcl]
 
 makeFile {
-#  This package requires pkg3, but it does
-#  not use any of pkg3's procs in the code that is executed by the file
-#  (i.e. references to pkg3's procs are in the proc bodies only).
+#  This package requires pkg3, but it does not use any of pkg3's procs in the
+#  code that is executed by the file (i.e. references to pkg3's procs are in
+#  the proc bodies only).
 package require pkg3 1.0
 package provide pkg1 1.0
 namespace eval pkg1 {
@@ -433,8 +425,8 @@ test pkgMkIndex-6.2 {pkg1 requires pkg3 - use -direct} {
 removeFile [file join pkg pkg1.tcl]
 
 makeFile {
-#  This package requires pkg3, and it calls
-#  a pkg3 proc in the code that is executed by the file
+#  This package requires pkg3, and it calls a pkg3 proc in the code that is
+#  executed by the file
 package require pkg3 1.0
 package provide pkg4 1.0
 namespace eval pkg4 {
@@ -462,9 +454,8 @@ removeFile [file join pkg pkg4.tcl]
 removeFile [file join pkg pkg3.tcl]
 
 makeFile {
-#  This package requires pkg2, and it calls
-#  a pkg2 proc in the code that is executed by the file.
-#  Pkg2 is a split package.
+#  This package requires pkg2, and it calls a pkg2 proc in the code that is
+#  executed by the file.  Pkg2 is a split package.
 package require pkg2 1.0
 package provide pkg5 1.0
 namespace eval pkg5 {
@@ -496,9 +487,9 @@ removeFile [file join pkg pkg2_a.tcl]
 removeFile [file join pkg pkg2_b.tcl]
 
 makeFile {
-#  This package requires circ2, and circ2
-#  requires circ3, which in turn requires circ1.
-#  In case of cirularities, pkg_mkIndex should give up when it gets stuck.
+#  This package requires circ2, and circ2 requires circ3, which in turn
+#  requires circ1.  In case of cirularities, pkg_mkIndex should give up when
+#  it gets stuck.
 package require circ2 1.0
 package provide circ1 1.0
 namespace eval circ1 {
@@ -519,8 +510,8 @@ proc circ1::c1-4 {} {
 } [file join pkg circ1.tcl]
 
 makeFile {
-#  This package is required by circ1, and
-#  requires circ3. Circ3, in turn, requires circ1 to give us a circularity.
+#  This package is required by circ1, and requires circ3. Circ3, in turn,
+#  requires circ1 to give us a circularity.
 package require circ3 1.0
 package provide circ2 1.0
 namespace eval circ2 {
@@ -535,8 +526,8 @@ proc circ2::c2-2 { num } {
 } [file join pkg circ2.tcl]
 
 makeFile {
-#  This package is required by circ2, and in
-#  turn requires circ1. This closes the circularity.
+#  This package is required by circ2, and in turn requires circ1. This closes
+#  the circularity.
 package require circ1 1.0
 package provide circ3 1.0
 namespace eval circ3 {
@@ -562,44 +553,45 @@ removeFile [file join pkg circ3.tcl]
 set x [file join [file dirname [info nameofexecutable]] dltest \
 	pkga[info sharedlibextension]]
 set dll "[file tail $x]Required"
-::tcltest::testConstraint $dll [file exists $x]
+testConstraint $dll [file exists $x]
 
 if {[testConstraint $dll]} {
-makeFile {
+    makeFile {
 #  This package provides Pkga, which is also provided by a DLL.
 package provide Pkga 1.0
 proc pkga_neq { x } {
     return [expr {! [pkgq_eq $x]}]
 }
 } [file join pkg pkga.tcl]
-file copy -force $x $fullPkgPath
+    file copy -force $x $fullPkgPath
 }
 testConstraint exec [llength [info commands ::exec]]
 
 test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] {
-    # Do all [load]ing of shared libraries in another process, so 
-    # we can delete the file and not get stuck because we're holding
-    # a reference to it.
+    # Do all [load]ing of shared libraries in another process, so we can
+    # delete the file and not get stuck because we're holding a reference to
+    # it.
     set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
     exec [interpreter] << $cmd
     pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
 } "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
 test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
-    # Do all [load]ing of shared libraries in another process, so 
-    # we can delete the file and not get stuck because we're holding
-    # a reference to it.
+    # Do all [load]ing of shared libraries in another process, so we can
+    # delete the file and not get stuck because we're holding a reference to
+    # it.
     #
     # This test depends on context from prior test, so repeat it.
-    set script "[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]\n"
-    append script \
-	    "[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
+    set script \
+	"[list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]"
+    append script \n \
+	"[list pkg_mkIndex -lazy -load Pkg* $fullPkgPath [file tail $x]]"
     exec [interpreter] << $script
     pkgtest::runCreatedIndex {0 {}} -lazy -load Pkg* -- $fullPkgPath pkga[info sharedlibextension]
 } {0 {}}
 
 if {[testConstraint $dll]} {
-file delete -force [file join $fullPkgPath [file tail $x]]
-removeFile [file join pkg pkga.tcl]
+    file delete -force [file join $fullPkgPath [file tail $x]]
+    removeFile [file join pkg pkga.tcl]
 }
 
 # Tolerate "namespace import" at the global scope
@@ -625,9 +617,8 @@ test pkgMkIndex-11.1 {conflicting namespace imports} {
 
 removeFile [file join pkg import.tcl]
 
-# Verify that the auto load list generated is correct even when there
-# is a proc name conflict between two namespaces (ie, ::foo::baz and
-# ::bar::baz)
+# Verify that the auto load list generated is correct even when there is a
+# proc name conflict between two namespaces (ie, ::foo::baz and ::bar::baz)
 
 makeFile {
 package provide football 1.0
@@ -692,7 +683,7 @@ test pkgMkIndex-14.5 {tcl::Pkg::CompareExtension} {unix} {
 test pkgMkIndex-14.6 {tcl::Pkg::CompareExtension} {unix} {
     tcl::Pkg::CompareExtension foo.so.1.2.bar .so
 } 0
-
+
 # cleanup
 
 removeDirectory pkg
@@ -701,3 +692,7 @@ namespace delete pkgtest
 ::tcltest::cleanupTests
 return
 
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/platform.test b/tests/platform.test
index f9d7aca..6596975 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -8,15 +8,20 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) 
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+
+namespace eval ::tcl::test::platform {
+    namespace import ::tcltest::testConstraint
+    namespace import ::tcltest::test
+    namespace import ::tcltest::cleanupTests
+
+    variable ::tcl_platform
 
-testConstraint testWinCPUID [llength [info commands testwincpuid]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testCPUID [llength [info commands testcpuid]]
 
 test platform-1.1 {TclpSetVariables: tcl_platform} {
     interp create i
@@ -25,25 +30,25 @@ test platform-1.1 {TclpSetVariables: tcl_platform} {
     set result [i eval {lsort [array names tcl_platform]}]
     interp delete i
     set result
-} {byteOrder machine os osVersion platform user wordSize}
+} {byteOrder machine os osVersion pathSeparator platform pointerSize user wordSize}
 
 # Test assumes twos-complement arithmetic, which is true of virtually
 # everything these days.  Note that this does *not* use wide(), and
 # this is intentional since that could make Tcl's numbers wider than
 # the machine-integer on some platforms...
 test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
-    set result [expr {1 << (8 * $tcl_platform(wordSize) - 1)}]
+    set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}]
     # Result must be the largest bit in a machine word, which this checks
     # without assuming how wide the word really is
-    list [expr {$result < 0}] [expr {$result ^ ($result - 1)}]
+    list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
 } {1 -1}
 
-# On Windows, test that the CPU ID works
+# On Windows/UNIX, test that the CPU ID works
 
-test platform-3.1 {CPU ID on Windows } \
-    -constraints testWinCPUID \
+test platform-3.1 {CPU ID on Windows/UNIX} \
+    -constraints testCPUID \
     -body {		
-	set cpudata [testwincpuid 0]
+	set cpudata [testcpuid 0]
 	binary format iii \
 	    [lindex $cpudata 1] \
 	    [lindex $cpudata 3] \
@@ -53,7 +58,10 @@ test platform-3.1 {CPU ID on Windows } \
     -result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}
 
 # cleanup
-::tcltest::cleanupTests
+cleanupTests
+
+}
+namespace delete ::tcl::test::platform
 return
 
 # Local Variables:
diff --git a/tests/proc-old.test b/tests/proc-old.test
index 860279e..e45cf5c 100644
--- a/tests/proc-old.test
+++ b/tests/proc-old.test
@@ -13,8 +13,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: proc-old.test,v 1.13 2004/10/29 15:39:10 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -233,7 +231,7 @@ test proc-old-30.12 {arguments and defaults} {
 	return [list $x $y $args]
     }
     list [catch {tproc} msg] $msg
-} {1 {wrong # args: should be "tproc x ?y? ..."}}
+} {1 {wrong # args: should be "tproc x ?y? ?arg ...?"}}
 
 test proc-old-4.1 {variable numbers of arguments} {
     proc tproc args {return $args}
@@ -258,7 +256,7 @@ test proc-old-4.5 {variable numbers of arguments} {
 test proc-old-4.6 {variable numbers of arguments} {
     proc tproc {x missing args} {return $args}
     list [catch {tproc 1} msg] $msg
-} {1 {wrong # args: should be "tproc x missing ..."}}
+} {1 {wrong # args: should be "tproc x missing ?arg ...?"}}
 
 test proc-old-5.1 {error conditions} {
     list [catch {proc} msg] $msg
@@ -274,19 +272,16 @@ test proc-old-5.4 {error conditions} {
 } {1 {unmatched open brace in list}}
 test proc-old-5.5 {error conditions} {
     list [catch {proc tproc {{} y} {return foo}} msg] $msg
-} {1 {procedure "tproc" has argument with no name}}
+} {1 {argument with no name}}
 test proc-old-5.6 {error conditions} {
     list [catch {proc tproc {{} y} {return foo}} msg] $msg
-} {1 {procedure "tproc" has argument with no name}}
+} {1 {argument with no name}}
 test proc-old-5.7 {error conditions} {
     list [catch {proc tproc {{x 1 2} y} {return foo}} msg] $msg
 } {1 {too many fields in argument specifier "x 1 2"}}
 test proc-old-5.8 {error conditions} {
     catch {return}
 } 2
-test proc-old-5.9 {error conditions} {
-    list [catch {global} msg] $msg
-} {1 {wrong # args: should be "global varName ?varName ...?"}}
 proc tproc {} {
     set a 22
     global a
@@ -316,7 +311,7 @@ test proc-old-5.13 {error conditions} {
 	return
     }
     catch tproc msg
-    set errorInfo
+    set ::errorInfo
 } {error in procedure
     while executing
 "error "error in procedure""
@@ -330,7 +325,7 @@ test proc-old-5.14 {error conditions} {
 	return
     }
     catch tproc msg
-    set errorInfo
+    set ::errorInfo
 } {invoked "break" outside of a loop
     (procedure "tproc" line 1)
     invoked from within
@@ -342,7 +337,7 @@ test proc-old-5.15 {error conditions} {
 	return
     }
     catch tproc msg
-    set errorInfo
+    set ::errorInfo
 } {invoked "continue" outside of a loop
     (procedure "tproc" line 1)
     invoked from within
@@ -360,7 +355,7 @@ test proc-old-5.16 {error conditions} {
 	}
     }
     set fooMsg "foo not called"
-    list [catch tproc msg] $msg $errorInfo $fooMsg
+    list [catch tproc msg] $msg $::errorInfo $fooMsg
 } {1 {Nested error} {Nested error
     while executing
 "error "Nested error""
@@ -395,7 +390,7 @@ test proc-old-7.1 {return with special completion code} {
     list [catch {tproc ok} msg] $msg
 } {0 abc}
 test proc-old-7.2 {return with special completion code} {
-    list [catch {tproc error} msg] $msg $errorInfo $errorCode
+    list [catch {tproc error} msg] $msg $::errorInfo $::errorCode
 } {1 abc {abc
     while executing
 "tproc error"} NONE}
@@ -411,12 +406,12 @@ test proc-old-7.5 {return with special completion code} {
 test proc-old-7.6 {return with special completion code} {
     list [catch {tproc -14} msg] $msg
 } {-14 abc}
-test proc-old-7.7 {return with special completion code} {
-    list [catch {tproc gorp} msg] $msg
-} {1 {bad completion code "gorp": must be ok, error, return, break, continue, or an integer}}
-test proc-old-7.8 {return with special completion code} {
-    list [catch {tproc 10b} msg] $msg
-} {1 {bad completion code "10b": must be ok, error, return, break, continue, or an integer}}
+test proc-old-7.7 {return with special completion code} -body {
+    tproc err
+} -returnCodes error -match glob -result {bad completion code "err": must be ok, error, return, break, continue*, or an integer}
+test proc-old-7.8 {return with special completion code} -body {
+    tproc 10b
+} -returnCodes error -match glob -result {bad completion code "10b": must be ok, error, return, break, continue*, or an integer}
 test proc-old-7.9 {return with special completion code} {
     proc tproc2 {} {
 	tproc return
@@ -435,7 +430,7 @@ test proc-old-7.11 {return with special completion code} {
 	catch {open _bad_file_name r} msg
 	return -code error -errorinfo $errorInfo -errorcode $errorCode $msg
     }
-    set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+    set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode]
     regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
     normalizeMsg $msg
 } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
@@ -449,7 +444,7 @@ test proc-old-7.12 {return with special completion code} {
 	catch {open _bad_file_name r} msg
 	return -code error -errorcode $errorCode $msg
     }
-    set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+    set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode]
     regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
     normalizeMsg $msg
 } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
@@ -461,7 +456,7 @@ test proc-old-7.13 {return with special completion code} {
 	catch {open _bad_file_name r} msg
 	return -code error -errorinfo $errorInfo $msg
     }
-    set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+    set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode]
     regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
     normalizeMsg $msg
 } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
@@ -475,7 +470,7 @@ test proc-old-7.14 {return with special completion code} {
 	catch {open _bad_file_name r} msg
 	return -code error $msg
     }
-    set msg [list [catch tproc2 msg] $msg $errorInfo $errorCode]
+    set msg [list [catch tproc2 msg] $msg $::errorInfo $::errorCode]
     regsub -all [file join {} _bad_file_name] $msg "_bad_file_name" msg
     normalizeMsg $msg
 } {1 {couldn't open "_bad_file_name": no such file or directory} {couldn't open "_bad_file_name": no such file or directory
diff --git a/tests/proc.test b/tests/proc.test
index bef0948..e06720e 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -1,38 +1,34 @@
-# This file contains tests for the tclProc.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 includes only new tests, in particular
-# tests for code changed for the addition of Tcl namespaces. Other
-# procedure-related tests appear in other test files such as proc-old.test.
+# This file contains tests for the tclProc.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 includes only new tests, in particular tests for code
+# changed for the addition of Tcl namespaces. Other procedure-related tests
+# appear in other test files such as proc-old.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.
-#
-# RCS: @(#) $Id: proc.test,v 1.17 2004/09/22 15:48:23 msofer Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-if {[catch {package require procbodytest}]} {
-    testConstraint procbodytest 0
-} else {
-    testConstraint procbodytest 1
-}
+testConstraint procbodytest [expr {![catch {package require procbodytest}]}]
+testConstraint memory	    [llength [info commands memory]]
 
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
+catch {namespace delete {*}[namespace children :: test_ns_*]}
 catch {rename p ""}
 catch {rename {} ""}
 catch {unset msg}
-
-test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+
+test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1 {
         namespace eval baz {}
     }
@@ -42,23 +38,26 @@ test proc-1.1 {Tcl_ProcObjCmd, put proc in namespace specified in name, if any}
     list [test_ns_1::baz::p] \
          [namespace eval test_ns_1 {baz::p}] \
          [info commands test_ns_1::baz::*]
-} {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p}
-test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
-    list [catch {proc test_ns_1::baz::p {} {}} msg] $msg
-} {1 {can't create procedure "test_ns_1::baz::p": unknown namespace}}
-test proc-1.3 {Tcl_ProcObjCmd, empty proc name} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {{p in ::test_ns_1::baz} {p in ::test_ns_1::baz} ::test_ns_1::baz::p}
+test proc-1.2 {Tcl_ProcObjCmd, namespace specified in proc name must exist} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -returnCodes error -body {
+    proc test_ns_1::baz::p {} {}
+} -result {can't create procedure "test_ns_1::baz::p": unknown namespace}
+test proc-1.3 {Tcl_ProcObjCmd, empty proc name} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     proc :: {} {
         return "empty called"
     }
     list [::] \
          [info body {}]
-} {{empty called} {
+} -result {{empty called} {
         return "empty called"
     }}
-test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1 {
         namespace eval baz {
             proc p {} {
@@ -68,9 +67,10 @@ test proc-1.4 {Tcl_ProcObjCmd, simple proc name and proc defined in namespace} {
     }
     list [test_ns_1::baz::p] \
          [info commands test_ns_1::baz::*]
-} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p}
-test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p}
+test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1::baz {}
     namespace eval test_ns_1 {
         proc baz::p {} {
@@ -80,9 +80,10 @@ test proc-1.5 {Tcl_ProcObjCmd, qualified proc name and proc defined in namespace
     list [test_ns_1::baz::p] \
          [info commands test_ns_1::baz::*] \
          [namespace eval test_ns_1::baz {namespace which p}]
-} {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p}
-test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {{p in ::test_ns_1::baz} ::test_ns_1::baz::p ::test_ns_1::baz::p}
+test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or end of command names} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1 {
         proc q: {} {return "q:"}
         proc value:at: {} {return "value:at:"}
@@ -94,90 +95,104 @@ test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or e
          [lsort [info commands test_ns_1::*]] \
          [namespace eval test_ns_1 {namespace which q:}] \
          [namespace eval test_ns_1 {namespace which value:at:}]
-} {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
-test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} {
+} -result {q: value:at: q: value:at: {::test_ns_1::q: ::test_ns_1::value:at:} ::test_ns_1::q: ::test_ns_1::value:at:}
+test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup {
     catch {rename p ""}
-    list [catch {proc p {a(1) a(2)} { 
-            set z [expr $a(1)+$a(2)]
-            puts "$z=z, $a(1)=$a(1)"
-        }} msg] $msg
-} {1 {procedure "p" has formal parameter "a(1)" that is an array element}}
-test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} {
+} -returnCodes error -body {
+    proc p {a(1) a(2)} { 
+	set z [expr $a(1)+$a(2)]
+	puts "$z=z, $a(1)=$a(1)"
+    }
+} -result {formal parameter "a(1)" is an array element}
+test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
     catch {rename p ""}
-    list [catch {proc p {b:a b::a} { 
-    }} msg] $msg
-} {1 {procedure "p" has formal parameter "b::a" that is not a simple name}}
+} -body {
+    proc p {b:a b::a} { 
+    }
+} -returnCodes error -result {formal parameter "b::a" is not a simple name}
 
-test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename p ""}
+} -body {
     proc p {} {return "p in [namespace current]"}
     info body p
-} {return "p in [namespace current]"}
-test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {return "p in [namespace current]"}
+test proc-2.2 {TclFindProc, simple proc name and proc defined in namespace} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1 {
         namespace eval baz {
             proc p {} {return "p in [namespace current]"}
         }
     }
     namespace eval test_ns_1::baz {info body p}
-} {return "p in [namespace current]"}
-test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {return "p in [namespace current]"}
+test proc-2.3 {TclFindProc, qualified proc name and proc defined in namespace} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1::baz {}
     namespace eval test_ns_1 {
         proc baz::p {} {return "p in [namespace current]"}
     }
     namespace eval test_ns_1 {info body baz::p}
-} {return "p in [namespace current]"}
-test proc-2.4 {TclFindProc, global proc and executing in namespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {return "p in [namespace current]"}
+test proc-2.4 {TclFindProc, global proc and executing in namespace} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename p ""}
+} -body {
     proc p {} {return "global p"}
     namespace eval test_ns_1::baz {info body p}
-} {return "global p"}
+} -result {return "global p"}
 
-test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+test proc-3.1 {TclObjInterpProc, proc defined and executing in same namespace} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     proc p {} {return "p in [namespace current]"}
     p
-} {p in ::}
-test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {p in ::}
+test proc-3.2 {TclObjInterpProc, proc defined and executing in same namespace} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
     namespace eval test_ns_1::baz {
         proc p {} {return "p in [namespace current]"}
         p
     }
-} {p in ::test_ns_1::baz}
-test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {p in ::test_ns_1::baz}
+test proc-3.3 {TclObjInterpProc, proc defined and executing in different namespaces} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename p ""}
+} -body {
     proc p {} {return "p in [namespace current]"}
     namespace eval test_ns_1::baz {
         p
     }
-} {p in ::}
-test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+} -result {p in ::}
+test proc-3.4 {TclObjInterpProc, procs execute in the namespace in which they were defined unless renamed into new namespace} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename p ""}
+} -body {
     namespace eval test_ns_1::baz {
         proc p {} {return "p in [namespace current]"}
         rename ::test_ns_1::baz::p ::p
         list [p] [namespace which p]
     }
-} {{p in ::} ::p}
-test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} {
+} -result {{p in ::} ::p}
+test proc-3.5 {TclObjInterpProc, any old result is reset before appending error msg about missing arguments} -body {
     proc p {x} {info commands 3m}
-    list [catch {p} msg] $msg
-} {1 {wrong # args: should be "p x"}}
-
-test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} {
+    p
+} -returnCodes error -result {wrong # args: should be "p x"}
+test proc-3.6 {TclObjInterpProc, proper quoting of proc name, Bug 942757} -body {
     proc {a b  c} {x} {info commands 3m}
-    list [catch {{a b  c}} msg] $msg
-} {1 {wrong # args: should be "{a b  c} x"}}
+    {a b  c}
+} -returnCodes error -result {wrong # args: should be "{a b  c} x"}
 
-catch {namespace delete {expand}[namespace children :: test_ns_*]}
+test proc-3.7 {TclObjInterpProc, wrong num args, Bug 3366265} {
+    proc {} {x} {}
+    list [catch {{}} msg] $msg
+} {1 {wrong # args: should be "{} x"}}
+
+catch {namespace delete {*}[namespace children :: test_ns_*]}
 catch {rename p ""}
 catch {rename {} ""}
 catch {rename {a b  c} {}}
@@ -187,118 +202,119 @@ catch {rename p ""}
 catch {rename t ""}
 
 # Note that the test require that procedures whose body is used to create
-# procbody objects must be executed before the procbodytest::proc command
-# is executed, so that the Proc struct is populated correctly (CompiledLocals
-# are added at compile time).
+# procbody objects must be executed before the procbodytest::proc command is
+# executed, so that the Proc struct is populated correctly (CompiledLocals are
+# added at compile time).
 
-test proc-4.1 {TclCreateProc, procbody obj} procbodytest {
-    catch {
-	proc p x {return "$x:$x"}
-	set rv [p P]
-	procbodytest::proc t x p
-	lappend rv [t T]
-	set rv
-    } result
+test proc-4.1 {TclCreateProc, procbody obj} -constraints procbodytest -body {
+    proc p x {return "$x:$x"}
+    set rv [p P]
+    procbodytest::proc t x p
+    lappend rv [t T]
+} -cleanup {
     catch {rename p ""}
     catch {rename t ""}
-    set result
-} {P:P T:T}
-test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} procbodytest {
-    catch {
-	proc p x {
-	    set y [string tolower $x]
-	    return "$x:$y"
-	}
-	set rv [p P]
-	procbodytest::proc t x p
-	lappend rv [t T]
-	set rv
-    } result
+} -result {P:P T:T}
+test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} -body {
+    proc p x {
+	set y [string tolower $x]
+	return "$x:$y"
+    }
+    set rv [p P]
+    procbodytest::proc t x p
+    lappend rv [t T]
+} -constraints procbodytest -cleanup {
     catch {rename p ""}
     catch {rename t ""}
-    set result
-} {P:p T:t}
-test proc-4.3 {TclCreateProc, procbody obj, too many args} procbodytest {
-    catch {
-	proc p x {
-	    set y [string tolower $x]
-	    return "$x:$y"
-	}
-	set rv [p P]
-	procbodytest::proc t {x x1 x2} p
-	lappend rv [t T]
-	set rv
-    } result
+} -result {P:p T:t}
+test proc-4.3 {TclCreateProc, procbody obj, too many args} -body {
+    proc p x {
+	set y [string tolower $x]
+	return "$x:$y"
+    }
+    set rv [p P]
+    procbodytest::proc t {x x1 x2} p
+    lappend rv [t T]
+} -constraints procbodytest -returnCodes error -cleanup {
     catch {rename p ""}
     catch {rename t ""}
-    set result
-} {procedure "t": arg list contains 3 entries, precompiled header expects 1}
-test proc-4.4 {TclCreateProc, procbody obj, inconsitent arg name} procbodytest {
-    catch {
-	proc p {x y z} {
-	    set v [join [list $x $y $z]]
-	    set w [string tolower $v]
-	    return "$v:$w"
-	}
-	set rv [p P Q R]
-	procbodytest::proc t {x x1 z} p
-	lappend rv [t S T U]
-	set rv
-    } result
+} -result {procedure "t": arg list contains 3 entries, precompiled header expects 1}
+test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} -body {
+    proc p {x y z} {
+	set v [join [list $x $y $z]]
+	set w [string tolower $v]
+	return "$v:$w"
+    }
+    set rv [p P Q R]
+    procbodytest::proc t {x x1 z} p
+    lappend rv [t S T U]
+} -constraints procbodytest -returnCodes error -cleanup {
     catch {rename p ""}
     catch {rename t ""}
-    set result
-} {procedure "t": formal parameter 1 is inconsistent with precompiled body}
-test proc-4.5 {TclCreateProc, procbody obj, inconsitent arg default type} procbodytest {
-    catch {
-	proc p {x y {z Z}} {
-	    set v [join [list $x $y $z]]
-	    set w [string tolower $v]
-	    return "$v:$w"
-	}
-	set rv [p P Q R]
-	procbodytest::proc t {x y z} p
-	lappend rv [t S T U]
-	set rv
-    } result
+} -result {procedure "t": formal parameter 1 is inconsistent with precompiled body}
+test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} -body {
+    proc p {x y {z Z}} {
+	set v [join [list $x $y $z]]
+	set w [string tolower $v]
+	return "$v:$w"
+    }
+    set rv [p P Q R]
+    procbodytest::proc t {x y z} p
+    lappend rv [t S T U]
+} -constraints procbodytest -returnCodes error -cleanup {
     catch {rename p ""}
     catch {rename t ""}
-    set result
-} {procedure "t": formal parameter 2 is inconsistent with precompiled body}
-test proc-4.6 {TclCreateProc, procbody obj, inconsitent arg default type} procbodytest {
-    catch {
-	proc p {x y z} {
-	    set v [join [list $x $y $z]]
-	    set w [string tolower $v]
-	    return "$v:$w"
-	}
-	set rv [p P Q R]
-	procbodytest::proc t {x y {z Z}} p
-	lappend rv [t S T U]
-	set rv
-    } result
+} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body}
+test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} -body {
+    proc p {x y z} {
+	set v [join [list $x $y $z]]
+	set w [string tolower $v]
+	return "$v:$w"
+    }
+    set rv [p P Q R]
+    procbodytest::proc t {x y {z Z}} p
+    lappend rv [t S T U]
+} -returnCodes error -constraints procbodytest -cleanup {
     catch {rename p ""}
     catch {rename t ""}
-    set result
-} {procedure "t": formal parameter 2 is inconsistent with precompiled body}
-test proc-4.7 {TclCreateProc, procbody obj, inconsitent arg default value} procbodytest {
-    catch {
-	proc p {x y {z Z}} {
-	    set v [join [list $x $y $z]]
-	    set w [string tolower $v]
-	    return "$v:$w"
-	}
-	set rv [p P Q R]
-	procbodytest::proc t {x y {z ZZ}} p
-	lappend rv [t S T U]
-	set rv
-    } result
+} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body}
+test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} -body {
+    proc p {x y {z Z}} {
+	set v [join [list $x $y $z]]
+	set w [string tolower $v]
+	return "$v:$w"
+    }
+    set rv [p P Q R]
+    procbodytest::proc t {x y {z ZZ}} p
+    lappend rv [t S T U]
+} -constraints procbodytest -returnCodes error -cleanup {
     catch {rename p ""}
     catch {rename t ""}
-    set result
-} {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
+} -result {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
+test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -setup {
+    proc getbytes {} {
+	set lines [split [memory info] "\n"]
+	lindex $lines 3 3
+    }
+    proc px x {
+	set y [string tolower $x]
+	return "$x:$y"
+    }
+    px x
+} -constraints {procbodytest memory} -body {
+    set end [getbytes]
+    for {set i 0} {$i < 5} {incr i} {
+	procbodytest::proc tx x px
+	set tmp $end
+	set end [getbytes]
+    }
+    set leakedBytes [expr {$end - $tmp}]
+} -cleanup {
+    rename getbytes {}
+    unset -nocomplain end i tmp leakedBytes
+} -result 0
 
-test proc-5.1 {Bytecompiling noop; test for correct argument substitution} {
+test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
     proc p args {} ; # this will be bytecompiled into t
     proc t {} {
 	set res {}
@@ -309,20 +325,20 @@ test proc-5.1 {Bytecompiling noop; test for correct argument substitution} {
 	p $a ccccccw {bfe} {$a} [incr b] [incr a] {[incr b]} {$a} hello
 	set res
     }
-    set result [t]
+    t
+} -cleanup {
     catch {rename p ""}
     catch {rename t ""}
-    set result
-} {aba}    
+} -result {aba}    
 
-test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} {
+test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} -body {
     proc a {} {return -code -5}
     proc b {} a
-    set result [catch b]
+    catch b
+} -cleanup {
     rename a {}
     rename b {}
-    set result
-} -5
+} -result -5
 
 test proc-7.1 {Redefining a compiled cmd: Bug 729692} {
     proc bar args {}
@@ -332,19 +348,17 @@ test proc-7.1 {Redefining a compiled cmd: Bug 729692} {
     }
     foo
 } bar
-
-test proc-7.2 {Shadowing a compiled cmd: Bug 729692} {
+test proc-7.2 {Shadowing a compiled cmd: Bug 729692} -body {
     namespace eval ugly {}
     proc ugly::foo {} {
 	proc set args {return bar}
 	set x 1
     }
-    set res [list [catch {ugly::foo} msg] $msg]
+    ugly::foo
+} -cleanup {
     namespace delete ugly
-    set res
-} {0 bar}
-
-test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} {
+} -result bar
+test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} -body {
     namespace eval ugly {}
     proc ugly::foo {} {
 	set i 0
@@ -356,15 +370,27 @@ test proc-7.3 {Returning loop exception from redefined cmd: Bug 729692} {
 	}
 	return $i
     }
-    set res [list [catch {ugly::foo} msg] $msg]
+    ugly::foo
+} -cleanup {
     namespace delete ugly
-    set res
-} {0 4}
-
-
+} -result 4
 
+test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
+    set lambda x
+    lappend lambda {set a 1}
+    interp create slave
+    slave eval [list apply $lambda foo]
+    interp delete slave
+    unset lambda
+} {}
+
 # cleanup
 catch {rename p ""}
 catch {rename t ""}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/pwd.test b/tests/pwd.test
index 1592680..175c852 100644
--- a/tests/pwd.test
+++ b/tests/pwd.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: pwd.test,v 1.7 2004/05/19 13:00:13 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
diff --git a/tests/reg.test b/tests/reg.test
index 37536ce..e6ce42c 100644
--- a/tests/reg.test
+++ b/tests/reg.test
@@ -8,13 +8,14 @@
 # to read this file, ignoring the Tcl-isms.)
 #
 # Copyright (c) 1998, 1999 Henry Spencer.  All rights reserved.
-#
-# RCS: @(#) $Id: reg.test,v 1.22 2004/11/05 15:15:25 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 # All tests require the testregexp command, return if this
 # command doesn't exist
 
@@ -176,39 +177,46 @@ namespace eval RETest {
 	return $ret
     }
 
+    # Share the generation of the list of test constraints so it is
+    # done the same on all routes.
+    proc TestConstraints {flags} {
+	set constraints [list testregexp]
+
+	variable regBug
+	if {$regBug} {
+	    # This will trigger registration as a skipped test
+	    lappend constraints knownBug
+	}
+
+	# Tcl locale stuff doesn't do the ch/xy test fakery yet
+	if {[string match *+* $flags]} {
+	    # This will trigger registration as a skipped test
+	    lappend constraints localeRegexp
+	}
+
+	return $constraints
+    }
+
     # match expected, internal routine that does the work
     # parameters like the "real" routines except they don't have "opts",
     #  which is a possibly-empty list of switches for the regexp match attempt
     # The ! flag is used to indicate expected match failure (for REG_EXPECT,
     #  which wants argument testing even in the event of failure).
     proc MatchExpected {opts testid flags re target args} {
-	variable regBug
-
 	# if &, test as both BRE and ARE
 	if {[string match *&* $flags]} {
 	    set f [string map {& {}} $flags]
-	    MatchExpected $opts "$testid ARE" ${f}  $re $target {expand}$args
-	    MatchExpected $opts "$testid BRE" ${f}b $re $target {expand}$args
+	    MatchExpected $opts "$testid ARE" ${f}  $re $target {*}$args
+	    MatchExpected $opts "$testid BRE" ${f}b $re $target {*}$args
 	    return
 	}
 
-	set constraints [list testregexp]
-
-	if {$regBug} {
-	    # This will register as a skipped test
-	    lappend constraints knownBug
-	}
-
-	# Tcl locale stuff doesn't do the ch/xy test fakery yet
-	if {[string match *+* $flags]} {
-	    # This will register as a skipped test
-	    lappend constraints localeRegexp
-	}
+	set constraints [TestConstraints $flags]
 
 	set f [TestFlags $flags]
 	set infoflags [TestInfoFlags $flags]
-	set ccmd [list testregexp -about        {expand}$f $re]
-	set ecmd [list testregexp {expand}$opts {expand}$f $re $target]
+	set ccmd [list testregexp -about        {*}$f $re]
+	set ecmd [list testregexp {*}$opts {*}$f $re $target]
 
 	set nsub [expr {[llength $args] - 1}]
 	set names [list]
@@ -230,7 +238,7 @@ namespace eval RETest {
 	    incr nsub -1			;# the extra does not count
 	}
 	set erun "list \[[concat $ecmd $names]\] $refs"
-	set result [list [expr {![string match *!* $flags]}] {expand}$args]
+	set result [list [expr {![string match *!* $flags]}] {*}$args]
 	set info [list $nsub $infoflags]
 
 	::tcltest::test [TestNum $testid compile] [TestDesc $testid compile] \
@@ -254,15 +262,9 @@ namespace eval RETest {
 	    return
 	}
 
-	set constraints [list testregexp]
-
-	# Tcl locale stuff doesn't do the ch/xy test fakery yet
-	if {[string match *+* $flags]} {
-	    # This will register as a skipped test
-	    lappend constraints localeRegexp
-	}
+	set constraints [TestConstraints $flags]
 
-	set cmd [list testregexp -about {expand}[TestFlags $flags] $re]
+	set cmd [list testregexp -about {*}[TestFlags $flags] $re]
 	::tcltest::test [TestNum $testid error] [TestDesc $testid error] \
 		-constraints $constraints -result [list 1 REG_$err] -body \
 		"list \[catch \{$cmd\}\] \[lindex \$::errorCode 1\]"
@@ -270,25 +272,20 @@ namespace eval RETest {
 
     # match failure expected
     proc expectNomatch {testid flags re target args} {
+	variable regBug
 	# if &, test as both ARE and BRE
 	if {[string match *&* $flags]} {
 	    set f [string map {& {}} $flags]
-	    expectNomatch "$testid ARE" ${f}  $re $target {expand}$args
-	    expectNomatch "$testid BRE" ${f}b $re $target {expand}$args
+	    expectNomatch "$testid ARE" ${f}  $re $target {*}$args
+	    expectNomatch "$testid BRE" ${f}b $re $target {*}$args
 	    return
 	}
 
-	set constraints [list testregexp]
-
-	# Tcl locale stuff doesn't do the ch/xy test fakery yet
-	if {[string match *+* $flags]} {
-	    # This will register as a skipped test
-	    lappend constraints localeRegexp
-	}
+	set constraints [TestConstraints $flags]
 
 	set f [TestFlags $flags]
 	set infoflags [TestInfoFlags $flags]
-	set ccmd [list testregexp -about {expand}$f $re]
+	set ccmd [list testregexp -about {*}$f $re]
 	set nsub [expr {[llength $args] - 1}]
 	if {$nsub == -1} {
 	    # didn't tell us number of subexps
@@ -297,7 +294,7 @@ namespace eval RETest {
 	} else {
 	    set info [list $nsub $infoflags]
 	}
-	set ecmd [list testregexp {expand}$f $re $target]
+	set ecmd [list testregexp {*}$f $re $target]
 
 	::tcltest::test [TestNum $testid compile] [TestDesc $testid compile] \
 		-constraints $constraints -body $ccmd -result $info
@@ -308,13 +305,13 @@ namespace eval RETest {
     # match expected (no missing, empty, or ambiguous submatches)
     # expectMatch testno flags re target mat submat ...
     proc expectMatch {args} {
-	MatchExpected {} {expand}$args
+	MatchExpected {} {*}$args
     }
 
     # match expected (full fanciness)
     # expectIndices testno flags re target mat submat ...
     proc expectIndices {args} {
-	MatchExpected -indices {expand}$args 
+	MatchExpected -indices {*}$args 
     }
 
     # partial match expected
@@ -322,7 +319,7 @@ namespace eval RETest {
     # Quirk:  number of ""s must be one more than number of subREs.
     proc expectPartial {args} {
 	lset args 1 ![lindex $args 1]	;# add ! flag
-	MatchExpected -indices {expand}$args
+	MatchExpected -indices {*}$args
     }
 
     # test is a knownBug
@@ -333,7 +330,7 @@ namespace eval RETest {
     }
 }
 namespace import RETest::*
-
+
 ######## the tests themselves ########
 
 # support functions and preliminary misc.
@@ -628,16 +625,24 @@ expectMatch	13.13 P		"a\\nb"		"a\nb"	"a\nb"
 expectMatch	13.14 P		"a\\rb"		"a\rb"	"a\rb"
 expectMatch	13.15 P		"a\\tb"		"a\tb"	"a\tb"
 expectMatch	13.16 P		"a\\u0008x"	"a\bx"	"a\bx"
-expectError	13.17 -		{a\u008x}	EESCAPE
+expectMatch	13.17 P		{a\u008x}	"a\bx"	"a\bx"
 expectMatch	13.18 P		"a\\u00088x"	"a\b8x"	"a\b8x"
 expectMatch	13.19 P		"a\\U00000008x"	"a\bx"	"a\bx"
-expectError	13.20 -		{a\U0000008x}	EESCAPE
+expectMatch	13.20 P		{a\U0000008x}	"a\bx"	"a\bx"
 expectMatch	13.21 P		"a\\vb"		"a\vb"	"a\vb"
 expectMatch	13.22 MP	"a\\x08x"	"a\bx"	"a\bx"
 expectError	13.23 -		{a\xq}		EESCAPE
-expectMatch	13.24 MP	"a\\x0008x"	"a\bx"	"a\bx"
+expectMatch	13.24 MP	"a\\x08x"	"a\bx"	"a\bx"
 expectError	13.25 -		{a\z}		EESCAPE
 expectMatch	13.26 MP	"a\\010b"	"a\bb"	"a\bb"
+expectMatch	13.27 P		"a\\U00001234x"	"a\u1234x"	"a\u1234x"
+expectMatch	13.28 P		{a\U00001234x}	"a\u1234x"	"a\u1234x"
+expectMatch	13.29 P		"a\\U0001234x"	"a\u1234x"	"a\u1234x"
+expectMatch	13.30 P		{a\U0001234x}	"a\u1234x"	"a\u1234x"
+expectMatch	13.31 P		"a\\U000012345x"	"a\u12345x"	"a\u12345x"
+expectMatch	13.32 P		{a\U000012345x}	"a\u12345x"	"a\u12345x"
+expectMatch	13.33 P		"a\\U1000000x"	"a\ufffd0x"	"a\ufffd0x"
+expectMatch	13.34 P		{a\U1000000x}	"a\ufffd0x"	"a\ufffd0x"
 
 
 doing 14 "back references"
@@ -662,6 +667,9 @@ expectMatch	14.17 RP	{a([bc])(\1*)}	ab	ab	b	""
 expectError	14.18 -		{a((b)\1)}	ESUBREG
 expectError	14.19 -		{a(b)c\2}	ESUBREG
 expectMatch	14.20 bR	{a\(b*\)c\1}	abbcbb	abbcbb	bb
+expectMatch	14.21 RP	{^([bc])\1*$}	bbb	bbb	b
+expectMatch	14.22 RP	{^([bc])\1*$}	ccc	ccc	c
+knownBug expectNomatch 14.23 R	{^([bc])\1*$}	bcb
 
 
 doing 15 "octal escapes vs back references"
@@ -684,6 +692,7 @@ expectError	15.9  -	{a((((((((((b\10))))))))))c}	ESUBREG
 expectMatch	15.10 MP	"a\\12b"	"a\nb"	"a\nb"
 expectError	15.11 b		{a\12b}		ESUBREG
 expectMatch	15.12 eAS	{a\12b}		a12b	a12b
+expectMatch	15.13 MP	{a\701b}	a\u00381b	a\u00381b
 
 
 doing 16 "expanded syntax"
@@ -1050,14 +1059,110 @@ test reg-33.8 {Bug 505048} {
 test reg-33.9 {Bug 505048} {
     regexp -indices -inline {\A\s*[^b]*b} ab
 } {{0 1}}
-test reg-33.10 {Bug 840258} {
+test reg-33.10 {Bug 840258} -body {
     regsub {(^|\n)+\.*b} \n.b {} tmp
-} 1
-test reg-33.11 {Bug 840258} {
+} -cleanup {
+    unset tmp
+} -result 1
+test reg-33.11 {Bug 840258} -body {
     regsub {(^|[\n\r]+)\.*\?<.*?(\n|\r)+} \
 	    "TQ\r\n.?<5000267>Test already stopped\r\n" {} tmp
+} -cleanup {
+    unset tmp
+} -result 1
+test reg-33.12 {Bug 1810264 - bad read} {
+    regexp {\3161573148} {\3161573148}
+} 0
+test reg-33.13 {Bug 1810264 - infinite loop} {
+    regexp {($|^)*} {x}
 } 1
-
+# Some environments have small default stack sizes. [Bug 1905562]
+test reg-33.14 {Bug 1810264 - super-expensive expression} nonPortable {
+    regexp {(x{200}){200}$y} {x}
+} 0
+test reg-33.15 {Bug 3603557 - an "in the wild" RE} {
+    lindex [regexp -expanded -about {
+	^TETRA_MODE_CMD				# Message Type
+	([[:blank:]]+)				# Pad
+	(ETS_1_1|ETS_1_2|ETS_2_2)		# SystemCode
+	([[:blank:]]+)				# Pad
+	(CONTINUOUS|CARRIER|MCCH|TRAFFIC)	# SharingMode
+	([[:blank:]]+)				# Pad
+	([[:digit:]]{1,2})			# ColourCode
+	([[:blank:]]+)				# Pad
+	(1|2|3|4|6|9|12|18)			# TSReservedFrames
+	([[:blank:]]+)				# Pad
+	(PASS|TRUE|FAIL|FALSE)			# UPlaneDTX
+	([[:blank:]]+)				# Pad
+	(PASS|TRUE|FAIL|FALSE)			# Frame18Extension
+	([[:blank:]]+)				# Pad
+	([[:digit:]]{1,4})			# MCC
+	([[:blank:]]+)				# Pad
+	([[:digit:]]{1,5})			# MNC
+	([[:blank:]]+)				# Pad
+	(BOTH|BCAST|ENQRY|NONE)			# NbrCellBcast
+	([[:blank:]]+)				# Pad
+	(UNKNOWN|LOW|MEDIUM|HIGH)		# CellServiceLevel
+	([[:blank:]]+)				# Pad
+	(PASS|TRUE|FAIL|FALSE)			# LateEntryInfo
+	([[:blank:]]+)				# Pad
+	(300|400)				# FrequencyBand
+	([[:blank:]]+)				# Pad
+	(NORMAL|REVERSE)			# ReverseOperation
+	([[:blank:]]+)				# Pad
+	(NONE|\+6\.25|\-6\.25|\+12\.5)		# Offset
+	([[:blank:]]+)				# Pad
+	(10)					# DuplexSpacing
+	([[:blank:]]+)				# Pad
+	([[:digit:]]{1,4})			# MainCarrierNr
+	([[:blank:]]+)				# Pad
+	(0|1|2|3)				# NrCSCCH
+	([[:blank:]]+)				# Pad
+	(15|20|25|30|35|40|45)			# MSTxPwrMax
+	([[:blank:]]+)				# Pad
+	(\-125|\-120|\-115|\-110|\-105|\-100|\-95|\-90|\-85|\-80|\-75|\-70|\-65|\-60|\-55|\-50)
+						# RxLevAccessMin
+	([[:blank:]]+)				# Pad
+	(\-53|\-51|\-49|\-47|\-45|\-43|\-41|\-39|\-37|\-35|\-33|\-31|\-29|\-27|\-25|\-23)
+						# AccessParameter
+	([[:blank:]]+)				# Pad
+	(DISABLE|[[:digit:]]{3,4})		# RadioDLTimeout
+	([[:blank:]]+)				# Pad
+	(\-[[:digit:]]{2,3})			# RSSIThreshold
+	([[:blank:]]+)				# Pad
+	([[:digit:]]{1,5})			# CCKIdSCKVerNr
+	([[:blank:]]+)				# Pad
+	([[:digit:]]{1,5})			# LocationArea
+	([[:blank:]]+)				# Pad
+	([(1|0)]{16})				# SubscriberClass
+	([[:blank:]]+)				# Pad
+	([(1|0)]{12})				# BSServiceDetails
+	([[:blank:]]+)				# Pad
+	(RANDOMIZE|IMMEDIATE|[[:digit:]]{1,2})	# IMM
+	([[:blank:]]+)				# Pad
+	([[:digit:]]{1,2})			# WT
+	([[:blank:]]+)				# Pad
+	([[:digit:]]{1,2})			# Nu
+	([[:blank:]]+)				# Pad
+	([0-1])					# FrameLngFctr
+	([[:blank:]]+)				# Pad
+	([[:digit:]]{1,2})			# TSPtr
+	([[:blank:]]+)				# Pad
+	([0-7])					# MinPriority
+	([[:blank:]]+)				# Pad
+	(PASS|TRUE|FAIL|FALSE)			# ExtdSrvcsEnabled
+	([[:blank:]]+)				# Pad
+	(.*)					# ConditionalFields
+    }] 0
+} 68
+test reg-33.16 {Bug [8d2c0da36d]- another "in the wild" RE} {
+    lindex [regexp -about "^MRK:client1: =1339 14HKelly Talisman 10011000 (\[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]*) \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 8 0 8 0 0 0 77 77 1 1 2 0 11 { 1 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 13HC6 My Creator 2 3 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 31HC7 Slightly offensive name, huh 3 8 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 23HE-mail:kelly@hotbox.com 4 9 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 17Hcompface must die 5 10 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 3HAir 6 12 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 14HPGP public key 7 13 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 16Hkelly@hotbox.com 8 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 12H2 text/plain 9 30 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 0 13H2 x-kom/basic 10 33 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H0 11 14 8 \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* \[0-9\]* 00000000 1 1H3 }\r?"] 0
+} 1
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/regexp.test b/tests/regexp.test
index 03efa04..1b2bec9 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -10,15 +10,16 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: regexp.test,v 1.27 2005/05/10 18:35:23 kennykb Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-catch {unset foo}
+unset -nocomplain foo
+
+testConstraint exec [llength [info commands exec]]
+
 test regexp-1.1 {basic regexp operation} {
     regexp ab*c abbbc
 } 1
@@ -43,6 +44,30 @@ test regexp-1.7 {regexp utf compliance} {
     regexp "\u4e4eb q" "a\u4e4eb qw\u5e4e\x4e wq" bar
     list [string compare $foo $bar] [regexp 4 $bar]
 } {0 0}
+test regexp-1.8 {regexp ***= metasyntax} {
+    regexp -- "***=o" "aeiou"
+} 1
+test regexp-1.9 {regexp ***= metasyntax} {
+    set string "aeiou"
+    regexp -- "***=o" $string
+} 1
+test regexp-1.10 {regexp ***= metasyntax} {
+    set string "aeiou"
+    set re "***=o"
+    regexp -- $re $string
+} 1
+test regexp-1.11 {regexp ***= metasyntax} {
+    regexp -- "***=y" "aeiou"
+} 0
+test regexp-1.12 {regexp ***= metasyntax} {
+    set string "aeiou"
+    regexp -- "***=y" $string
+} 0
+test regexp-1.13 {regexp ***= metasyntax} {
+    set string "aeiou"
+    set re "***=y"
+    regexp -- $re $string
+} 0
 
 test regexp-2.1 {getting substrings back from regexp} {
     set foo {}
@@ -94,6 +119,28 @@ test regexp-2.10 {getting substrings back from regexp} {
     set f2 {}
     list [regexp f\352te(b*)c eff\352tebbbbc foo f2] $foo $f2
 } [list 1 f\352tebbbbc bbbb]
+test regexp-2.11 {non-capturing subgroup} {
+    set foo {}
+    set f2 {}
+    list [regexp {str(?:a+)} straa foo f2] $foo $f2
+} [list 1 straa {}]
+test regexp-2.12 {non-capturing subgroup with -inline} {
+    regexp -inline {str(?:a+)} straa
+} {straa}
+test regexp-2.13 {non-capturing and capturing subgroups} {
+    set foo {}
+    set f2 {}
+    set f3 {}
+    list [regexp {str(?:a+)(c+)} straacc foo f2 f3] $foo $f2 $f3
+} [list 1 straacc cc {}]
+test regexp-2.14 {non-capturing and capturing subgroups} {
+    regexp -inline {str(?:a+)(c+)} straacc
+} {straacc cc}
+test regexp-2.15 {getting substrings back from regexp} {
+    set foo NA
+    set f2 NA
+    list [regexp {str(?:a+)} straa foo f2] $foo $f2
+} [list 1 straa {}]
 
 test regexp-3.1 {-indices option to regexp} {
     set foo {}
@@ -149,7 +196,7 @@ set x $x$x$x$x$x$x$x$x$x$x$x$x
 test regexp-4.4 {case conversion in regexp} {
     list [regexp -nocase $x $x foo] $foo
 } "1 $x"
-catch {unset x}
+unset -nocomplain x
 
 test regexp-5.1 {exercise cache of compiled expressions} {
     regexp .*a b
@@ -194,10 +241,10 @@ test regexp-5.5 {exercise cache of compiled expressions} {
 
 test regexp-6.1 {regexp errors} {
     list [catch {regexp a} msg] $msg
-} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
+} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}
 test regexp-6.2 {regexp errors} {
     list [catch {regexp -nocase a} msg] $msg
-} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
+} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}
 test regexp-6.3 {regexp errors} {
     list [catch {regexp -gorp a} msg] $msg
 } {1 {bad switch "-gorp": must be -all, -about, -indices, -inline, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
@@ -213,14 +260,18 @@ test regexp-6.6 {regexp errors} {
 test regexp-6.7 {regexp errors} {
     list [catch {regexp (x)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)(.) xyzzy} msg] $msg
 } {0 0}
-test regexp-6.8 {regexp errors} {
-    catch {unset f1}
+test regexp-6.8 {regexp errors} -setup {
+    unset -nocomplain f1
+} -body {
     set f1 44
-    list [catch {regexp abc abc f1(f2)} msg] $msg
-} {1 {couldn't set variable "f1(f2)"}}
+    regexp abc abc f1(f2)
+} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
 test regexp-6.9 {regexp errors, -start bad int check} {
     list [catch {regexp -start bogus {^$} {}} msg] $msg
 } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
+test regexp-6.10 {regexp errors} {
+    list [catch {regexp {a[} b} msg] $msg
+} {1 {couldn't compile regular expression pattern: brackets [] not balanced}}
 
 test regexp-7.1 {basic regsub operation} {
     list [regsub aa+ xaxaaaxaa 111&222 foo] $foo
@@ -280,6 +331,42 @@ test regexp-7.17 {regsub utf compliance} {
     regsub a\u4e4eb xyza\u4e4ebijka\u4e4ebpqr 555 bar
     list [string compare $foo $bar] [regexp 4 $bar]
 } {0 0}
+test regexp-7.18 {basic regsub replacement} {
+    list [regsub a+ aaa {&} foo] $foo
+} {1 aaa}
+test regexp-7.19 {basic regsub replacement} {
+    list [regsub a+ aaa {\&} foo] $foo
+} {1 &}
+test regexp-7.20 {basic regsub replacement} {
+    list [regsub a+ aaa {\\&} foo] $foo
+} {1 {\aaa}}
+test regexp-7.21 {basic regsub replacement} {
+    list [regsub a+ aaa {\\\&} foo] $foo
+} {1 {\&}}
+test regexp-7.22 {basic regsub replacement} {
+    list [regsub a+ aaa {\0} foo] $foo
+} {1 aaa}
+test regexp-7.23 {basic regsub replacement} {
+    list [regsub a+ aaa {\\0} foo] $foo
+} {1 {\0}}
+test regexp-7.24 {basic regsub replacement} {
+    list [regsub a+ aaa {\\\0} foo] $foo
+} {1 {\aaa}}
+test regexp-7.25 {basic regsub replacement} {
+    list [regsub a+ aaa {\\\\0} foo] $foo
+} {1 {\\0}}
+test regexp-7.26 {dollar zero is not a backslash replacement} {
+    list [regsub a+ aaa {$0} foo] $foo
+} {1 {$0}}
+test regexp-7.27 {dollar zero is not a backslash replacement} {
+    list [regsub a+ aaa {\0$0} foo] $foo
+} {1 {aaa$0}}
+test regexp-7.28 {dollar zero is not a backslash replacement} {
+    list [regsub a+ aaa {\$0} foo] $foo
+} {1 {\$0}}
+test regexp-7.29 {dollar zero is not a backslash replacement} {
+    list [regsub a+ aaa {\\} foo] $foo
+} {1 \\}
 
 test regexp-8.1 {case conversion in regsub} {
     list [regsub -nocase a(a+) xaAAaAAay & foo] $foo
@@ -354,27 +441,28 @@ test regexp-10.5 {inverse partial newline sensitivity in regsub} {
 
 test regexp-11.1 {regsub errors} {
     list [catch {regsub a b} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
 test regexp-11.2 {regsub errors} {
     list [catch {regsub -nocase a b} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
 test regexp-11.3 {regsub errors} {
     list [catch {regsub -nocase -all a b} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
 test regexp-11.4 {regsub errors} {
     list [catch {regsub a b c d e f} msg] $msg
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
 test regexp-11.5 {regsub errors} {
     list [catch {regsub -gorp a b c} msg] $msg
 } {1 {bad switch "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
 test regexp-11.6 {regsub errors} {
     list [catch {regsub -nocase a( b c d} msg] $msg
 } {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
-test regexp-11.7 {regsub errors} {
-    catch {unset f1}
+test regexp-11.7 {regsub errors} -setup {
+    unset -nocomplain f1
+} -body {
     set f1 44
-    list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
-} {1 {couldn't set variable "f1(f2)"}}
+    regsub -nocase aaa aaa xxx f1(f2)
+} -returnCodes error -result {can't set "f1(f2)": variable isn't array}
 test regexp-11.8 {regsub errors, -start bad int check} {
     list [catch {regsub -start bogus pattern string rep var} msg] $msg
 } {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
@@ -400,10 +488,8 @@ test regexp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
 } {1 abcdefghijklmnopqrstuvwxyz a b c d e f g h i j k l m n o p q r s t u v w x y z}
 
 test regexp-13.1 {regsub of a very large string} {
-    # This test is designed to stress the memory subsystem in order
-    # to catch Bug #933.  It only fails if the Tcl memory allocator
-    # is in use.
-
+    # This test is designed to stress the memory subsystem in order to catch
+    # Bug #933.  It only fails if the Tcl memory allocator is in use.
     set line {BEGIN_TABLE ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; END_TABLE}
     set filedata [string repeat $line 200]
     for {set i 1} {$i<10} {incr i} {
@@ -432,10 +518,8 @@ test regexp-14.2 {CompileRegexp: regexp cache, different flags} {
     append x *a
     regexp -nocase $x bbba
 } 1
-
-testConstraint exec [llength [info commands exec]]
 test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -constraints {
-	exec
+    exec
 } -setup {
     set junk [makeFile {puts [regexp {} foo]} junk.tcl]
 } -body {
@@ -445,23 +529,23 @@ test regexp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache} -co
 } -result 1
 
 test regexp-15.1 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start -10 {\d} 1abc2de3 x] $x
 } {1 1}
 test regexp-15.2 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 2 {\d} 1abc2de3 x] $x
 } {1 2}
 test regexp-15.3 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 4 {\d} 1abc2de3 x] $x
 } {1 2}
 test regexp-15.4 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 5 {\d} 1abc2de3 x] $x
 } {1 3}
 test regexp-15.5 {regexp -start, over end of string} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
 } {0 0}
 test regexp-15.6 {regexp -start, loss of ^$ behavior} {
@@ -474,24 +558,28 @@ test regexp-15.8 {regexp -start, double option} {
     regexp -start 0 -start 2 a abc
 } 0
 test regexp-15.9 {regexp -start, end relative index} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start end {\d} 1abc2de3 x] [info exists x]
 } {0 0}
 test regexp-15.10 {regexp -start, end relative index} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start end-1 {\d} 1abc2de3 x] [info exists x] $x
 } {1 1 3}
+test regexp-15.11 {regexp -start, over end of string} {
+    set x NA
+    list [regexp -start 2 {.*} ab x] $x
+} {1 {}}
 
 test regexp-16.1 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
 } {4 a1b/2c/3d/4e/5}
 test regexp-16.2 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start -25 {z} hello {/&} x] $x
 } {0 hello}
 test regexp-16.3 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start 3 {z} hello {/&} x] $x
 } {0 hello}
 test regexp-16.4 {regsub -start, \A behavior} {
@@ -511,6 +599,62 @@ test regexp-16.7 {regexp -start, end relative index} {
 test regexp-16.8 {regexp -start, end relative index} {
     list [regsub -start end-1 a aaa b x] $x
 } {1 aab}
+test regexp-16.9 {regsub -start and -all} {
+    set foo {}
+    list [regsub -start 0 -all x+ axxxbxx |&| foo] $foo
+} {2 a|xxx|b|xx|}
+test regexp-16.10 {regsub -start and -all} {
+    set foo {}
+    list [regsub -start 1 -all x+ axxxbxx |&| foo] $foo
+} {2 a|xxx|b|xx|}
+test regexp-16.11 {regsub -start and -all} {
+    set foo {}
+    list [regsub -start 4 -all x+ axxxbxx |&| foo] $foo
+} {1 axxxb|xx|}
+test regexp-16.12 {regsub -start} {
+    set foo {}
+    list [regsub -start 4 x+ axxxbxx |&| foo] $foo
+} {1 axxxb|xx|}
+test regexp-16.13 {regsub -start and -all} {
+    set foo {}
+    list [regsub -start 1 -all a+ "" & foo] $foo
+} {0 {}}
+test regexp-16.14 {regsub -start} {
+    set foo {}
+    list [regsub -start 1 a+ "" & foo] $foo
+} {0 {}}
+test regexp-16.15 {regsub -start and -all} {
+    set foo {}
+    list [regsub -start 2 -all a+ "xy" & foo] $foo
+} {0 xy}
+test regexp-16.16 {regsub -start} {
+    set foo {}
+    list [regsub -start 2 a+ "xy" & foo] $foo
+} {0 xy}
+test regexp-16.17 {regsub -start and -all} {
+    set foo {}
+    list [regsub -start 1 -all y+ "xy" & foo] $foo
+} {1 xy}
+test regexp-16.18 {regsub -start} {
+    set foo {}
+    list [regsub -start 1 y+ "xy" & foo] $foo
+} {1 xy}
+test regexp-16.19 {regsub -start} {
+    set foo {}
+    list [regsub -start -1 a+ "" & foo] $foo
+} {0 {}}
+test regexp-16.20 {regsub -start, loss of ^$ behavior} {
+    set foo NA
+    list [regsub -start 1 {^$} {} & foo] $foo
+} {0 {}}
+test regexp-16.21 {regsub -start, loss of ^$ behavior} {
+    set foo NA
+    list [regsub -start 1 {^.*$} abc & foo] $foo
+} {0 abc}
+test regexp-16.22 {regsub -start, loss of ^$ behavior} {
+    set foo NA
+    list [regsub -all -start 1 {^.*$} abc & foo] $foo
+} {0 abc}
 
 test regexp-17.1 {regexp -inline} {
     regexp -inline b ababa
@@ -590,6 +734,12 @@ test regexp-19.1 {regsub null replacement} {
     list $result [string length $result]
 } "\0a\0hel\0a\0lo\0a\0 14"
 
+test regexp-19.2 {regsub null replacement} {
+    regsub -all {@} {@hel@lo@} "\0a\0" result
+    set expected "\0a\0hel\0a\0lo\0a\0"
+    string equal $result $expected
+} 1
+
 test regexp-20.1 {regsub shared object shimmering} {
     # Bug #461322
     set a abcdefghijklmnopqurstuvwxyz 
@@ -605,56 +755,379 @@ test regexp-20.2 {regsub shared object shimmering with -about} {
 test regexp-21.1 {regsub works with empty string} {
     regsub -- ^ {} foo
 } {foo}
-
 test regexp-21.2 {regsub works with empty string} {
     regsub -- \$ {} foo
 } {foo}
-
 test regexp-21.3 {regsub works with empty string offset} {
     regsub -start 0 -- ^ {} foo
 } {foo}
-
 test regexp-21.4 {regsub works with empty string offset} {
     regsub -start 0 -- \$ {} foo
 } {foo}
-
 test regexp-21.5 {regsub works with empty string offset} {
     regsub -start 3 -- \$ {123} foo
 } {123foo}
-
 test regexp-21.6 {regexp works with empty string} {
     regexp -- ^ {}
 } {1}
-
 test regexp-21.7 {regexp works with empty string} {
     regexp -start 0 -- ^ {}
 } {1}
-
 test regexp-21.8 {regexp works with empty string offset} {
     regexp -start 3 -- ^ {123}
 } {0}
-
 test regexp-21.9 {regexp works with empty string offset} {
     regexp -start 3 -- \$ {123}
 } {1}
-
 test regexp-21.10 {multiple matches handle newlines} {
     regsub -all -lineanchor -- {^#[^\n]*\n} "#one\n#two\n#three\n" foo\n
 } "foo\nfoo\nfoo\n"
-
 test regexp-21.11 {multiple matches handle newlines} {
     regsub -all -line -- ^ "a\nb\nc" \#
 } "\#a\n\#b\n\#c"
-
 test regexp-21.12 {multiple matches handle newlines} {
     regsub -all -line -- ^ "\n\n" \#
 } "\#\n\#\n\#"
-
 test regexp-21.13 {multiple matches handle newlines} {
     regexp -all -inline -indices -line -- ^ "a\nb\nc"
 } {{0 -1} {2 1} {4 3}}
+test regexp-21.14 {regsub works with empty string} {
+    regsub -- ^ {} &
+} {}
+test regexp-21.15 {regsub works with empty string} {
+    regsub -- ^ {} foo&
+} {foo}
+test regexp-21.16 {regsub works with empty string} {
+    regsub -all -- ^ {} foo&
+} {foo}
+test regexp-21.17 {regsub works with empty string} {
+    regsub -- ^ {} {foo\0}
+} {foo}
+test regexp-21.18 {regsub works with empty string} {
+    regsub -- ^.* {} {foo$0}
+} {foo$0}
+test regexp-21.19 {regsub works with empty string} {
+    regsub -- ^ {input} {}
+} {input}
+test regexp-21.20 {regsub works with empty string} {
+    regsub -- x {} {foo}
+} {}
+
+test regexp-22.1 {Bug 1810038} {
+    regexp ($|^X)* {}
+} 1
+test regexp-22.2 {regexp compile and backrefs, Bug 1857126} {
+    regexp -- {([bc])\1} bb
+} 1
+test regexp-22.3 {Bug 3604074} {
+    # This will hang in interps where the bug is not fixed
+    regexp ((((((((a)*)*)*)*)*)*)*)* a
+} 1
+test regexp-22.4 {Bug 3606139} -setup {
+    interp alias {} a {} string repeat a
+} -body {
+    # This crashes in interps where the bug is not fixed
+    regexp [join [list [a 160]([a 55])[a 668]([a 55])[a 669]([a 55]) \
+	[a 668]([a 55])[a 649]([a 55])[a 668]([a 55])[a 668]([a 55]) \
+	[a 672]([a 55])[a 669]([a 55])[a 671]([a 55])[a 671]([a 55]) \
+	[a 672]([a 55])[a 652]([a 55])[a 672]([a 55])[a 671]([a 55]) \
+	[a 671]([a 55])[a 671]([a 55])[a 653]([a 55])[a 672]([a 55]) \
+	[a 653]([a 55])[a 672]([a 55])[a 672]([a 55])[a 652]([a 55]) \
+	[a 671]([a 55])[a 652]([a 55])[a 652]([a 55])[a 672]([a 55]) \
+	[a 672]([a 55])[a 672]([a 55])[a 653]([a 55])[a 671]([a 55]) \
+	[a 669]([a 55])[a 649]([a 55])[a 668]([a 55])[a 668]([a 55]) \
+	[a 668]([a 55])[a 650]([a 55])[a 650]([a 55])[a 672]([a 55]) \
+	[a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \
+	[a 668]([a 55])[a 669]([a 55])[a 672]([a 55])[a 669]([a 55]) \
+	[a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 672]([a 55]) \
+	[a 670]([a 55])[a 671]([a 55])[a 672]([a 55])[a 672]([a 55]) \
+	[a 671]([a 55])[a 671]([a 55])[a 672]([a 55])[a 669]([a 55]) \
+	[a 668]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \
+	[a 669]([a 55])[a 668]([a 55])[a 669]([a 55])[a 669]([a 55]) \
+	[a 668]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \
+	[a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 669]([a 55]) \
+	[a 668]([a 55])[a 669]([a 55])[a 672]([a 55])[a 669]([a 55]) \
+	[a 669]([a 55])[a 669]([a 55])[a 669]([a 55])[a 668]([a 55]) \
+	[a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \
+	[a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
+	[a 672]([a 55])[a 669]([a 55])[a 669]([a 55])[a 710]([a 55]) \
+	[a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
+	[a 668]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \
+	[a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 669]([a 55]) \
+	[a 672]([a 55])[a 669]([a 55])[a 669]([a 55])[a 668]([a 55]) \
+	[a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 668]([a 55]) \
+	[a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 668]([a 55]) \
+	[a 667]([a 55])[a 668]([a 55])[a 669]([a 55])[a 668]([a 55]) \
+	[a 671]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
+	[a 669]([a 55])[a 669]([a 55])[a 668]([a 55])[a 669]([a 55]) \
+	[a 668]([a 55])[a 710]([a 55])[a 668]([a 55])[a 668]([a 55]) \
+	[a 668]([a 55])[a 668]([a 55])[a 668]([a 55])[a 511]] {}] a
+} -cleanup {
+    rename a {}
+} -returnCodes 1 -result {couldn't compile regular expression pattern: nfa has too many states}
+test regexp-22.5 {Bug 3610026} -setup {
+    set e {}
+    set cp 99
+    while {$cp < 32864} {
+	append e [format %c [incr cp]]
+    }
+} -body {
+    regexp -about $e
+} -cleanup {
+    unset -nocomplain e cp
+} -returnCodes error  -match glob -result {*too many colors*}
+test regexp-22.6 {Bug 6585b21ca8} {
+    expr {[regexp {(\w).*?\1} Programmer m] ? $m : "<NONE>"}
+} rogr
+
+
+test regexp-23.1 {regexp -all and -line} {
+    set string ""
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1}} {{0 -1}} {{0 -1}}}
+test regexp-23.2 {regexp -all and -line} {
+    set string "\n"
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1}} {{0 -1}} {{0 -1}}}
+test regexp-23.3 {regexp -all and -line} {
+    set string "\n\n"
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1} {1 0}} {{0 -1} {1 0}} {{0 -1} {1 0}}}
+test regexp-23.4 {regexp -all and -line} {
+    set string "a"
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^.*$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1}} {{0 0}} {{1 0}}}
+test regexp-23.5 {regexp -all and -line} {knownBug} {
+    set string "a\n"
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^.*$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1} {2 1}} {{0 0} {2 1}} {{1 0} {2 1}}}
+test regexp-23.6 {regexp -all and -line} {
+    set string "\na"
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^.*$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1} {1 0}} {{0 -1} {1 1}} {{0 -1} {2 1}}}
+test regexp-23.7 {regexp -all and -line} {knownBug} {
+    set string "ab\n"
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^.*$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1} {3 2}} {{0 1} {3 2}} {{2 1} {3 2}}}
+test regexp-23.8 {regexp -all and -line} {
+    set string "a\nb"
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^.*$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1} {2 1}} {{0 0} {2 2}} {{1 0} {3 2}}}
+test regexp-23.9 {regexp -all and -line} {knownBug} {
+    set string "a\nb\n"
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^.*$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1} {2 1} {4 3}} {{0 0} {2 2} {4 3}} {{1 0} {3 2} {4 3}}}
+test regexp-23.10 {regexp -all and -line} {
+    set string "a\nb\nc"
+    list \
+	[regexp -all -inline -indices -line -- {^} $string] \
+	[regexp -all -inline -indices -line -- {^.*$} $string] \
+	[regexp -all -inline -indices -line -- {$} $string]
+} {{{0 -1} {2 1} {4 3}} {{0 0} {2 2} {4 4}} {{1 0} {3 2} {5 4}}}
+test regexp-23.11 {regexp -all and -line} {
+    regexp -all -inline -indices -line -- {b} "abb\nb"
+} {{1 1} {2 2} {4 4}}
 
+test regexp-24.1 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string ""
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} {1 <> 1 <> 1 <>}
+test regexp-24.2 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "\n"
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>\n<>" 2 "<>\n<>" 2 "<>\n<>"]
+test regexp-24.3 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "\n\n"
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} [list 3 "<>\n<>\n<>" 3 "<>\n<>\n<>" 3 "<>\n<>\n<>"]
+test regexp-24.4 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a"
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} [list 1 "<>a" 1 "<a>" 1 "a<>"]
+test regexp-24.5 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a\n"
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>a\n<>" 2 "<a>\n<>" 2 "a<>\n<>"]
+test regexp-24.6 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "\na"
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>\n<>a" 2 "<>\n<a>" 2 "<>\na<>"]
+test regexp-24.7 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "ab\n"
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>ab\n<>" 2 "<ab>\n<>" 2 "ab<>\n<>"]
+test regexp-24.8 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a\nb"
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} [list 2 "<>a\n<>b" 2 "<a>\n<b>" 2 "a<>\nb<>"]
+test regexp-24.9 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a\nb\n"
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} [list 3 "<>a\n<>b\n<>" 3 "<a>\n<b>\n<>" 3 "a<>\nb<>\n<>"]
+test regexp-24.10 {regsub -all and -line} {
+    foreach {v1 v2 v3} {{} {} {}} {}
+    set string "a\nb\nc"
+    list \
+	[regsub -line -all {^} $string {<&>} v1] $v1 \
+	[regsub -line -all {^.*$} $string {<&>} v2] $v2 \
+	[regsub -line -all {$} $string {<&>} v3] $v3
+} [list 3 "<>a\n<>b\n<>c" 3 "<a>\n<b>\n<c>" 3 "a<>\nb<>\nc<>"]
+test regexp-24.11 {regsub -all and -line} {
+    regsub -line -all {b} "abb\nb" {<&>}
+} "a<b><b>\n<b>"
 
+test regexp-25.1 {regexp without -line option} {
+    set foo ""
+    list [regexp {a.*b} "dabc\naxyb\n" foo] $foo
+} [list 1 abc\naxyb]
+test regexp-25.2 {regexp without -line option} {
+    set foo ""
+    list [regexp {^a.*b$} "dabc\naxyb\n" foo] $foo
+} {0 {}}
+test regexp-25.3 {regexp with -line option} {
+    set foo ""
+    list [regexp -line {^a.*b$} "dabc\naxyb\n" foo] $foo
+} {1 axyb}
+test regexp-25.4 {regexp with -line option} {
+    set foo ""
+    list [regexp -line {^a.*b$} "dabc\naxyb\nxb" foo] $foo
+} {1 axyb}
+test regexp-25.5 {regexp without -line option} {
+    set foo ""
+    list [regexp {^a.*b$} "dabc\naxyb\nxb" foo] $foo
+} {0 {}}
+test regexp-25.6 {regexp without -line option} {
+    set foo ""
+    list [regexp {a.*b$} "dabc\naxyb\nxb" foo] $foo
+} "1 {abc\naxyb\nxb}"
+test regexp-25.7 {regexp with -lineanchor option} {
+    set foo ""
+    list [regexp -lineanchor {^a.*b$} "dabc\naxyb\nxb" foo] $foo
+} "1 {axyb\nxb}"
+test regexp-25.8 {regexp with -lineanchor and -linestop option} {
+    set foo ""
+    list [regexp -lineanchor -linestop {^a.*b$} "dabc\naxyb\nxb" foo] $foo
+} {1 axyb}
+test regexp-25.9 {regexp with -linestop option} {
+    set foo ""
+    list [regexp -linestop {a.*b} "ab\naxyb\nxb" foo] $foo
+} {1 ab}
+
+test regexp-26.1 {matches start of line 1 time} {
+    regexp -all -inline -- {^a+} "aab\naaa"
+} {aa}
+test regexp-26.2 {matches start of line(s) 2 times} {
+    regexp -all -inline -line -- {^a+} "aab\naaa"
+} {aa aaa}
+test regexp-26.3 {effect of -line -all and -start} {
+    list \
+	[regexp -all -inline -line -start 0 -- {^a+} "aab\naaa"] \
+	[regexp -all -inline -line -start 1 -- {^a+} "aab\naaa"] \
+	[regexp -all -inline -line -start 3 -- {^a+} "aab\naaa"] \
+	[regexp -all -inline -line -start 4 -- {^a+} "aab\naaa"] \
+} {{aa aaa} aaa aaa aaa}
+# No regexp-26.4
+test regexp-26.5 {match length 0, match length 1} {
+    regexp -all -inline -line -- {^b*} "a\nb"
+} {{} b}
+test regexp-26.6 {non reporting capture group} {
+    regexp -all -inline -line -- {^(?:a+|b)} "aab\naaa"
+} {aa aaa}
+test regexp-26.7 {Tcl bug 2826551: -line sensitive regexp and -start} {
+    set match1 {}
+    set match2 {}
+    list \
+	[regexp -start 0 -indices -line {^a} "\nab" match1] $match1 \
+	[regexp -start 1 -indices -line {^a} "\nab" match2] $match2
+} {1 {1 1} 1 {1 1}}
+test regexp-26.8 {Tcl bug 2826551: diff regexp with -line option} {
+    set data "@1\n2\n+3\n@4\n-5\n+6\n7\n@8\n9\n"
+    regexp -all -inline -line {^@.*\n(?:[^@].*\n?)*} $data
+} [list "@1\n2\n+3\n" "@4\n-5\n+6\n7\n" "@8\n9\n"]
+test regexp-26.9 {Tcl bug 2826551: diff regexp with embedded -line option} {
+    set data "@1\n2\n+3\n@4\n-5\n+6\n7\n@8\n9\n"
+    regexp -all -inline {(?n)^@.*\n(?:[^@].*\n?)*} $data
+} [list "@1\n2\n+3\n" "@4\n-5\n+6\n7\n" "@8\n9\n"]
+test regexp-26.10 {regexp with -line option} {
+    regexp -all -inline -line -- {a*} "a\n"
+} {a {}}
+test regexp-26.11 {regexp without -line option} {
+    regexp -all -inline -- {a*} "a\n"
+} {a {}}
+test regexp-26.12 {regexp with -line option} {
+    regexp -all -inline -line -- {a*} "b\n"
+} {{} {}}
+test regexp-26.13 {regexp without -line option} {
+    regexp -all -inline -- {a*} "b\n"
+} {{} {}}
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index a84099e..94fb90e 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -10,8 +10,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id$
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -31,7 +29,8 @@ proc evalInProc { script } {
     #return [list $status $result]
 }
 
-catch {unset foo}
+unset -nocomplain foo
+
 test regexpComp-1.1 {basic regexp operation} {
     evalInProc {
 	regexp ab*c abbbc
@@ -43,7 +42,7 @@ test regexpComp-1.2 {basic regexp operation} {
     }
 } 1
 test regexpComp-1.3 {basic regexp operation} {
-    evalInProc {    
+    evalInProc {
 	regexp ab*c ab
     }
 } 0
@@ -69,6 +68,64 @@ test regexpComp-1.7 {regexp utf compliance} {
     }
 } {0 0}
 
+test regexpComp-1.8 {regexp ***= metasyntax} {
+    evalInProc {
+	regexp -- "***=o" "aeiou"
+    }
+} 1
+test regexpComp-1.9 {regexp ***= metasyntax} {
+    evalInProc {
+	set string "aeiou"
+	regexp -- "***=o" $string
+    }
+} 1
+test regexpComp-1.10 {regexp ***= metasyntax} {
+    evalInProc {
+	set string "aeiou"
+	set re "***=o"
+	regexp -- $re $string
+    }
+} 1
+test regexpComp-1.11 {regexp ***= metasyntax} {
+    evalInProc {
+	regexp -- "***=y" "aeiou"
+    }
+} 0
+test regexpComp-1.12 {regexp ***= metasyntax} {
+    evalInProc {
+	set string "aeiou"
+	regexp -- "***=y" $string
+    }
+} 0
+test regexpComp-1.13 {regexp ***= metasyntax} {
+    evalInProc {
+	set string "aeiou"
+	set re "***=y"
+	regexp -- $re $string
+    }
+} 0
+test regexpComp-1.14 {regexp ***= metasyntax} {
+    evalInProc {
+	set string "aeiou"
+	set re "***=e*o"
+	regexp -- $re $string
+    }
+} 0
+test regexpComp-1.15 {regexp ***= metasyntax} {
+    evalInProc {
+	set string "ae*ou"
+	set re "***=e*o"
+	regexp -- $re $string
+    }
+} 1
+test regexpComp-1.16 {regexp ***= metasyntax} {
+    evalInProc {
+	set string {ae*[o]?ua}
+	set re {***=e*[o]?u}
+	regexp -- $re $string
+    }
+} 1
+
 test regexpComp-2.1 {getting substrings back from regexp} {
     evalInProc {
 	set foo {}
@@ -202,7 +259,7 @@ test regexpComp-4.4 {case conversion in regexp} {
 	list [regexp -nocase $::x $::x foo] $foo
     }
 } "1 $x"
-catch {unset ::x}
+unset -nocomplain ::x
 
 test regexpComp-5.1 {exercise cache of compiled expressions} {
     evalInProc {
@@ -259,12 +316,12 @@ test regexpComp-6.1 {regexp errors} {
     evalInProc {
 	list [catch {regexp a} msg] $msg
     }
-} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
+} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}
 test regexpComp-6.2 {regexp errors} {
     evalInProc {
 	list [catch {regexp -nocase a} msg] $msg
     }
-} {1 {wrong # args: should be "regexp ?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?"}}
+} {1 {wrong # args: should be "regexp ?-switch ...? exp string ?matchVar? ?subMatchVar ...?"}}
 test regexpComp-6.3 {regexp errors} {
     evalInProc {
 	list [catch {regexp -gorp a} msg] $msg
@@ -292,11 +349,11 @@ test regexpComp-6.7 {regexp errors} {
 } {0 0}
 test regexpComp-6.8 {regexp errors} {
     evalInProc {
-	catch {unset f1}
+	unset -nocomplain f1
 	set f1 44
 	list [catch {regexp abc abc f1(f2)} msg] $msg
     }
-} {1 {couldn't set variable "f1(f2)"}}
+} {1 {can't set "f1(f2)": variable isn't array}}
 test regexpComp-6.9 {regexp errors, -start bad int check} {
     evalInProc {
 	list [catch {regexp -start bogus {^$} {}} msg] $msg
@@ -505,22 +562,22 @@ test regexpComp-11.1 {regsub errors} {
     evalInProc {
 	list [catch {regsub a b} msg] $msg
     }
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
 test regexpComp-11.2 {regsub errors} {
     evalInProc {
 	list [catch {regsub -nocase a b} msg] $msg
     }
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
 test regexpComp-11.3 {regsub errors} {
     evalInProc {
 	list [catch {regsub -nocase -all a b} msg] $msg
     }
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
 test regexpComp-11.4 {regsub errors} {
     evalInProc {
 	list [catch {regsub a b c d e f} msg] $msg
     }
-} {1 {wrong # args: should be "regsub ?switches? exp string subSpec ?varName?"}}
+} {1 {wrong # args: should be "regsub ?-switch ...? exp string subSpec ?varName?"}}
 test regexpComp-11.5 {regsub errors} {
     evalInProc {
 	list [catch {regsub -gorp a b c} msg] $msg
@@ -533,11 +590,11 @@ test regexpComp-11.6 {regsub errors} {
 } {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
 test regexpComp-11.7 {regsub errors} {
     evalInProc {
-	catch {unset f1}
+	unset -nocomplain f1
 	set f1 44
 	list [catch {regsub -nocase aaa aaa xxx f1(f2)} msg] $msg
     }
-} {1 {couldn't set variable "f1(f2)"}}
+} {1 {can't set "f1(f2)": variable isn't array}}
 test regexpComp-11.8 {regsub errors, -start bad int check} {
     evalInProc {
 	list [catch {regsub -start bogus pattern string rep var} msg] $msg
@@ -604,23 +661,23 @@ test regexpComp-14.3 {CompileRegexp: regexp cache, empty regexp and empty cache}
 } -result 1
 
 test regexpComp-15.1 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start -10 {\d} 1abc2de3 x] $x
 } {1 1}
 test regexpComp-15.2 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 2 {\d} 1abc2de3 x] $x
 } {1 2}
 test regexpComp-15.3 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 4 {\d} 1abc2de3 x] $x
 } {1 2}
 test regexpComp-15.4 {regexp -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start 5 {\d} 1abc2de3 x] $x
 } {1 3}
 test regexpComp-15.5 {regexp -start, over end of string} {
-    catch {unset x}
+    unset -nocomplain x
     list [regexp -start [string length 1abc2de3] {\d} 1abc2de3 x] [info exists x]
 } {0 0}
 test regexpComp-15.6 {regexp -start, loss of ^$ behavior} {
@@ -628,15 +685,15 @@ test regexpComp-15.6 {regexp -start, loss of ^$ behavior} {
 } {0}
 
 test regexpComp-16.1 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start 2 {\d} a1b2c3d4e5 {/&} x] $x
 } {4 a1b/2c/3d/4e/5}
 test regexpComp-16.2 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start -25 {z} hello {/&} x] $x
 } {0 hello}
 test regexpComp-16.3 {regsub -start} {
-    catch {unset x}
+    unset -nocomplain x
     list [regsub -all -start 3 {z} hello {/&} x] $x
 } {0 hello}
 test regexpComp-16.4 {regsub -start, \A behavior} {
@@ -802,6 +859,18 @@ test regexpComp-21.11 {regexp command compiling tests} {
     }
 } {0 {}}
 
+test regexpComp-22.0.1 {Bug 1810038} {
+    evalInProc {
+	regexp ($|^X)* {}
+    }
+} 1
+
+test regexpComp-22.0.2 {regexp compile and backrefs, Bug 1857126} {
+    evalInProc {
+	regexp -- {([bc])\1} bb
+    }
+} 1
+
 set i 0
 foreach {str exp result} {
     foo		^foo		1
@@ -822,6 +891,102 @@ foreach {str exp result} {
 	     [subst {evalInProc {set a "$str"; regexp {$exp} \$a}}] $result
 }
 
+set i 0
+foreach {str exp result} {
+    foo		^foo		1
+    foobar	^foobar$	1
+    foobar	bar$		1
+    foobar	^$		0
+    ""		^$		1
+    anything	$		1
+    anything	^.*$		1
+    anything	^.*a$		0
+    anything	^.*a.*$		1
+    anything	^.*.*$		1
+    anything	^.*..*$		1
+    anything	^.*b$		0
+    anything	^a.*$		1
+} {
+    test regexpComp-23.[incr i] {regexp command compiling tests INST_REGEXP} \
+	[subst {evalInProc {set a "$str"; set re "$exp"; regexp \$re \$a}}] $result
+}
+
+test regexpComp-24.1 {regexp command compiling tests} {
+    evalInProc {
+	set re foo
+	regexp -nocase $re bar
+    }
+} 0
+test regexpComp-24.2 {regexp command compiling tests} {
+    evalInProc {
+	set re {^foo$}
+	regexp $re dogfood
+    }
+} 0
+test regexpComp-24.3 {regexp command compiling tests} {
+    evalInProc {
+	set a foo
+	set re {^foo$}
+	regexp $re $a
+    }
+} 1
+test regexpComp-24.4 {regexp command compiling tests} {
+    evalInProc {
+	set re foo
+	regexp $re dogfood
+    }
+} 1
+test regexpComp-24.5 {regexp command compiling tests} {
+    evalInProc {
+	set re FOO
+	regexp -nocase $re dogfod
+    }
+} 0
+test regexpComp-24.6 {regexp command compiling tests} {
+    evalInProc {
+	set re foo
+	regexp -n $re dogfoOd
+    }
+} 1
+test regexpComp-24.7 {regexp command compiling tests} {
+    evalInProc {
+	set re FoO
+	regexp -no -- $re dogfood
+    }
+} 1
+test regexpComp-24.8 {regexp command compiling tests} {
+    evalInProc {
+	set re foo
+	regexp -- $re dogfod
+    }
+} 0
+test regexpComp-24.9 {regexp command compiling tests} {
+    evalInProc {
+	set re "("
+	list [catch {regexp -- $re dogfod} msg] $msg
+    }
+} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
+test regexpComp-24.10 {regexp command compiling tests} {
+    # Bug 1902436 - last * escaped
+    evalInProc {
+	set text {this is *bold* !}
+	set re {\*bold\*}
+	regexp -- $re $text
+    }
+} 1
+test regexpComp-24.11 {regexp command compiling tests} {
+    # Bug 1902436 - last * escaped
+    evalInProc {
+	set text {this is *bold* !}
+	set re {\*bold\*.*!}
+	regexp -- $re $text
+    }
+} 1
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/registry.test b/tests/registry.test
index 9d475e7..77588e3 100644
--- a/tests/registry.test
+++ b/tests/registry.test
@@ -9,45 +9,56 @@
 #
 # Copyright (c) 1997 by Sun Microsystems, Inc.  All rights reserved.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# RCS: @(#) $Id: registry.test,v 1.18 2004/10/27 20:53:37 davygrvy Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-if {$tcl_platform(platform) == "windows"} {
-    if [catch {
-	# Is the registry extension already static to this shell?
-	if [catch {load {} Registry; set ::reglib {}}] {
-	    # try the location given to use on the commandline to tcltest
+testConstraint reg 0
+if {[testConstraint win]} {
+    if {![catch {
 	    ::tcltest::loadTestedCommands
-	    load $::reglib Registry
-	}
-	::tcltest::testConstraint reg 1
-    }] {
-	::tcltest::testConstraint reg 0
+	    set ::regver [package require registry 1.3.0]
+	}]} {
+	testConstraint reg 1
     }
 }
 
 # determine the current locale
-testConstraint english [expr {[llength [info commands testlocale]]
-	&& [string match "English*" [testlocale all ""]]
+testConstraint english [expr {
+    [llength [info commands testlocale]]
+    && [string match "English*" [testlocale all ""]]
 }]
-
-set hostname [info hostname]
-
+
+test registry-1.0 {check if we are testing the right dll} {win reg} {
+    set ::regver
+} {1.3.0}
 test registry-1.1 {argument parsing for registry command} {win reg} {
     list [catch {registry} msg] $msg
-} {1 {wrong # args: should be "registry option ?arg arg ...?"}}
+} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
+test registry-1.1a {argument parsing for registry command} {win reg} {
+    list [catch {registry -32bit} msg] $msg
+} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
+test registry-1.1b {argument parsing for registry command} {win reg} {
+    list [catch {registry -64bit} msg] $msg
+} {1 {wrong # args: should be "registry ?-32bit|-64bit? option ?arg ...?"}}
 test registry-1.2 {argument parsing for registry command} {win reg} {
     list [catch {registry foo} msg] $msg
 } {1 {bad option "foo": must be broadcast, delete, get, keys, set, type, or values}}
+test registry-1.2a {argument parsing for registry command} {win reg} {
+    list [catch {registry -33bit foo} msg] $msg
+} {1 {bad mode "-33bit": must be -32bit or -64bit}}
 
 test registry-1.3 {argument parsing for registry command} {win reg} {
     list [catch {registry d} msg] $msg
 } {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
+test registry-1.3a {argument parsing for registry command} {win reg} {
+    list [catch {registry -32bit d} msg] $msg
+} {1 {wrong # args: should be "registry -32bit delete keyName ?valueName?"}}
+test registry-1.3b {argument parsing for registry command} {win reg} {
+    list [catch {registry -64bit d} msg] $msg
+} {1 {wrong # args: should be "registry -64bit delete keyName ?valueName?"}}
 test registry-1.4 {argument parsing for registry command} {win reg} {
     list [catch {registry delete} msg] $msg
 } {1 {wrong # args: should be "registry delete keyName ?valueName?"}}
@@ -58,6 +69,12 @@ test registry-1.5 {argument parsing for registry command} {win reg} {
 test registry-1.6 {argument parsing for registry command} {win reg} {
     list [catch {registry g} msg] $msg
 } {1 {wrong # args: should be "registry get keyName valueName"}}
+test registry-1.6a {argument parsing for registry command} {win reg} {
+    list [catch {registry -32bit g} msg] $msg
+} {1 {wrong # args: should be "registry -32bit get keyName valueName"}}
+test registry-1.6b {argument parsing for registry command} {win reg} {
+    list [catch {registry -64bit g} msg] $msg
+} {1 {wrong # args: should be "registry -64bit get keyName valueName"}}
 test registry-1.7 {argument parsing for registry command} {win reg} {
     list [catch {registry get} msg] $msg
 } {1 {wrong # args: should be "registry get keyName valueName"}}
@@ -71,6 +88,12 @@ test registry-1.9 {argument parsing for registry command} {win reg} {
 test registry-1.10 {argument parsing for registry command} {win reg} {
     list [catch {registry k} msg] $msg
 } {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
+test registry-1.10a {argument parsing for registry command} {win reg} {
+    list [catch {registry -32bit k} msg] $msg
+} {1 {wrong # args: should be "registry -32bit keys keyName ?pattern?"}}
+test registry-1.10b {argument parsing for registry command} {win reg} {
+    list [catch {registry -64bit k} msg] $msg
+} {1 {wrong # args: should be "registry -64bit keys keyName ?pattern?"}}
 test registry-1.11 {argument parsing for registry command} {win reg} {
     list [catch {registry keys} msg] $msg
 } {1 {wrong # args: should be "registry keys keyName ?pattern?"}}
@@ -81,6 +104,12 @@ test registry-1.12 {argument parsing for registry command} {win reg} {
 test registry-1.13 {argument parsing for registry command} {win reg} {
     list [catch {registry s} msg] $msg
 } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
+test registry-1.13a {argument parsing for registry command} {win reg} {
+    list [catch {registry -32bit s} msg] $msg
+} {1 {wrong # args: should be "registry -32bit set keyName ?valueName data ?type??"}}
+test registry-1.13b {argument parsing for registry command} {win reg} {
+    list [catch {registry -64bit s} msg] $msg
+} {1 {wrong # args: should be "registry -64bit set keyName ?valueName data ?type??"}}
 test registry-1.14 {argument parsing for registry command} {win reg} {
     list [catch {registry set} msg] $msg
 } {1 {wrong # args: should be "registry set keyName ?valueName data ?type??"}}
@@ -94,6 +123,12 @@ test registry-1.16 {argument parsing for registry command} {win reg} {
 test registry-1.17 {argument parsing for registry command} {win reg} {
     list [catch {registry t} msg] $msg
 } {1 {wrong # args: should be "registry type keyName valueName"}}
+test registry-1.17a {argument parsing for registry command} {win reg} {
+    list [catch {registry -32bit t} msg] $msg
+} {1 {wrong # args: should be "registry -32bit type keyName valueName"}}
+test registry-1.17b {argument parsing for registry command} {win reg} {
+    list [catch {registry -64bit t} msg] $msg
+} {1 {wrong # args: should be "registry -64bit type keyName valueName"}}
 test registry-1.18 {argument parsing for registry command} {win reg} {
     list [catch {registry type} msg] $msg
 } {1 {wrong # args: should be "registry type keyName valueName"}}
@@ -107,6 +142,12 @@ test registry-1.20 {argument parsing for registry command} {win reg} {
 test registry-1.21 {argument parsing for registry command} {win reg} {
     list [catch {registry v} msg] $msg
 } {1 {wrong # args: should be "registry values keyName ?pattern?"}}
+test registry-1.21a {argument parsing for registry command} {win reg} {
+    list [catch {registry -32bit v} msg] $msg
+} {1 {wrong # args: should be "registry -32bit values keyName ?pattern?"}}
+test registry-1.21b {argument parsing for registry command} {win reg} {
+    list [catch {registry -64bit v} msg] $msg
+} {1 {wrong # args: should be "registry -64bit values keyName ?pattern?"}}
 test registry-1.22 {argument parsing for registry command} {win reg} {
     list [catch {registry values} msg] $msg
 } {1 {wrong # args: should be "registry values keyName ?pattern?"}}
@@ -124,480 +165,527 @@ test registry-2.3 {DeleteKey: bad key} {win reg} {
     list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg
 } {1 {bad key: cannot delete root keys}}
 test registry-2.4 {DeleteKey: subkey at root level} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry keys HKEY_CLASSES_ROOT TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry keys HKEY_CURRENT_USER TclFoobar
 } {}
 test registry-2.5 {DeleteKey: subkey below root level} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar\\test
-    set result [registry keys HKEY_CLASSES_ROOT TclFoobar\\test]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\test
+    registry delete HKEY_CURRENT_USER\\TclFoobar\\test
+    set result [registry keys HKEY_CURRENT_USER TclFoobar\\test]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } {}
 test registry-2.6 {DeleteKey: recursive delete} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test1
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test3
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    set result [registry keys HKEY_CLASSES_ROOT TclFoobar]
+    registry set HKEY_CURRENT_USER\\TclFoobar\\test1
+    registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    set result [registry keys HKEY_CURRENT_USER TclFoobar]
     set result
 } {}
 test registry-2.7 {DeleteKey: trailing backslashes} {win reg english} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz
-    list [catch {registry delete HKEY_CLASSES_ROOT\\TclFoobar\\} msg] $msg
+    registry set HKEY_CURRENT_USER\\TclFoobar\\baz
+    list [catch {registry delete HKEY_CURRENT_USER\\TclFoobar\\} msg] $msg
 } {1 {unable to delete key: The configuration registry key is invalid.}}
 test registry-2.8 {DeleteKey: failure} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
 } {}
 test registry-2.9 {DeleteKey: unicode} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test\u00c7bar\\a
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test\u00c7bar\\b
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar\\test\u00c7bar
-    set result [registry keys HKEY_CLASSES_ROOT\\TclFoobar]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\test\u00c7bar\\a
+    registry set HKEY_CURRENT_USER\\TclFoobar\\test\u00c7bar\\b
+    registry delete HKEY_CURRENT_USER\\TclFoobar\\test\u00c7bar
+    set result [registry keys HKEY_CURRENT_USER\\TclFoobar]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } {}
 
 test registry-3.1 {DeleteValue} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz test1 blort
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz test2 blat
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar\\baz test1
-    set result [registry values HKEY_CLASSES_ROOT\\TclFoobar\\baz]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\baz test1 blort
+    registry set HKEY_CURRENT_USER\\TclFoobar\\baz test2 blat
+    registry delete HKEY_CURRENT_USER\\TclFoobar\\baz test1
+    set result [registry values HKEY_CURRENT_USER\\TclFoobar\\baz]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } test2
 test registry-3.2 {DeleteValue: bad key} {win reg english} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    list [catch {registry delete HKEY_CLASSES_ROOT\\TclFoobar test} msg] $msg
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    list [catch {registry delete HKEY_CURRENT_USER\\TclFoobar test} msg] $msg
 } {1 {unable to open key: The system cannot find the file specified.}}
 test registry-3.3 {DeleteValue: bad value} {win reg english} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz test2 blort
-    set result [list [catch {registry delete HKEY_CLASSES_ROOT\\TclFoobar test1} msg] $msg]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\baz test2 blort
+    set result [list [catch {registry delete HKEY_CURRENT_USER\\TclFoobar test1} msg] $msg]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
-} {1 {unable to delete value "test1" from key "HKEY_CLASSES_ROOT\TclFoobar": The system cannot find the file specified.}}
+} {1 {unable to delete value "test1" from key "HKEY_CURRENT_USER\TclFoobar": The system cannot find the file specified.}}
 test registry-3.4 {DeleteValue: Unicode} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\\u00c7baz \u00c7test1 blort
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\\u00c7baz test2 blat
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar\\\u00c7baz \u00c7test1
-    set result [registry values HKEY_CLASSES_ROOT\\TclFoobar\\\u00c7baz]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz \u00c7test1 blort
+    registry set HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz test2 blat
+    registry delete HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz \u00c7test1
+    set result [registry values HKEY_CURRENT_USER\\TclFoobar\\\u00c7baz]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } test2
 
 test registry-4.1 {GetKeyNames: bad key} {win reg english} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    list [catch {registry keys HKEY_CLASSES_ROOT\\TclFoobar} msg] $msg
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    list [catch {registry keys HKEY_CURRENT_USER\\TclFoobar} msg] $msg
 } {1 {unable to open key: The system cannot find the file specified.}}
 test registry-4.2 {GetKeyNames} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz
-    set result [registry keys HKEY_CLASSES_ROOT\\TclFoobar]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\baz
+    set result [registry keys HKEY_CURRENT_USER\\TclFoobar]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } {baz}
 test registry-4.3 {GetKeyNames: remote key} {win reg nonPortable english} {
-    registry set \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar\\baz
-    set result [registry keys \\\\gaspode\\HKEY_CLASSES_ROOT\\TclFoobar]
-    registry delete \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar
+    set hostname [info hostname]
+    registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar\\baz
+    set result [registry keys \\\\gaspode\\HKEY_CURRENT_USER\\TclFoobar]
+    registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar
     set result
 } {baz}
 test registry-4.4 {GetKeyNames: empty key} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar
-    set result [registry keys HKEY_CLASSES_ROOT\\TclFoobar]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar
+    set result [registry keys HKEY_CURRENT_USER\\TclFoobar]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } {}
 test registry-4.5 {GetKeyNames: patterns} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo
-    set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\baz
+    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
+    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
+    set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } {baz blat}
 test registry-4.6 {GetKeyNames: names with spaces} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz\ bar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo
-    set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\ bar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
+    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
+    set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } {{baz bar} blat}
 test registry-4.7 {GetKeyNames: Unicode} {win reg english} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz\u00c7bar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo
-    set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u00c7bar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
+    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
+    set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } "baz\u00c7bar blat"
 test registry-4.8 {GetKeyNames: Unicode} {win reg nt} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz\u30b7bar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\blat
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\foo
-    set result [lsort [registry keys HKEY_CLASSES_ROOT\\TclFoobar b*]]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\baz\u30b7bar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\blat
+    registry set HKEY_CURRENT_USER\\TclFoobar\\foo
+    set result [lsort [registry keys HKEY_CURRENT_USER\\TclFoobar b*]]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } "baz\u30b7bar blat"
+test registry-4.9 {GetKeyNames: very long key [Bug 1682211]} {*}{
+    -constraints {win reg}
+    -setup {
+	registry set HKEY_CURRENT_USER\\TclFoobar\\a
+	registry set HKEY_CURRENT_USER\\TclFoobar\\b[string repeat x 254]
+	registry set HKEY_CURRENT_USER\\TclFoobar\\c
+    }
+    -body {
+	lsort [registry keys HKEY_CURRENT_USER\\TclFoobar]
+    }
+    -cleanup {
+	registry delete HKEY_CURRENT_USER\\TclFoobar
+    }} \
+    -result [list a b[string repeat x 254] c]
 
 test registry-5.1 {GetType} {win reg english} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    list [catch {registry type HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    list [catch {registry type HKEY_CURRENT_USER\\TclFoobar val1} msg] $msg
 } {1 {unable to open key: The system cannot find the file specified.}}
 test registry-5.2 {GetType} {win reg english} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar
-    list [catch {registry type HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
-} {1 {unable to get type of value "val1" from key "HKEY_CLASSES_ROOT\TclFoobar": The system cannot find the file specified.}}
+    registry set HKEY_CURRENT_USER\\TclFoobar
+    list [catch {registry type HKEY_CURRENT_USER\\TclFoobar val1} msg] $msg
+} {1 {unable to get type of value "val1" from key "HKEY_CURRENT_USER\TclFoobar": The system cannot find the file specified.}}
 test registry-5.3 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar none
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar none
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } none
 test registry-5.4 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } sz
 test registry-5.5 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar sz
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar sz
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } sz
 test registry-5.6 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar expand_sz
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar expand_sz
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } expand_sz
 test registry-5.7 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 binary
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 binary
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } binary
 test registry-5.8 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 dword
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 dword
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } dword
 test registry-5.9 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 dword_big_endian
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 dword_big_endian
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } dword_big_endian
 test registry-5.10 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 link
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 link
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } link
 test registry-5.11 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar multi_sz
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar multi_sz
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } multi_sz
 test registry-5.12 {GetType} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 resource_list
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 resource_list
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } resource_list
 test registry-5.13 {GetType: unknown types} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 24
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 24
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } 24
 test registry-5.14 {GetType: Unicode} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar va\u00c7l1 1 24
-    set result [registry type HKEY_CLASSES_ROOT\\TclFoobar va\u00c7l1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar va\u00c7l1 1 24
+    set result [registry type HKEY_CURRENT_USER\\TclFoobar va\u00c7l1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } 24
 
 test registry-6.1 {GetValue} {win reg english} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    list [catch {registry get HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    list [catch {registry get HKEY_CURRENT_USER\\TclFoobar val1} msg] $msg
 } {1 {unable to open key: The system cannot find the file specified.}}
 test registry-6.2 {GetValue} {win reg english} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar
-    list [catch {registry get HKEY_CLASSES_ROOT\\TclFoobar val1} msg] $msg
-} {1 {unable to get value "val1" from key "HKEY_CLASSES_ROOT\TclFoobar": The system cannot find the file specified.}}
+    registry set HKEY_CURRENT_USER\\TclFoobar
+    list [catch {registry get HKEY_CURRENT_USER\\TclFoobar val1} msg] $msg
+} {1 {unable to get value "val1" from key "HKEY_CURRENT_USER\TclFoobar": The system cannot find the file specified.}}
 test registry-6.3 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar none
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar none
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } foobar
 test registry-6.4 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } foobar
 test registry-6.5 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } foobar
 test registry-6.6 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar expand_sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar expand_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } foobar
 test registry-6.7 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 binary
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 binary
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } 1
 test registry-6.8 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 0x20 dword
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 0x20 dword
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } 32
 test registry-6.9 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 0x20 dword_big_endian
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 0x20 dword_big_endian
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } 32
 test registry-6.10 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 link
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 link
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } 1
 test registry-6.11 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 foobar multi_sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 foobar multi_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } foobar
 test registry-6.12 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {foo\ bar baz} multi_sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo\ bar baz} multi_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } {{foo bar} baz}
 test registry-6.13 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {} multi_sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 {} multi_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } {}
 test registry-6.14 {GetValue: truncation of multivalues with null elements} \
 	{win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {a {} b} multi_sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 {a {} b} multi_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } a
 test registry-6.15 {GetValue} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 resource_list
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 resource_list
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } 1
 test registry-6.16 {GetValue: unknown types} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 1 24
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 1 24
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } 1
 test registry-6.17 {GetValue: Unicode value names} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val\u00c71 foobar multi_sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val\u00c71]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val\u00c71 foobar multi_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val\u00c71]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } foobar
 test registry-6.18 {GetValue: values with Unicode strings} {win reg nt} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u30b7r baz} multi_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } "foo ba\u30b7r baz"
 test registry-6.19 {GetValue: values with Unicode strings} {win reg english} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u00c7r baz} multi_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } "foo ba\u00c7r baz"
 test registry-6.20 {GetValue: values with Unicode strings with embedded nulls} {win reg} {
-    registry set HKEY_CLASSES_ROOT\\TclFoobar val1 {foo ba\u0000r baz} multi_sz
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar val1]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar val1 {foo ba\u0000r baz} multi_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar val1]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
 } "foo ba r baz"
-
-test registry-7.1 {GetValueNames: bad key} {win reg english} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    list [catch {registry values HKEY_CLASSES_ROOT\\TclFoobar} msg] $msg
-} {1 {unable to open key: The system cannot find the file specified.}}
-test registry-7.2 {GetValueNames} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar baz foobar
-    set result [registry values HKEY_CLASSES_ROOT\\TclFoobar]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    set result
-} baz
-test registry-7.3 {GetValueNames} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar baz foobar1
-    registry set HKEY_CLASSES_ROOT\\TclFoobar blat foobar2
-    registry set HKEY_CLASSES_ROOT\\TclFoobar {} foobar3
-    set result [lsort [registry values HKEY_CLASSES_ROOT\\TclFoobar]]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    set result
-} {{} baz blat}
-test registry-7.4 {GetValueNames: remote key} {win reg nonPortable english} {
-    registry set \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar baz blat
-    set result [registry values \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar]
-    registry delete \\\\$hostname\\HKEY_CLASSES_ROOT\\TclFoobar
-    set result
-} baz
-test registry-7.5 {GetValueNames: empty key} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar
-    set result [registry values HKEY_CLASSES_ROOT\\TclFoobar]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    set result
-} {}
-test registry-7.6 {GetValueNames: patterns} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar baz foobar1
-    registry set HKEY_CLASSES_ROOT\\TclFoobar blat foobar2
-    registry set HKEY_CLASSES_ROOT\\TclFoobar foo foobar3
-    set result [lsort [registry values HKEY_CLASSES_ROOT\\TclFoobar b*]]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    set result
-} {baz blat}
-test registry-7.7 {GetValueNames: names with spaces} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar baz\ bar foobar1
-    registry set HKEY_CLASSES_ROOT\\TclFoobar blat foobar2
-    registry set HKEY_CLASSES_ROOT\\TclFoobar foo foobar3
-    set result [lsort [registry values HKEY_CLASSES_ROOT\\TclFoobar b*]]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
+test registry-6.21 {GetValue: very long value names and values} {pcOnly reg} {
+    registry set HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383] [string repeat x 16383] multi_sz
+    set result [registry get HKEY_CURRENT_USER\\TclFoobar [string repeat k 16383]]
+    registry delete HKEY_CURRENT_USER\\TclFoobar
     set result
-} {{baz bar} blat}
+} [string repeat x 16383]
 
-test registry-8.1 {OpenSubKey} {win reg nonPortable english} {
-    # This test will only succeed if the current user does not have registry
-    # access on the specified machine.
-    list [catch {registry keys {\\mom\HKEY_LOCAL_MACHINE}} msg] $msg
-} {1 {unable to open key: Access is denied.}}
-test registry-8.2 {OpenSubKey} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar
-    set result [registry keys HKEY_CLASSES_ROOT TclFoobar]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    set result
-} TclFoobar
-test registry-8.3 {OpenSubKey} {win reg english} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    list [catch {registry keys HKEY_CLASSES_ROOT\\TclFoobar} msg] $msg
-} {1 {unable to open key: The system cannot find the file specified.}}
+test registry-7.1 {GetValueNames: bad key} -constraints {win reg english} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -body {
+    registry values HKEY_CURRENT_USER\\TclFoobar
+} -returnCodes error -result {unable to open key: The system cannot find the file specified.}
+test registry-7.2 {GetValueNames} -constraints {win reg} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar baz foobar
+} -body {
+    registry values HKEY_CURRENT_USER\\TclFoobar
+} -cleanup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -result baz
+test registry-7.3 {GetValueNames} -constraints {win reg} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1
+    registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2
+    registry set HKEY_CURRENT_USER\\TclFoobar {} foobar3
+} -body {
+    lsort [registry values HKEY_CURRENT_USER\\TclFoobar]
+} -cleanup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -result {{} baz blat}
+test registry-7.4 {GetValueNames: remote key} -constraints {win reg nonPortable english} -body {
+    set hostname [info hostname]
+    registry set \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar baz blat
+    set result [registry values \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar]
+    registry delete \\\\$hostname\\HKEY_CURRENT_USER\\TclFoobar
+    set result
+} -result baz
+test registry-7.5 {GetValueNames: empty key} -constraints {win reg} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar
+} -body {
+    registry values HKEY_CURRENT_USER\\TclFoobar
+} -cleanup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -result {}
+test registry-7.6 {GetValueNames: patterns} -constraints {win reg} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar baz foobar1
+    registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2
+    registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3
+} -body {
+    lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]
+} -cleanup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -result {baz blat}
+test registry-7.7 {GetValueNames: names with spaces} -constraints {win reg} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar baz\ bar foobar1
+    registry set HKEY_CURRENT_USER\\TclFoobar blat foobar2
+    registry set HKEY_CURRENT_USER\\TclFoobar foo foobar3
+} -body {
+    lsort [registry values HKEY_CURRENT_USER\\TclFoobar b*]
+} -cleanup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -result {{baz bar} blat}
 
-test registry-9.1 {ParseKeyName: bad keys} {win reg} {
-    list [catch {registry values \\} msg] $msg
-} "1 {bad key \"\\\": must start with a valid root}"
-test registry-9.2 {ParseKeyName: bad keys} {win reg} {
-    list [catch {registry values \\foobar} msg] $msg
-} {1 {bad key "\foobar": must start with a valid root}}
-test registry-9.3 {ParseKeyName: bad keys} {win reg} {
-    list [catch {registry values \\\\} msg] $msg
-} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
-test registry-9.4 {ParseKeyName: bad keys} {win reg} {
-    list [catch {registry values \\\\\\} msg] $msg
-} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
-test registry-9.5 {ParseKeyName: bad keys} {win reg english nt} {
-    list [catch {registry values \\\\\\HKEY_CLASSES_ROOT} msg] $msg
-} {1 {unable to open key: The network address is invalid.}}
-test registry-9.6 {ParseKeyName: bad keys} {win reg} {
-    list [catch {registry values \\\\gaspode} msg] $msg
-} {1 {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
-test registry-9.7 {ParseKeyName: bad keys} {win reg} {
-    list [catch {registry values foobar} msg] $msg
-} {1 {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}}
-test registry-9.8 {ParseKeyName: null keys} {win reg} {
-    list [catch {registry delete HKEY_CLASSES_ROOT\\} msg] $msg
-} {1 {bad key: cannot delete root keys}}
-test registry-9.9 {ParseKeyName: null keys} {win reg english} {
-    list [catch {registry keys HKEY_CLASSES_ROOT\\TclFoobar\\baz} msg] $msg
-} {1 {unable to open key: The system cannot find the file specified.}}
+test registry-8.1 {OpenSubKey} -constraints {win reg nonPortable english} \
+    -body {
+        # This test will only succeed if the current user does not have
+        # registry access on the specified machine.
+        registry keys {\\mom\HKEY_LOCAL_MACHINE}
+    } -returnCodes error -result "unable to open key: Access is denied."
+test registry-8.2 {OpenSubKey} -constraints {win reg} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar
+} -body {
+    registry keys HKEY_CURRENT_USER TclFoobar
+} -cleanup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -result {TclFoobar}
+test registry-8.3 {OpenSubKey} -constraints {win reg english} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -body {
+    registry keys HKEY_CURRENT_USER\\TclFoobar
+} -returnCodes error \
+    -result "unable to open key: The system cannot find the file specified."
 
-test registry-10.1 {RecursiveDeleteKey} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test1
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test3
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    set result [registry keys HKEY_CLASSES_ROOT TclFoobar]
-    set result
-} {}
-test registry-10.2 {RecursiveDeleteKey} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test1
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test3
-    set result [registry delete HKEY_CLASSES_ROOT\\TclFoobar\\test2\\test4]
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    set result
-} {}
+test registry-9.1 {ParseKeyName: bad keys} -constraints {win reg} -body {
+    registry values \\
+} -returnCodes error -result "bad key \"\\\": must start with a valid root"
+test registry-9.2 {ParseKeyName: bad keys} -constraints {win reg} -body {
+    registry values \\foobar
+} -returnCodes error -result {bad key "\foobar": must start with a valid root}
+test registry-9.3 {ParseKeyName: bad keys} -constraints {win reg} -body {
+    registry values \\\\
+} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
+test registry-9.4 {ParseKeyName: bad keys} -constraints {win reg} -body {
+    registry values \\\\\\
+} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
+test registry-9.5 {ParseKeyName: bad keys} -constraints {win reg english nt} -body {
+    registry values \\\\\\HKEY_CLASSES_ROOT
+} -returnCodes error -result {unable to open key: The network address is invalid.}
+test registry-9.6 {ParseKeyName: bad keys} -constraints {win reg} -body {
+    registry values \\\\gaspode
+} -returnCodes error -result {bad root name "": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
+test registry-9.7 {ParseKeyName: bad keys} -constraints {win reg} -body {
+    registry values foobar
+} -returnCodes error -result {bad root name "foobar": must be HKEY_LOCAL_MACHINE, HKEY_USERS, HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_CURRENT_CONFIG, HKEY_PERFORMANCE_DATA, or HKEY_DYN_DATA}
+test registry-9.8 {ParseKeyName: null keys} -constraints {win reg} -body {
+    registry delete HKEY_CLASSES_ROOT\\
+} -returnCodes error -result {bad key: cannot delete root keys}
+test registry-9.9 {ParseKeyName: null keys} \
+    -constraints {win reg english} \
+    -body {registry keys HKEY_CLASSES_ROOT\\TclFoobar\\baz} \
+    -returnCodes error \
+    -result {unable to open key: The system cannot find the file specified.}
 
-test registry-11.1 {SetValue: recursive creation} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz blat foobar
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar\\baz blat]
-} foobar
-test registry-11.2 {SetValue: modification} {win reg} {
-    registry delete HKEY_CLASSES_ROOT\\TclFoobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz blat foobar
-    registry set HKEY_CLASSES_ROOT\\TclFoobar\\baz blat frob
-    set result [registry get HKEY_CLASSES_ROOT\\TclFoobar\\baz blat]
-} frob
-test registry-11.3 {SetValue: failure} {win reg nonPortable english} {
-    # This test will only succeed if the current user does not have registry
-    # access on the specified machine.
-    list [catch {registry set {\\mom\HKEY_CLASSES_ROOT\TclFoobar} bar foobar} msg] $msg
-} {1 {unable to open key: Access is denied.}}
+test registry-10.1 {RecursiveDeleteKey} -constraints {win reg} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -body {
+    registry set HKEY_CURRENT_USER\\TclFoobar\\test1
+    registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    set result [registry keys HKEY_CURRENT_USER TclFoobar]
+    set result
+} -result {}
+test registry-10.2 {RecursiveDeleteKey} -constraints {win reg} -setup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+    registry set HKEY_CURRENT_USER\\TclFoobar\\test1
+    registry set HKEY_CURRENT_USER\\TclFoobar\\test2\\test3
+} -body {
+    registry delete HKEY_CURRENT_USER\\TclFoobar\\test2\\test4
+} -cleanup {
+    registry delete HKEY_CURRENT_USER\\TclFoobar
+} -result {}
 
-test registry-12.1 {BroadcastValue} {win reg} {
-    list [catch {registry broadcast} msg] $msg
-} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}}
-test registry-12.2 {BroadcastValue} {win reg} {
-    list [catch {registry broadcast "" -time} msg] $msg
-} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}}
-test registry-12.3 {BroadcastValue} {win reg} {
-    list [catch {registry broadcast "" - 500} msg] $msg
-} {1 {wrong # args: should be "registry broadcast keyName ?-timeout millisecs?"}}
-test registry-12.4 {BroadcastValue} {win reg} {
-    list [catch {registry broadcast {Environment}} msg] $msg
-} {0 {1 0}}
-test registry-12.5 {BroadcastValue} {win reg} {
-    list [catch {registry b {}} msg] $msg
-} {0 {1 0}}
+test registry-11.1 {SetValue: recursive creation} \
+    -constraints {win reg} -setup {
+        registry delete HKEY_CURRENT_USER\\TclFoobar
+    } -body {
+        registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar
+        set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat]
+    } -result {foobar}
+test registry-11.2 {SetValue: modification} -constraints {win reg} \
+    -setup {
+        registry delete HKEY_CURRENT_USER\\TclFoobar
+    } -body {
+        registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat foobar
+        registry set HKEY_CURRENT_USER\\TclFoobar\\baz blat frob
+        set result [registry get HKEY_CURRENT_USER\\TclFoobar\\baz blat]
+    } -result {frob}
+test registry-11.3 {SetValue: failure} \
+    -constraints {win reg nonPortable english} \
+    -body {
+        # This test will only succeed if the current user does not have
+        # registry access on the specified machine.
+        registry set {\\mom\HKEY_CURRENT_USER\TclFoobar} bar foobar
+    } -returnCodes error -result {unable to open key: Access is denied.}
 
+test registry-12.1 {BroadcastValue} -constraints {win reg} -body {
+    registry broadcast
+} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
+test registry-12.2 {BroadcastValue} -constraints {win reg} -body {
+    registry broadcast "" -time
+} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
+test registry-12.3 {BroadcastValue} -constraints {win reg} -body {
+    registry broadcast "" - 500
+} -returnCodes error -result "wrong # args: should be \"registry broadcast keyName ?-timeout milliseconds?\""
+test registry-12.4 {BroadcastValue} -constraints {win reg} -body {
+    registry broadcast {Environment}
+} -result {1 0}
+test registry-12.5 {BroadcastValue} -constraints {win reg} -body {
+    registry b {}
+} -result {1 0}
+
 # cleanup
-unset hostname
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# tcl-indent-level: 4
+# fill-column: 78
+# End:
diff --git a/tests/remote.tcl b/tests/remote.tcl
index 005f2df..097e41f 100644
--- a/tests/remote.tcl
+++ b/tests/remote.tcl
@@ -8,8 +8,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: remote.tcl,v 1.3 1999/04/16 00:47:33 stanton Exp $
 
 # Initialize message delimitor
 
@@ -32,11 +30,9 @@ proc __doCommands__ {l s} {
 	puts "---"
     }
     set callerSocket $s
-    if {[catch {uplevel #0 $l} msg]} {
-	list error $msg
-    } else {
-	list success $msg
-    }
+    set ::errorInfo ""
+    set code [catch {uplevel "#0" $l} msg]
+    return [list $code $::errorInfo $msg]
 }
 
 proc __readAndExecute__ {s} {
@@ -44,10 +40,9 @@ proc __readAndExecute__ {s} {
 
     set l [gets $s]
     if {[string compare $l "--Marker--Marker--Marker--"] == 0} {
-	if {[info exists command($s)]} {
-	    puts $s [list error incomplete_command]
-	}
+        puts $s [__doCommands__ $command($s) $s]
 	puts $s "--Marker--Marker--Marker--"
+        set command($s) ""
 	return
     }
     if {[string compare $l ""] == 0} {
@@ -59,28 +54,26 @@ proc __readAndExecute__ {s} {
 	}
 	return
     }
-    append command($s) $l "\n"
-    if {[info complete $command($s)]} {
-	set cmds $command($s)
-	unset command($s)
-	puts $s [__doCommands__ $cmds $s]
-    }
     if {[eof $s]} {
 	if {$VERBOSE} {
 	    puts "Server closing $s, eof from client"
 	}
 	close $s
+        unset command($s)
+        return
     }
+    append command($s) $l "\n"
 }
 
 proc __accept__ {s a p} {
-    global VERBOSE
+    global command VERBOSE
 
     if {$VERBOSE} {
 	puts "Server accepts new connection from $a:$p on $s"
     }
-    fileevent $s readable [list __readAndExecute__ $s]
+    set command($s) ""
     fconfigure $s -buffering line -translation crlf
+    fileevent $s readable [list __readAndExecute__ $s]
 }
 
 set serverIsSilent 0
@@ -153,20 +146,14 @@ if {$serverIsSilent == 0} {
     flush stdout
 }
 
+proc getPort sock {
+    lindex [fconfigure $sock -sockname] 2
+}
+
 if {[catch {set serverSocket \
 	[socket -myaddr $serverAddress -server __accept__ $serverPort]} msg]} {
     puts "Server on $serverAddress:$serverPort cannot start: $msg"
 } else {
+    puts ready
     vwait __server_wait_variable__
 }
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/rename.test b/tests/rename.test
index 45d6847..ebf5425 100644
--- a/tests/rename.test
+++ b/tests/rename.test
@@ -1,34 +1,35 @@
 # Commands covered:  rename
 #
-# 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.
-#
-# RCS: @(#) $Id: rename.test,v 1.12 2004/05/19 20:15:32 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-testConstraint testdel [llength [info commands testdel]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
-# Must eliminate the "unknown" command while the test is running,
-# especially if the test is being run in a program with its
-# own special-purpose unknown command.
+testConstraint testdel [llength [info commands testdel]]
 
+# Must eliminate the "unknown" command while the test is running, especially
+# if the test is being run in a program with its own special-purpose unknown
+# command.
 catch {rename unknown unknown.old}
-
+
 catch {rename r2 {}}
 proc r1 {} {return "procedure r1"}
 rename r1 r2
+
 test rename-1.1 {simple renaming} {
     r2
 } {procedure r1}
@@ -40,10 +41,9 @@ test rename-1.3 {simple renaming} {
     list [catch r2 msg] $msg
 } {1 {invalid command name "r2"}}
 
-# The test below is tricky because it renames a built-in command.
-# It's possible that the test procedure uses this command, so must
-# restore the command before calling test again.
-
+# The test below is tricky because it renames a built-in command. It's
+# possible that the test procedure uses this command, so must restore the
+# command before calling test again.
 rename list l.new
 set a [catch list msg1]
 set b [l.new a b c]
@@ -56,24 +56,27 @@ test rename-2.1 {renaming built-in command} {
 
 test rename-3.1 {error conditions} {
     list [catch {rename r1} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
+} {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}}
 test rename-3.2 {error conditions} {
     list [catch {rename r1 r2 r3} msg] $msg $errorCode
-} {1 {wrong # args: should be "rename oldName newName"} NONE}
-test rename-3.3 {error conditions} {
+} {1 {wrong # args: should be "rename oldName newName"} {TCL WRONGARGS}}
+test rename-3.3 {error conditions} -setup {
     proc r1 {} {}
     proc r2 {} {}
-    list [catch {rename r1 r2} msg] $msg
-} {1 {can't rename to "r2": command already exists}}
-test rename-3.4 {error conditions} {
+} -returnCodes error -body {
+    rename r1 r2
+} -result {can't rename to "r2": command already exists}
+test rename-3.4 {error conditions} -setup {
     catch {rename r1 {}}
     catch {rename r2 {}}
-    list [catch {rename r1 r2} msg] $msg
-} {1 {can't rename "r1": command doesn't exist}}
-test rename-3.5 {error conditions} {
+} -returnCodes error -body {
+    rename r1 r2
+} -result {can't rename "r1": command doesn't exist}
+test rename-3.5 {error conditions} -setup {
     catch {rename _non_existent_command {}}
-    list [catch {rename _non_existent_command {}} msg] $msg
-} {1 {can't delete "_non_existent_command": command doesn't exist}}
+} -returnCodes error -body {
+    rename _non_existent_command {}
+} -result {can't delete "_non_existent_command": command doesn't exist}
 
 catch {rename unknown {}}
 catch {rename unknown.old unknown}
@@ -137,16 +140,21 @@ test rename-4.7 {reentrancy issues with command deletion and renaming} testdel {
 if {[info exists env(value)]} {
     unset env(value)
 }
+test rename-4.8 {Bug a16752c252} testdel {
+    set x broken
+    testdel {} foo {set x ok}
+    proc foo args {}
+    rename foo {}
+    return -level 0 $x[unset x]
+} ok
 
 # Save the unknown procedure which is modified by the following test.
 
 catch {rename unknown unknown.old}
 
+set SAVED_UNKNOWN "proc unknown "
+append SAVED_UNKNOWN [list [info args unknown.old] [info body unknown.old]]
 test rename-5.1 {repeated rename deletion and redefinition of same command} {
-    set SAVED_UNKNOWN "proc unknown "
-    append SAVED_UNKNOWN "\{[info args unknown.old]\} "
-    append SAVED_UNKNOWN "\{[info body unknown.old]\}"
-
     for {set i 0} {$i < 10} {incr i} {
         eval $SAVED_UNKNOWN
         tcl_wordBreakBefore "" 0
@@ -158,24 +166,27 @@ test rename-5.1 {repeated rename deletion and redefinition of same command} {
 catch {rename unknown {}}
 catch {rename unknown.old unknown}
 
-
-test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed } {
-     proc x {} {
+test rename-6.1 {old code invalidated (epoch incremented) when cmd with compile proc is renamed} -body {
+    proc x {} {
         set a 123
         set b [incr a]
     }
     x
     rename incr incr.old
     proc incr {} {puts "new incr called!"}
-    catch {x} msg
+    x
+} -cleanup {
     rename incr {}
     rename incr.old incr
-    set msg
-} {wrong # args: should be "incr"}
-
+} -returnCodes error -result {wrong # args: should be "incr"}
+
 if {[info commands incr.old] != {}} {
     catch {rename incr {}}
     catch {rename incr.old incr}
 }
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/resolver.test b/tests/resolver.test
new file mode 100644
index 0000000..e73ea50
--- /dev/null
+++ b/tests/resolver.test
@@ -0,0 +1,203 @@
+# This test collection covers some unwanted interactions between command
+# literal sharing and the use of command resolvers (per-interp) which cause
+# command literals to be re-used with their command references being invalid
+# in the reusing context.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 2011 Gustaf Neumann <gustaf.neumann@wu.ac.at>
+# Copyright (c) 2011 Stefan Sobernig <stefan.sobernig@wu.ac.at>
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcltest 2
+if {"::tcltest" in [namespace children]} {
+    namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testinterpresolver [llength [info commands testinterpresolver]]
+
+test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup {
+    testinterpresolver up
+    namespace eval ::ns1 {
+	proc z {} { return Z }
+	namespace export z
+    }
+    proc ::y {} { return Y }
+    proc ::x {} {
+	z
+    }
+} -constraints testinterpresolver -body {
+    # 1) Have the proc body compiled: During compilation or, alternatively,
+    # the first evaluation of the compiled body, the InterpCmdResolver (see
+    # tclTest.c) maps the cmd token "z" to "::y"; this mapping is saved in the
+    # resulting CmdName Tcl_Obj with the print string "z". The CmdName Tcl_Obj
+    # is turned into a command literal shared for a given (here: the global)
+    # namespace.
+    set r0 [x];			# --> The result of [x] is "Y"
+    # 2) After having requested cmd resolution above, we can now use the
+    # globally shared CmdName Tcl_Obj "z", now bound to cmd ::y. This is
+    # certainly questionable, but defensible
+    set r1 [z];			# --> The result of [z] is "Y"
+    # 3) We import from the namespace ns1 another z. [namespace import] takes
+    # care "shadowed" cmd references, however, till now cmd literals have not
+    # been touched. This is, however, necessary since the BC compiler (used in
+    # the [namespace eval]) seems to be eager to reuse CmdName Tcl_Objs as cmd
+    # literals for a given NS scope. We expect, that r2 is "Z", the result of
+    # the namespace imported cmd.
+    namespace eval :: {
+	namespace import ::ns1::z
+	set r2 [z]
+    }
+    list $r0 $r1 $::r2
+} -cleanup {
+    testinterpresolver down
+    rename ::x ""
+    rename ::y ""
+    namespace delete ::ns1
+} -result {Y Y Z}
+test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup {
+    testinterpresolver up
+    proc ::y {} { return Y }
+    proc ::x {} {
+	z
+    }
+} -constraints testinterpresolver -body {
+    set r0 [x]
+    set r1 [z]
+    proc ::foo {} {
+	proc ::z {} { return Z }
+	return [z]
+    }
+    list $r0 $r1 [::foo]
+} -cleanup {
+    testinterpresolver down
+    rename ::x ""
+    rename ::y ""
+    rename ::foo ""
+    rename ::z ""
+} -result {Y Y Z}
+test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup {
+    testinterpresolver up
+    proc ::Z {} { return Z }
+    proc ::y {} { return Y }
+    proc ::x {} {
+	z
+    }
+} -constraints testinterpresolver -body {
+    set r0 [x]
+    set r1 [z]
+    namespace eval :: {
+	rename ::Z ::z
+	set r2 [z]
+    }
+    list $r0 $r1 $r2
+} -cleanup {
+    testinterpresolver down
+    rename ::x ""
+    rename ::y ""
+    rename ::z ""
+} -result {Y Y Z}
+test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup {
+    testinterpresolver up
+    proc ::Z {} { return Z }
+    interp hide {} Z
+    proc ::y {} { return Y }
+    proc ::x {} {
+	z
+    }
+} -constraints testinterpresolver -body {
+    set r0 [x]
+    set r1 [z]
+    interp expose {} Z z
+    namespace eval :: {
+	set r2 [z]
+    }
+    list $r0 $r1 $r2
+} -cleanup {
+    testinterpresolver down
+    rename ::x ""
+    rename ::y ""
+    rename ::z ""
+} -result {Y Y Z}
+test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -setup {
+    testinterpresolver up
+    namespace eval ::ns1 {
+	proc z {} { return Z }
+	namespace export z
+    }
+    proc ::y {} { return Y }
+    namespace eval ::ns2 {
+	proc x {} {
+	    z
+	}
+    }
+} -constraints testinterpresolver -body {
+    set r0 [namespace eval ::ns2 {x}]
+    set r1 [namespace eval ::ns2 {z}]
+    namespace eval ::ns2 {
+	namespace import ::ns1::z
+	set r2 [z]
+    }
+    list $r0 $r1 $r2
+} -cleanup {
+    testinterpresolver down
+    namespace delete ::ns2
+    namespace delete ::ns1
+} -result {Y Y Z}
+test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup {
+    testinterpresolver up
+    proc ::Z {} { return Z }
+    proc ::y {} { return Y }
+    proc ::x {} {
+	z
+    }
+} -constraints testinterpresolver -body {
+    set r0 [x]
+    set r1 [z]
+    namespace eval :: {
+	interp alias {} ::z {} ::Z
+	set r2 [z]
+    }
+    list $r0 $r1 $r2
+} -cleanup {
+    testinterpresolver down
+    rename ::x ""
+    rename ::y ""
+    rename ::Z ""
+} -result {Y Y Z}
+
+test resolver-2.1 {compiled var resolver: Bug #3383616} -setup {
+    testinterpresolver up
+    # The compiled var resolver fetches just variables starting with a capital
+    # "T" and stores some test information in the resolver-specific resolver
+    # var info.
+    proc ::x {} {
+	set T1 100
+	return $T1
+    }
+} -constraints testinterpresolver -body {
+    # Call "x" the first time, causing a byte code compilation of the body.
+    # During the compilation the compiled var resolver, the resolve-specific
+    # var info is allocated, during the execution of the body, the variable is
+    # fetched and cached.
+    x;
+    # During later calls, the cached variable is reused.
+    x
+    # When the proc is freed, the resolver-specific resolver var info is
+    # freed. This did not happen before fix #3383616.
+    rename ::x ""
+} -cleanup {
+    testinterpresolver down
+} -result {}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/result.test b/tests/result.test
index 4337ef3..9e8a66b 100644
--- a/tests/result.test
+++ b/tests/result.test
@@ -9,18 +9,19 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# SCCS: @(#) result.test 1.4 97/12/08 15:07:49
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
 # Some tests require the testsaveresult command
 
-::tcltest::testConstraint testsaveresult \
-	[expr {[info commands testsaveresult] != {}}]
+testConstraint testsaveresult      [llength [info commands testsaveresult]]
+testConstraint testsetobjerrorcode [llength [info commands testsetobjerrorcode]]
+testConstraint testseterrorcode    [llength [info commands testseterrorcode]]
+testConstraint testreturn          [llength [info commands testreturn]]
 
 test result-1.1 {Tcl_SaveInterpResult} {testsaveresult} {
     testsaveresult small {set x 42} 0
@@ -47,7 +48,6 @@ test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} {
     testsaveresult object {set x 42} 1
 } {42 different}
 
-
 # Tcl_RestoreInterpResult is mostly tested by the previous tests except
 # for the following case
 
@@ -58,16 +58,13 @@ test result-2.1 {Tcl_RestoreInterpResult} {testsaveresult} {
 # Tcl_DiscardInterpResult is mostly tested by the previous tests except
 # for the following cases
 
-test result-3.1 {Tcl_DiscardInterpResult} {testsaveresult} {
-    list [catch {testsaveresult append {cd _foobar} 1} msg] $msg
-} {1 {couldn't change working directory to "_foobar": no such file or directory}}
+test result-3.1 {Tcl_DiscardInterpResult} -constraints testsaveresult -body {
+    testsaveresult append {cd _foobar} 1
+} -returnCodes error -result {couldn't change working directory to "_foobar": no such file or directory}
 test result-3.2 {Tcl_DiscardInterpResult} {testsaveresult} {
     testsaveresult free {set x 42} 1
 } {42}
 
-::tcltest::testConstraint testsetobjerrorcode \
-	[expr {[info commands testsetobjerrorcode] != {}}]
-
 test result-4.1 {Tcl_SetObjErrorCode - one arg} {testsetobjerrorcode} {
     catch {testsetobjerrorcode 1}
     list [set errorCode]
@@ -89,9 +86,6 @@ test result-4.5 {Tcl_SetObjErrorCode - five args} {testsetobjerrorcode} {
     list [set errorCode]
 } {{1 2 3 4 5}}
 
-::tcltest::testConstraint testseterrorcode \
-	[expr {[info commands testseterrorcode] != {}}]
-
 test result-5.1 {Tcl_SetErrorCode - one arg} testseterrorcode {
     catch {testseterrorcode 1}
     set errorCode
@@ -109,8 +103,6 @@ test result-5.4 {Tcl_SetErrorCode - two args, list quoting} testseterrorcode {
     set errorCode
 } {{a b} c}
 
-::tcltest::testConstraint testreturn \
-	[expr {[info commands testreturn] != {}}]
 test result-6.0 {Bug 1209759} -constraints testreturn -body {
     # Might panic if bug is not fixed.
     proc foo {} {testreturn}
@@ -120,8 +112,36 @@ test result-6.1 {Bug 1209759} -constraints testreturn -body {
     # Might panic if bug is not fixed.
     proc foo {} {catch {return -level 2}; testreturn}
     foo
+} -cleanup {
+    rename foo {}
 } -returnCodes ok -result {}
-
+test result-6.2 {Bug 1649062} -setup {
+    proc foo {} {
+        if {[catch {
+            return -code error -errorinfo custom -errorcode CUSTOM foo
+        } err]} {
+            return [list $err $::errorCode $::errorInfo]
+        }
+    }
+    set ::errorInfo {}
+    set ::errorCode {}
+} -body {
+    foo
+} -cleanup {
+    rename foo {}
+} -result {foo {} {}}
+test result-6.3 {Bug 2383005} {
+     catch {return -code error -errorcode {{}a} eek} m
+     set m
+} {bad -errorcode value: expected a list but got "{}a"}
+test result-6.4 {non-list -errorstack} -body {
+     catch {return -code error -errorstack {{}a} eek} m o
+     list $m [dict get $o -errorcode] [dict get $o -errorstack]
+} -match glob -result {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {INNER * UP 1}}
+test result-6.5 {odd-sized-list -errorstack} -body {
+     catch {return -code error -errorstack a eek} m o
+     list $m [dict get $o -errorcode] [dict get $o -errorstack]
+} -match glob -result {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {INNER * UP 1}}
 # cleanup
-::tcltest::cleanupTests
+cleanupTests
 return
diff --git a/tests/safe.test b/tests/safe.test
index 4def77c..859f352 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -1,19 +1,19 @@
 # safe.test --
 #
-# This file contains a collection of tests for safe Tcl, packages loading,
-# and using safe interpreters. 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 safe Tcl, packages loading, and
+# using safe interpreters. Sourcing this file into tcl runs the tests and
+# generates output for errors. No output means no errors were found.
 #
 # Copyright (c) 1995-1996 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.
-#
-# RCS: @(#) $Id: safe.test,v 1.19 2005/05/10 18:35:23 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.5
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
@@ -24,464 +24,831 @@ foreach i [interp slaves] {
 set saveAutoPath $::auto_path
 set ::auto_path [info library]
 
-# Force actual loading of the safe package 
-# because we use un exported (and thus un-autoindexed) APIs
-# in this test result arguments:
+# Force actual loading of the safe package because we use un exported (and
+# thus un-autoindexed) APIs in this test result arguments:
 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)
 
-test safe-1.1 {safe::interpConfigure syntax} {
-    list [catch {safe::interpConfigure} msg] $msg;
-} {1 {no value given for parameter "slave" (use -help for full usage) :
-    slave name () name of the slave}}
-test safe-1.2 {safe::interpCreate syntax} {
-    list [catch {safe::interpCreate -help} msg] $msg;
-} {1 {Usage information:
+testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
+
+test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
+    safe::interpConfigure
+} -result {no value given for parameter "slave" (use -help for full usage) :
+    slave name () name of the slave}
+test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
+    safe::interpCreate -help
+} -result {Usage information:
     Var/FlagName  Type     Value   Help
     ------------  ----     -----   ----
-    ( -help                        gives this help )
+    (-help                         gives this help)
     ?slave?       name     ()      name of the slave (optional)
     -accessPath   list     ()      access path for the slave
     -noStatics    boolflag (false) prevent loading of statically linked pkgs
     -statics      boolean  (true)  loading of statically linked pkgs
     -nestedLoadOk boolflag (false) allow nested loading
     -nested       boolean  (false) nested loading
-    -deleteHook   script   ()      delete hook}}
-test safe-1.3 {safe::interpInit syntax} {
-    list [catch {safe::interpInit -noStatics} msg] $msg;
-} {1 {bad value "-noStatics" for parameter
-    slave name () name of the slave}}
-
+    -deleteHook   script   ()      delete hook}
+test safe-1.3 {safe::interpInit syntax} -returnCodes error -body {
+    safe::interpInit -noStatics
+} -result {bad value "-noStatics" for parameter
+    slave name () name of the slave}
 
 test safe-2.1 {creating interpreters, should have no aliases} emptyTest {
     # Disabled this test.  It tests nothing sensible.  [Bug 999612]
     # interp aliases
 } ""
-test safe-2.2 {creating interpreters, should have no aliases} {
+test safe-2.2 {creating interpreters, should have no aliases} -setup {
     catch {safe::interpDelete a}
+} -body {
     interp create a
-    set l [a aliases]
+    a aliases
+} -cleanup {
     safe::interpDelete a
-    set l
-} ""
-test safe-2.3 {creating safe interpreters, should have no unexpected aliases} {
+} -result ""
+test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -setup {
     catch {safe::interpDelete a}
+} -body {
     interp create a -safe
-    set l [a aliases]
+    lsort [a aliases]
+} -cleanup {
     interp delete a
-    set l
-} {clock}
+} -result {::tcl::mathfunc::max ::tcl::mathfunc::min clock}
 
-test safe-3.1 {calling safe::interpInit is safe} {
+test safe-3.1 {calling safe::interpInit is safe} -setup {
     catch {safe::interpDelete a}
-    interp create a -safe 
+    interp create a -safe
+} -body {
     safe::interpInit a
-    catch {interp eval a exec ls} msg
+    interp eval a exec ls
+} -returnCodes error -cleanup {
     safe::interpDelete a
-    set msg
-} {invalid command name "exec"}
-test safe-3.2 {calling safe::interpCreate on trusted interp} {
+} -result {invalid command name "exec"}
+test safe-3.2 {calling safe::interpCreate on trusted interp} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
-    set l [lsort [a aliases]]
+    lsort [a aliases]
+} -cleanup {
     safe::interpDelete a
-    set l
-} {clock encoding exit file load source}
-test safe-3.3 {calling safe::interpCreate on trusted interp} {
+} -result {::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 ::tcl::info::nameofexecutable clock encoding exit glob load source}
+test safe-3.3 {calling safe::interpCreate on trusted interp} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
-    set x [interp eval a {source [file join $tcl_library init.tcl]}]
+    interp eval a {source [file join $tcl_library init.tcl]}
+} -cleanup {
     safe::interpDelete a
-    set x
-} ""
-test safe-3.4 {calling safe::interpCreate on trusted interp} {
+} -result ""
+test safe-3.4 {calling safe::interpCreate on trusted interp} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
-    catch {set x \
-		[interp eval a {source [file join $tcl_library init.tcl]}]} msg
+    interp eval a {source [file join $tcl_library init.tcl]}
+} -cleanup {
     safe::interpDelete a
-    list $x $msg
-} {{} {}}
+} -result {}
 
-test safe-4.1 {safe::interpDelete} {
+test safe-4.1 {safe::interpDelete} -setup {
     catch {safe::interpDelete a}
+} -body {
     interp create a
     safe::interpDelete a
-} ""
-test safe-4.2 {safe::interpDelete, indirectly} {
+} -result ""
+test safe-4.2 {safe::interpDelete, indirectly} -setup {
     catch {safe::interpDelete a}
+} -body {
     interp create a
     a alias exit safe::interpDelete a
     a eval exit
-} ""
-test safe-4.3 {safe::interpDelete, state array (not a public api)} {
-    catch {safe::interpDelete a}
-    namespace eval safe {set [InterpStateName a](foo) 33}
-    # not an error anymore to call it if interp is already
-    # deleted, to make trhings smooth if it's called twice...
-    catch {safe::interpDelete a} m1
-    catch {namespace eval safe {set [InterpStateName a](foo)}} m2
-    list $m1 $m2
-} "{}\
-   {can't read \"[safe::InterpStateName a](foo)\": no such variable}"
-test safe-4.4 {safe::interpDelete, state array, indirectly (not a public api)} {
+} -result ""
+test safe-4.5 {safe::interpDelete} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
-    namespace eval safe {set [InterpStateName a](foo) 33}
-    a eval exit
-    catch {namespace eval safe {set [InterpStateName a](foo)}} msg
-} 1
-test safe-4.5 {safe::interpDelete} {
-    catch {safe::interpDelete a}
     safe::interpCreate a
-    catch {safe::interpCreate a} msg
-    set msg
-} {interpreter named "a" already exists, cannot create}
-test safe-4.6 {safe::interpDelete, indirectly} {
+} -returnCodes error -cleanup {
+    safe::interpDelete a
+} -result {interpreter named "a" already exists, cannot create}
+test safe-4.6 {safe::interpDelete, indirectly} -setup {
     catch {safe::interpDelete a}
+} -body {
     safe::interpCreate a
     a eval exit
-} ""
+} -result ""
 
 # The following test checks whether the definition of tcl_endOfWord can be
 # obtained from auto_loading.
 
-test safe-5.1 {test auto-loading in safe interpreters} {
+test safe-5.1 {test auto-loading in safe interpreters} -setup {
     catch {safe::interpDelete a}
     safe::interpCreate a
-    set r [catch {interp eval a {tcl_endOfWord "" 0}} msg]
+} -body {
+    interp eval a {tcl_endOfWord "" 0}
+} -cleanup {
     safe::interpDelete a
-    list $r $msg
-} {0 -1}
+} -result -1
 
 # test safe interps 'information leak'
-proc SI {} {
-    global I
-    set I [interp create -safe];
-}
-proc DI {} {
-    global I;
-    interp delete $I;
+proc SafeEval {script} {
+    # Helper procedure that ensures the safe interp is cleaned up even if
+    # there is a failure in the script.
+    set SafeInterp [interp create -safe]
+    catch {$SafeInterp eval $script} msg opts
+    interp delete $SafeInterp
+    return -options $opts $msg
 }
 
 test safe-6.1 {test safe interpreters knowledge of the world} {
-    SI; set r [lsort [$I eval {info globals}]]; DI; set r
+    lsort [SafeEval {info globals}]
 } {tcl_interactive tcl_patchLevel tcl_platform tcl_version}
 test safe-6.2 {test safe interpreters knowledge of the world} {
-    SI; set r [$I eval {info script}]; DI; set r
+    SafeEval {info script}
 } {}
 test safe-6.3 {test safe interpreters knowledge of the world} {
-    SI
-    set r [lsort [$I eval {array names tcl_platform}]]
-    DI
+    set r [SafeEval {array names tcl_platform}]
     # If running a windows-debug shell, remove the "debug" element from r.
-    if {$tcl_platform(platform) == "windows" && \
-	    [lsearch $r "debug"] != -1} {
-	set r [lreplace $r 1 1]
+    if {[testConstraint win]} {
+	set r [lsearch -all -inline -not -exact $r "debug"]
     }
-    set threaded [lsearch $r "threaded"]
-    if {$threaded != -1} {
-	set r [lreplace $r $threaded $threaded]
-    }
-    set r
-} {byteOrder platform wordSize}
+    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];
+    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};
+    interp eval $i {http_config}
     safe::interpDelete $i
     set v
 } 1.0
-test safe-7.2 {tests specific path and interpFind/AddToAccessPath} {
-    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]];
+test safe-7.2 {tests specific path and interpFind/AddToAccessPath} -body {
+    set i [safe::interpCreate -nostat -nested 1 -accessPath [list [info library]]]
     # should not add anything (p0)
     set token1 [safe::interpAddToAccessPath $i [info library]]
     # should add as p1
-    set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"];
+    set token2 [safe::interpAddToAccessPath $i "/dummy/unixlike/test/path"]
     # an error shall occur (http is not anymore in the secure 0-level
     # provided deep path)
     list $token1 $token2 \
 	    [catch {interp eval $i {package require http 1}} msg] $msg \
 	    [safe::interpConfigure $i]\
 	    [safe::interpDelete $i]
-} "{\$p(:0:)} {\$p(:1:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library /dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"
-
+} -match glob -result "{\$p(:0:)} {\$p(:*:)} 1 {can't find package http 1} {-accessPath {[list $tcl_library */dummy/unixlike/test/path]} -statics 0 -nested 1 -deleteHook {}} {}"
+test safe-7.3 {check that safe subinterpreters work} {
+    set i [safe::interpCreate]
+    set j [safe::interpCreate [list $i x]]
+    list [interp eval $j {join {o k} ""}] [safe::interpDelete $i] [interp exists $j]
+} {ok {} 0}
 
 # test source control on file name
-test safe-8.1 {safe source control on file} {
-    set i "a";
+test safe-8.1 {safe source control on file} -setup {
+    set i "a"
     catch {safe::interpDelete $i}
-    safe::interpCreate $i;
-    list  [catch {$i eval {source}} msg] \
-	    $msg \
-	    [safe::interpDelete $i] ;
-} {1 {wrong # args: should be "source fileName"} {}}
-test safe-8.2 {safe source control on file} {
-    set i "a";
+} -body {
+    safe::interpCreate $i
+    $i eval {source}
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {wrong # args: should be "source ?-encoding E? fileName"}
+test safe-8.2 {safe source control on file} -setup {
+    set i "a"
     catch {safe::interpDelete $i}
-    safe::interpCreate $i;
-    list  [catch {$i eval {source}} msg] \
-	    $msg \
-	    [safe::interpDelete $i] ;
-} {1 {wrong # args: should be "source fileName"} {}}
-test safe-8.3 {safe source control on file} {
-    set i "a";
+} -body {
+    safe::interpCreate $i
+    $i eval {source a b c d e}
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {wrong # args: should be "source ?-encoding E? fileName"}
+test safe-8.3 {safe source control on file} -setup {
+    set i "a"
     catch {safe::interpDelete $i}
-    safe::interpCreate $i;
-    set log {};
-    proc safe-test-log {str} {global log; lappend log $str}
-    set prevlog [safe::setLogCmd];
-    safe::setLogCmd safe-test-log;
-    list  [catch {$i eval {source .}} msg] \
-	    $msg \
-	    $log \
-	    [safe::setLogCmd $prevlog; unset log] \
-	    [safe::interpDelete $i] ;
-} {1 {permission denied} {{ERROR for slave a : ".": is a directory}} {} {}}
-test safe-8.4 {safe source control on file} {
-    set i "a";
+    set log {}
+    proc safe-test-log {str} {lappend ::log $str}
+    set prevlog [safe::setLogCmd]
+} -body {
+    safe::interpCreate $i
+    safe::setLogCmd safe-test-log
+    list [catch {$i eval {source .}} msg] $msg $log
+} -cleanup {
+    safe::setLogCmd $prevlog
+    unset log
+    safe::interpDelete $i
+} -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}}
+test safe-8.4 {safe source control on file} -setup {
+    set i "a"
     catch {safe::interpDelete $i}
-    safe::interpCreate $i;
-    set log {};
+    set log {}
     proc safe-test-log {str} {global log; lappend log $str}
-    set prevlog [safe::setLogCmd];
-    safe::setLogCmd safe-test-log;
-    list  [catch {$i eval {source /abc/def}} msg] \
-	    $msg \
-	    $log \
-	    [safe::setLogCmd $prevlog; unset log] \
-	    [safe::interpDelete $i] ;
-} {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}} {} {}}
-test safe-8.5 {safe source control on file} {
-    # This tested filename == *.tcl or tclIndex, but that restriction
-    # was removed in 8.4a4 - hobbs
-    set i "a";
+    set prevlog [safe::setLogCmd]
+} -body {
+    safe::interpCreate $i
+    safe::setLogCmd safe-test-log
+    list [catch {$i eval {source /abc/def}} msg] $msg $log
+} -cleanup {
+    safe::setLogCmd $prevlog
+    unset log
+    safe::interpDelete $i
+} -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}}
+test safe-8.5 {safe source control on file} -setup {
+    set i "a"
     catch {safe::interpDelete $i}
-    safe::interpCreate $i;
-    set log {};
+    set log {}
     proc safe-test-log {str} {global log; lappend log $str}
-    set prevlog [safe::setLogCmd];
-    safe::setLogCmd safe-test-log;
-    list  [catch {$i eval {source [file join [info lib] blah]}} msg] \
-	    $msg \
-	    $log \
-	    [safe::setLogCmd $prevlog; unset log] \
-	    [safe::interpDelete $i] ;
-} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"] {} {}]
-test safe-8.6 {safe source control on file} {
-    set i "a";
+    set prevlog [safe::setLogCmd]
+} -body {
+    # This tested filename == *.tcl or tclIndex, but that restriction was
+    # removed in 8.4a4 - hobbs
+    safe::interpCreate $i
+    safe::setLogCmd safe-test-log
+    list [catch {
+	$i eval {source [file join [info lib] blah]}
+    } msg] $msg $log
+} -cleanup {
+    safe::setLogCmd $prevlog
+    unset log
+    safe::interpDelete $i
+} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]]
+test safe-8.6 {safe source control on file} -setup {
+    set i "a"
     catch {safe::interpDelete $i}
-    safe::interpCreate $i;
-    set log {};
+    set log {}
     proc safe-test-log {str} {global log; lappend log $str}
-    set prevlog [safe::setLogCmd];
-    safe::setLogCmd safe-test-log;
-    list  [catch {$i eval {source [file join [info lib] blah.tcl]}} msg] \
-	    $msg \
-	    $log \
-	    [safe::setLogCmd $prevlog; unset log] \
-	    [safe::interpDelete $i] ;
-} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"] {} {}]
-test safe-8.7 {safe source control on file} {
-    # This tested length of filename, but that restriction
-    # was removed in 8.4a4 - hobbs
-    set i "a";
+    set prevlog [safe::setLogCmd]
+} -body {
+    safe::interpCreate $i
+    safe::setLogCmd safe-test-log
+    list [catch {
+	$i eval {source [file join [info lib] blah.tcl]}
+    } msg] $msg $log
+} -cleanup {
+    safe::setLogCmd $prevlog
+    unset log
+    safe::interpDelete $i
+} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]]
+test safe-8.7 {safe source control on file} -setup {
+    set i "a"
     catch {safe::interpDelete $i}
-    safe::interpCreate $i;
-    set log {};
+    set log {}
     proc safe-test-log {str} {global log; lappend log $str}
-    set prevlog [safe::setLogCmd];
-    safe::setLogCmd safe-test-log;
-    list  [catch {$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}}\
-		 msg] \
-	    $msg \
-	    $log \
-	    [safe::setLogCmd $prevlog; unset log] \
-	    [safe::interpDelete $i] ;
-} [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"] {} {}]
-test safe-8.8 {safe source forbids -rsrc} {
-    set i "a";
+    set prevlog [safe::setLogCmd]
+} -body {
+    safe::interpCreate $i
+    # This tested length of filename, but that restriction was removed in
+    # 8.4a4 - hobbs
+    safe::setLogCmd safe-test-log
+    list [catch {
+	$i eval {source [file join [info lib] xxxxxxxxxxx.tcl]}
+    } msg] $msg $log
+} -cleanup {
+    safe::setLogCmd $prevlog
+    unset log
+    safe::interpDelete $i
+} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
+test safe-8.8 {safe source forbids -rsrc} -setup {
+    set i "a"
+    catch {safe::interpDelete $i}
+    safe::interpCreate $i
+} -body {
+    $i eval {source -rsrc Init}
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {wrong # args: should be "source ?-encoding E? fileName"}
+test safe-8.9 {safe source and return} -setup {
+    set returnScript [makeFile {return "ok"} return.tcl]
+    catch {safe::interpDelete $i}
+} -body {
+    safe::interpCreate $i
+    set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
+    $i eval [list source $token/[file tail $returnScript]]
+} -cleanup {
+    catch {safe::interpDelete $i}
+    removeFile $returnScript
+} -result ok
+test safe-8.10 {safe source and return} -setup {
+    set returnScript [makeFile {return -level 2 "ok"} return.tcl]
+    catch {safe::interpDelete $i}
+} -body {
+    safe::interpCreate $i
+    set token [safe::interpAddToAccessPath $i [file dirname $returnScript]]
+    $i eval [list apply {filename {
+	source $filename
+	error boom
+    }} $token/[file tail $returnScript]]
+} -cleanup {
     catch {safe::interpDelete $i}
-    safe::interpCreate $i;
-    list  [catch {$i eval {source -rsrc Init}} msg] \
-	    $msg \
-	    [safe::interpDelete $i] ;
-} {1 {wrong # args: should be "source fileName"} {}}
+    removeFile $returnScript
+} -result ok
 
-test safe-9.1 {safe interps' deleteHook} {
-    set i "a";
+test safe-9.1 {safe interps' deleteHook} -setup {
+    set i "a"
     catch {safe::interpDelete $i}
     set res {}
+} -body {
     proc testDelHook {args} {
-	global res;
+	global res
 	# the interp still exists at that point
 	interp eval a {set delete 1}
 	# mark that we've been here (successfully)
-	set res $args;
+	set res $args
     }
-    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
+    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"
     list [interp eval $i exit] $res
-} {{} {arg1 arg2 a}}
-test safe-9.2 {safe interps' error in deleteHook} {
-    set i "a";
+} -result {{} {arg1 arg2 a}}
+test safe-9.2 {safe interps' error in deleteHook} -setup {
+    set i "a"
     catch {safe::interpDelete $i}
     set res {}
+    set log {}
+    proc safe-test-log {str} {lappend ::log $str}
+    set prevlog [safe::setLogCmd]
+} -body {
     proc testDelHook {args} {
-	global res;
+	global res
 	# the interp still exists at that point
 	interp eval a {set delete 1}
 	# mark that we've been here (successfully)
-	set res $args;
+	set res $args
 	# create an exception
-	error "being catched";
+	error "being catched"
     }
-    set log {};
-    proc safe-test-log {str} {global log; lappend log $str}
-    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2";
-    set prevlog [safe::setLogCmd];
-    safe::setLogCmd safe-test-log;
-    list  [safe::interpDelete $i] $res \
-	    $log \
-	    [safe::setLogCmd $prevlog; unset log];
-} {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}} {}}
-test safe-9.3 {dual specification of statics} {
-    list [catch {safe::interpCreate -stat true -nostat} msg] $msg
-} {1 {conflicting values given for -statics and -noStatics}}
+    safe::interpCreate $i -deleteHook "testDelHook arg1 arg2"
+    safe::setLogCmd safe-test-log
+    list [safe::interpDelete $i] $res $log
+} -cleanup {
+    safe::setLogCmd $prevlog
+    unset log
+} -result {{} {arg1 arg2 a} {{NOTICE for slave a : About to delete} {ERROR for slave a : Delete hook error (being catched)} {NOTICE for slave a : Deleted}}}
+test safe-9.3 {dual specification of statics} -returnCodes error -body {
+    safe::interpCreate -stat true -nostat
+} -result {conflicting values given for -statics and -noStatics}
 test safe-9.4 {dual specification of statics} {
     # no error shall occur
     safe::interpDelete [safe::interpCreate -stat false -nostat]
 } {}
-test safe-9.5 {dual specification of nested} {
-    list [catch {safe::interpCreate -nested 0 -nestedload} msg] $msg
-} {1 {conflicting values given for -nested and -nestedLoadOk}}
-
-test safe-9.6 {interpConfigure widget like behaviour} {
-   # this test shall work, don't try to "fix it" unless
-   # you *really* know what you are doing (ie you are me :p) -- dl
+test safe-9.5 {dual specification of nested} -returnCodes error -body {
+    safe::interpCreate -nested 0 -nestedload
+} -result {conflicting values given for -nested and -nestedLoadOk}
+test safe-9.6 {interpConfigure widget like behaviour} -body {
+   # this test shall work, don't try to "fix it" unless you *really* know what
+   # you are doing (ie you are me :p) -- dl
    list [set i [safe::interpCreate \
-	                           -noStatics \
-                                   -nestedLoadOk \
-	                           -deleteHook {foo bar}];
-         safe::interpConfigure $i -accessPath /foo/bar ;
+		    -noStatics \
+		    -nestedLoadOk \
+		    -deleteHook {foo bar}]
+         safe::interpConfigure $i -accessPath /foo/bar
          safe::interpConfigure $i]\
 	[safe::interpConfigure $i -aCCess]\
 	[safe::interpConfigure $i -nested]\
 	[safe::interpConfigure $i -statics]\
 	[safe::interpConfigure $i -DEL]\
-	[safe::interpConfigure $i -accessPath /blah -statics 1;
+	[safe::interpConfigure $i -accessPath /blah -statics 1
 	 safe::interpConfigure $i]\
-	[safe::interpConfigure $i -deleteHook toto -nosta -nested 0;
+	[safe::interpConfigure $i -deleteHook toto -nosta -nested 0
 	 safe::interpConfigure $i]
-} {{-accessPath /foo/bar -statics 0 -nested 1 -deleteHook {foo bar}} {-accessPath /foo/bar} {-nested 1} {-statics 0} {-deleteHook {foo bar}} {-accessPath /blah -statics 1 -nested 1 -deleteHook {foo bar}} {-accessPath /blah -statics 0 -nested 0 -deleteHook toto}}
-
-# testing that nested and statics do what is advertised
-# (we use a static package : Tcltest)
-
-if {[catch {package require Tcltest} msg]} {
-    testConstraint TcltestPackage 0
-} else {
-    testConstraint TcltestPackage 1
-    # we use the Tcltest package , which has no Safe_Init
-}
+} -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}}
 
-test safe-10.1 {testing statics loading} TcltestPackage {
-    set i [safe::interpCreate]
-    list \
-	    [catch {interp eval $i {load {} Tcltest}} msg] \
-	    $msg \
-            [safe::interpDelete $i];
-} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
-test safe-10.2 {testing statics loading / -nostatics} TcltestPackage {
+catch {teststaticpkg Safepkg1 0 0}
+test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i {load {} Safepkg1}
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
+    set i [safe::interpCreate]
+} -body {
+    catch {interp eval $i {load {} Safepkg1}} m o
+    dict get $o -errorinfo
+} -returnCodes ok -cleanup {
+    unset -nocomplain m o
+    safe::interpDelete $i
+} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+    invoked from within
+"load {} Safepkg1"
+    invoked from within
+"interp eval $i {load {} Safepkg1}"}
+test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body {
     set i [safe::interpCreate -nostatics]
-    list \
-	    [catch {interp eval $i {load {} Tcltest}} msg] \
-	    $msg \
-            [safe::interpDelete $i];
-} {1 {permission denied (static package)} {}}
-test safe-10.3 {testing nested statics loading / no nested by default} TcltestPackage {
-    set i [safe::interpCreate]
-    list \
-	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
-	    $msg \
-            [safe::interpDelete $i];
-} {1 {permission denied (nested load)} {}}
-test safe-10.4 {testing nested statics loading / -nestedloadok} TcltestPackage {
+    interp eval $i {load {} Safepkg1}
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {permission denied (static package)}
+test safe-10.3 {testing nested statics loading / no nested by default} -setup {
+    set i [safe::interpCreate]
+} -constraints TcltestPackage -body {
+    interp eval $i {interp create x; load {} Safepkg1 x}
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {permission denied (nested load)}
+test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
     set i [safe::interpCreate -nestedloadok]
-    list \
-	    [catch {interp eval $i {interp create x; load {} Tcltest x}} msg] \
-	    $msg \
-            [safe::interpDelete $i];
-} {1 {can't use package in a safe interpreter: no Tcltest_SafeInit procedure} {}}
+    interp eval $i {interp create x; load {} Safepkg1 x}
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
+test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
+    set i [safe::interpCreate -nestedloadok]
+    catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
+    dict get $o -errorinfo
+} -returnCodes ok -cleanup {
+    unset -nocomplain m o
+    safe::interpDelete $i
+} -result {can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
+    invoked from within
+"load {} Safepkg1 x"
+    invoked from within
+"interp eval $i {interp create x; load {} Safepkg1 x}"}
+
+test safe-11.1 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i encoding
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {wrong # args: should be "encoding option ?arg ...?"}
+test safe-11.1a {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i encoding foobar
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -match glob -result {bad option "foobar": must be *}
+test safe-11.2 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i encoding system cp775
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {wrong # args: should be "encoding system"}
+test safe-11.3 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i encoding system
+} -cleanup {
+    safe::interpDelete $i
+} -result [encoding system]
+test safe-11.4 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i encoding names
+} -cleanup {
+    safe::interpDelete $i
+} -result [encoding names]
+test safe-11.5 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i encoding convertfrom cp1258 foobar
+} -cleanup {
+    safe::interpDelete $i
+} -result foobar
+test safe-11.6 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i encoding convertto cp1258 foobar
+} -cleanup {
+    safe::interpDelete $i
+} -result foobar
+test safe-11.7 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i encoding convertfrom
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {wrong # args: should be "encoding convertfrom ?encoding? data"}
+test safe-11.7.1 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    catch {interp eval $i encoding convertfrom} m o
+    dict get $o -errorinfo
+} -returnCodes ok -cleanup {
+    unset -nocomplain m o
+    safe::interpDelete $i
+} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
+    while executing
+"encoding convertfrom"
+    invoked from within
+"::interp invokehidden interp1 encoding convertfrom"
+    invoked from within
+"encoding convertfrom"
+    invoked from within
+"interp eval $i encoding convertfrom"}
+test safe-11.8 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    interp eval $i encoding convertto
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {wrong # args: should be "encoding convertto ?encoding? data"}
+test safe-11.8.1 {testing safe encoding} -setup {
+    set i [safe::interpCreate]
+} -body {
+    catch {interp eval $i encoding convertto} m o
+    dict get $o -errorinfo
+} -returnCodes ok -cleanup {
+    unset -nocomplain m o
+    safe::interpDelete $i
+} -result {wrong # args: should be "encoding convertto ?encoding? data"
+    while executing
+"encoding convertto"
+    invoked from within
+"::interp invokehidden interp1 encoding convertto"
+    invoked from within
+"encoding convertto"
+    invoked from within
+"interp eval $i encoding convertto"}
+
+test safe-12.1 {glob is restricted [Bug 2906841]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    $i eval glob ../*
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result "permission denied"
+test safe-12.2 {glob is restricted [Bug 2906841]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    $i eval glob -directory .. *
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result "permission denied"
+test safe-12.3 {glob is restricted [Bug 2906841]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    $i eval glob -join .. *
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result "permission denied"
+test safe-12.4 {glob is restricted [Bug 2906841]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    $i eval glob -nocomplain ../*
+} -cleanup {
+    safe::interpDelete $i
+} -result {}
+test safe-12.5 {glob is restricted [Bug 2906841]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    $i eval glob -directory .. -nocomplain *
+} -cleanup {
+    safe::interpDelete $i
+} -result {}
+test safe-12.6 {glob is restricted [Bug 2906841]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    $i eval glob -nocomplain -join .. *
+} -cleanup {
+    safe::interpDelete $i
+} -result {}
+test safe-12.7 {glob is restricted} -setup {
+    set i [safe::interpCreate]
+} -body {
+    $i eval glob *
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {permission denied}
+
+proc buildEnvironment {filename} {
+    upvar 1 testdir testdir testdir2 testdir2 testfile testfile
+    set testdir [makeDirectory deletethisdir]
+    set testdir2 [makeDirectory deletemetoo $testdir]
+    set testfile [makeFile {} $filename $testdir2]
+}
+#### New tests for Safe base glob, with patches @ Bug 2964715
+test safe-13.1 {glob is restricted [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    $i eval glob *
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+} -result {permission denied}
+test safe-13.2 {mimic the valid glob call by ::tcl::tm::UnknownHandler [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    buildEnvironment deleteme.tm
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir2
+    set result [$i eval glob -nocomplain -directory $testdir2 *.tm]
+    if {$result eq [list $testfile]} {
+        return "glob match"
+    } else {
+        return "no match: $result"
+    }
+} -cleanup {
+    safe::interpDelete $i
+    removeDirectory $testdir
+} -result {glob match}
+test safe-13.3 {cf 13.2 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    buildEnvironment deleteme.tm
+} -body {
+    $i eval glob -directory $testdir2 *.tm
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+    removeDirectory $testdir
+} -result {permission denied}
+test safe-13.4 {another valid glob call [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    buildEnvironment deleteme.tm
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir
+    ::safe::interpAddToAccessPath $i $testdir2
+    set result [$i eval \
+	    glob -nocomplain -directory $testdir [file join deletemetoo *.tm]]
+    if {$result eq [list $testfile]} {
+        return "glob match"
+    } else {
+        return "no match: $result"
+    }
+} -cleanup {
+    safe::interpDelete $i
+    removeDirectory $testdir
+} -result {glob match}
+test safe-13.5 {as 13.4 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    buildEnvironment deleteme.tm
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir2
+    $i eval \
+	glob -directory $testdir [file join deletemetoo *.tm]
+} -returnCodes error -cleanup {
+    safe::interpDelete $i
+    removeDirectory $testdir
+} -result {permission denied}
+test safe-13.6 {as 13.4 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    buildEnvironment deleteme.tm
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir
+    $i eval \
+	glob -nocomplain -directory $testdir [file join deletemetoo *.tm]
+} -cleanup {
+    safe::interpDelete $i
+    removeDirectory $testdir
+} -result {}
+test safe-13.7 {mimic the glob call by tclPkgUnknown which gives a deliberate error in a safe interpreter [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    buildEnvironment pkgIndex.tcl
+} -body {
+    set safeTD [::safe::interpAddToAccessPath $i $testdir]
+    ::safe::interpAddToAccessPath $i $testdir2
+    string map [list $safeTD EXPECTED] [$i eval [list \
+	glob -directory $safeTD -join * pkgIndex.tcl]]
+} -cleanup {
+    safe::interpDelete $i
+    removeDirectory $testdir
+} -result {{EXPECTED/deletemetoo/pkgIndex.tcl}}
+# Note the extra {} around the result above; that's *expected* because of the
+# format of virtual path roots.
+test safe-13.8 {mimic the glob call by tclPkgUnknown without the deliberate error that is specific to pkgIndex.tcl [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    buildEnvironment notIndex.tcl
+} -body {
+    set safeTD [::safe::interpAddToAccessPath $i $testdir]
+    ::safe::interpAddToAccessPath $i $testdir2
+    $i eval [list glob -directory $safeTD -join -nocomplain * notIndex.tcl]
+} -cleanup {
+    safe::interpDelete $i
+    removeDirectory $testdir
+} -result {}
+test safe-13.9 {as 13.8 but test glob failure when -directory is outside access path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    buildEnvironment notIndex.tcl
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir2
+    set result [$i eval \
+	    glob -directory $testdir -join -nocomplain * notIndex.tcl]
+    if {$result eq [list $testfile]} {
+        return {glob match}
+    } else {
+        return "no match: $result"
+    }
+} -cleanup {
+    safe::interpDelete $i
+    removeDirectory $testdir
+} -result {no match: }
+test safe-13.10 {as 13.8 but test silent failure when result is outside access_path [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+    buildEnvironment notIndex.tcl
+} -body {
+    ::safe::interpAddToAccessPath $i $testdir
+    $i eval glob -directory $testdir -join -nocomplain * notIndex.tcl
+} -cleanup {
+    safe::interpDelete $i
+    removeDirectory $testdir
+} -result {}
+rename buildEnvironment {}
 
-test safe-11.1 {testing safe encoding} {
-    set i [safe::interpCreate]
-    list \
-	    [catch {interp eval $i encoding} msg] \
-	    $msg \
-	    [safe::interpDelete $i];
-} {1 {wrong # args: should be "encoding option ?arg ...?"} {}}
-test safe-11.2 {testing safe encoding} {
-    set i [safe::interpCreate]
-    list \
-	    [catch {interp eval $i encoding system cp775} msg] \
-	    $msg \
-	    [safe::interpDelete $i];
-} {1 {wrong # args: should be "encoding system"} {}}
-test safe-11.3 {testing safe encoding} {
-    set i [safe::interpCreate]
-    set result [catch {
-	string match [encoding system] [interp eval $i encoding system]
-    } msg]
-    list $result $msg [safe::interpDelete $i]
-} {0 1 {}}
-test safe-11.4 {testing safe encoding} {
-    set i [safe::interpCreate]
-    set result [catch {
-	string match [encoding names] [interp eval $i encoding names]
-    } msg]
-    list $result $msg  [safe::interpDelete $i]
-} {0 1 {}}
-test safe-11.5 {testing safe encoding} {
-    set i [safe::interpCreate]
-    list \
-	    [catch {interp eval $i encoding convertfrom cp1258 foobar} msg] \
-	    $msg \
-	    [safe::interpDelete $i];
-} {0 foobar {}}
-test safe-11.6 {testing safe encoding} {
-    set i [safe::interpCreate]
-    list \
-	    [catch {interp eval $i encoding convertto cp1258 foobar} msg] \
-	    $msg \
-	    [safe::interpDelete $i];
-} {0 foobar {}}
-test safe-11.7 {testing safe encoding} {
-    set i [safe::interpCreate]
-    list \
-	    [catch {interp eval $i encoding convertfrom} msg] \
-	    $msg \
-	    [safe::interpDelete $i];
-} {1 {wrong # args: should be "encoding convertfrom ?encoding? data"} {}}
-test safe-11.8 {testing safe encoding} {
-    set i [safe::interpCreate]
-    list \
-	    [catch {interp eval $i encoding convertto} msg] \
-	    $msg \
-	    [safe::interpDelete $i];
-} {1 {wrong # args: should be "encoding convertto ?encoding? data"} {}}
+#### Test for the module path
+test safe-14.1 {Check that module path is the same as in the master interpreter [Bug 2964715]} -setup {
+    set i [safe::interpCreate]
+} -body {
+    set tm {}
+    foreach token [$i eval ::tcl::tm::path list] {
+        lappend tm [dict get [set ::safe::S${i}(access_path,map)] $token]
+    }
+    return $tm
+} -cleanup {
+    safe::interpDelete $i
+} -result [::tcl::tm::path list]
 
+test safe-15.1 {safe file ensemble does not surprise code} -setup {
+    set i [interp create -safe]
+} -body {
+    set result [expr {"file" in [interp hidden $i]}]
+    lappend result [interp eval $i {tcl::file::split a/b/c}]
+    lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
+    lappend result [interp invokehidden $i file split a/b/c]
+    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
+    lappend result [catch {interp invokehidden $i file isdirectory .}]
+    interp expose $i file
+    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
+    lappend result [catch {interp eval $i {file isdirectory .}} msg] $msg
+} -cleanup {
+    unset -nocomplain msg
+    interp delete $i
+} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
+test safe-15.1.1 {safe file ensemble does not surprise code} -setup {
+    set i [interp create -safe]
+} -body {
+    set result [expr {"file" in [interp hidden $i]}]
+    lappend result [interp eval $i {tcl::file::split a/b/c}]
+    lappend result [catch {interp eval $i {tcl::file::isdirectory .}}]
+    lappend result [interp invokehidden $i file split a/b/c]
+    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
+    lappend result [catch {interp invokehidden $i file isdirectory .}]
+    interp expose $i file
+    lappend result [catch {interp eval $i {file split a/b/c}} msg] $msg
+    lappend result [catch {interp eval $i {file isdirectory .}} msg o] [dict get $o -errorinfo]
+} -cleanup {
+    unset -nocomplain msg o
+    interp delete $i
+} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file
+    while executing
+"file isdirectory ."
+    invoked from within
+"interp eval $i {file isdirectory .}"}}
 
+### ~ should have no special meaning in paths in safe interpreters
+test safe-16.1 {Bug 3529949: defang ~ in paths} -setup {
+    set savedHOME $env(HOME)
+    set env(HOME) /foo/bar
+    set i [safe::interpCreate]
+} -body {
+    $i eval {
+	set d [format %c 126]
+	list [file join [file dirname $d] [file tail $d]]
+    }
+} -cleanup {
+    safe::interpDelete $i
+    set env(HOME) $savedHOME
+} -result {./~}
+test safe-16.2 {Bug 3529949: defang ~user in paths} -setup {
+    set i [safe::interpCreate]
+    set user $tcl_platform(user)
+} -body {
+    string map [list $user USER] [$i eval \
+	    "file join \[file dirname ~$user\] \[file tail ~$user\]"]
+} -cleanup {
+    safe::interpDelete $i
+} -result {./~USER}
+test safe-16.3 {Bug 3529949: defang ~ in globs} -setup {
+    set syntheticHOME [makeDirectory foo]
+    makeFile {} bar $syntheticHOME
+    set savedHOME $env(HOME)
+    set env(HOME) $syntheticHOME
+    set i [safe::interpCreate]
+} -body {
+    ::safe::interpAddToAccessPath $i $syntheticHOME
+    $i eval {glob -nocomplain ~/*}
+} -cleanup {
+    safe::interpDelete $i
+    set env(HOME) $savedHOME
+    removeDirectory $syntheticHOME
+} -result {}
+test safe-16.4 {Bug 3529949: defang ~user in globs} -setup {
+    set i [safe::interpCreate]
+} -body {
+    ::safe::interpAddToAccessPath $i $~$tcl_platform(user)
+    $i eval [list glob -nocomplain ~$tcl_platform(user)/*]
+} -cleanup {
+    safe::interpDelete $i
+} -result {}
+
 set ::auto_path $saveAutoPath
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/scan.test b/tests/scan.test
index 2bb6626..b57b641 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -1,8 +1,8 @@
 # Commands covered:  scan
 #
-# 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-1994 The Regents of the University of California.
 # Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -10,17 +10,84 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: scan.test,v 1.17 2005/07/28 18:42:33 dgp Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-::tcltest::testConstraint wideIs64bit \
-	[expr {(0x80000000 > 0) && (0x8000000000000000 < 0)}]
+# procedure that returns the range of integers
 
+proc int_range {} {
+    for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} {
+	set MIN_INT [expr { $MIN_INT << 1 }]
+    }
+    set MIN_INT [expr {int($MIN_INT)}]
+    set MAX_INT [expr { ~ $MIN_INT }]
+    return [list $MIN_INT $MAX_INT]
+}
+
+# Big test for correct ordering of data in [expr]
+
+proc testIEEE {} {
+    variable ieeeValues
+    binary scan [binary format dd -1.0 1.0] c* c
+    switch -exact -- $c {
+	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
+	    # little endian
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xff d \
+		ieeeValues(-Infinity)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\xbf d \
+		ieeeValues(-Normal)
+	    binary scan \x00\x00\x00\x00\x00\x00\x08\x80 d \
+		ieeeValues(-Subnormal)
+	    binary scan \x00\x00\x00\x00\x00\x00\x00\x80 d \
+		ieeeValues(-0)
+	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+0)
+	    binary scan \x00\x00\x00\x00\x00\x00\x08\x00 d \
+		ieeeValues(+Subnormal)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x3f d \
+		ieeeValues(+Normal)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf0\x7f d \
+		ieeeValues(+Infinity)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
+		ieeeValues(NaN)
+	    set ieeeValues(littleEndian) 1
+	    return 1
+	}
+	{-65 -16 0 0 0 0 0 0 63 -16 0 0 0 0 0 0} {
+	    binary scan \xff\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-Infinity)
+	    binary scan \xbf\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-Normal)
+	    binary scan \x80\x08\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-Subnormal)
+	    binary scan \x80\x00\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-0)
+	    binary scan \x00\x00\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+0)
+	    binary scan \x00\x08\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+Subnormal)
+	    binary scan \x3f\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+Normal)
+	    binary scan \x7f\xf0\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(+Infinity)
+	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(NaN)
+	    set ieeeValues(littleEndian) 0
+	    return 1
+	}
+	default {
+	    return 0
+	}
+    }
+}
+
+testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint wideIs64bit \
+	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
+
 test scan-1.1 {BuildCharSet, CharInSet} {
     list [scan foo {%[^o]} x] $x
 } {1 f}
@@ -45,10 +112,11 @@ test scan-1.7 {BuildCharSet, CharInSet} {
 test scan-1.8 {BuildCharSet, CharInSet} {
     list [scan def-abc {%[^c-a]} x] $x
 } {1 def-}
-test scan-1.9 {BuildCharSet, CharInSet no match} {
-    catch {unset x}
+test scan-1.9 {BuildCharSet, CharInSet no match} -setup {
+    unset -nocomplain x
+} -body {
     list [scan {= f} {= %[TF]} x] [info exists x]
-} {0 0}
+} -result {0 0}
 
 test scan-2.1 {ReleaseCharSet} {
     list [scan abcde {%[abc]} x] $x
@@ -57,53 +125,53 @@ test scan-2.2 {ReleaseCharSet} {
     list [scan abcde {%[a-c]} x] $x
 } {1 abc}
 
-test scan-3.1 {ValidateFormat} {
-    list [catch {scan {} {%d%1$d} x} msg] $msg
-} {1 {cannot mix "%" and "%n$" conversion specifiers}}
-test scan-3.2 {ValidateFormat} {
-    list [catch {scan {} {%d%1$d} x} msg] $msg
-} {1 {cannot mix "%" and "%n$" conversion specifiers}}
-test scan-3.3 {ValidateFormat} {
-    list [catch {scan {} {%2$d%d} x} msg] $msg
-} {1 {"%n$" argument index out of range}}
+test scan-3.1 {ValidateFormat} -returnCodes error -body {
+    scan {} {%d%1$d} x
+} -result {cannot mix "%" and "%n$" conversion specifiers}
+test scan-3.2 {ValidateFormat} -returnCodes error -body {
+    scan {} {%d%1$d} x
+} -result {cannot mix "%" and "%n$" conversion specifiers}
+test scan-3.3 {ValidateFormat} -returnCodes error -body {
+    scan {} {%2$d%d} x
+} -result {"%n$" argument index out of range}
 test scan-3.4 {ValidateFormat} {
     # degenerate case, before changed from 8.2 to 8.3
     list [catch {scan {} %d} msg] $msg
 } {0 {}}
-test scan-3.5 {ValidateFormat} {
-    list [catch {scan {} {%10c} a} msg] $msg
-} {1 {field width may not be specified in %c conversion}}
-test scan-3.6 {ValidateFormat} {
-    list [catch {scan {} {%*1$d} a} msg] $msg
-} {1 {bad scan conversion character "$"}}
-test scan-3.7 {ValidateFormat} {
-    list [catch {scan {} {%1$d%1$d} a} msg] $msg
-} {1 {variable is assigned by multiple "%n$" conversion specifiers}}
-test scan-3.8 {ValidateFormat} {
-    list [catch {scan {} a x} msg] $msg
-} {1 {variable is not assigned by any conversion specifiers}}
-test scan-3.9 {ValidateFormat} {
-    list [catch {scan {} {%2$s} x y} msg] $msg
-} {1 {variable is not assigned by any conversion specifiers}}
-test scan-3.10 {ValidateFormat} {
-    list [catch {scan {} {%[a} x} msg] $msg
-} {1 {unmatched [ in format string}}
-test scan-3.11 {ValidateFormat} {
-    list [catch {scan {} {%[^a} x} msg] $msg
-} {1 {unmatched [ in format string}}
-test scan-3.12 {ValidateFormat} {
-    list [catch {scan {} {%[]a} x} msg] $msg
-} {1 {unmatched [ in format string}}
-test scan-3.13 {ValidateFormat} {
-    list [catch {scan {} {%[^]a} x} msg] $msg
-} {1 {unmatched [ in format string}}
+test scan-3.5 {ValidateFormat} -returnCodes error -body {
+    scan {} {%10c} a
+} -result {field width may not be specified in %c conversion}
+test scan-3.6 {ValidateFormat} -returnCodes error -body {
+    scan {} {%*1$d} a
+} -result {bad scan conversion character "$"}
+test scan-3.7 {ValidateFormat} -returnCodes error -body {
+    scan {} {%1$d%1$d} a
+} -result {variable is assigned by multiple "%n$" conversion specifiers}
+test scan-3.8 {ValidateFormat} -returnCodes error -body {
+    scan {} a x
+} -result {variable is not assigned by any conversion specifiers}
+test scan-3.9 {ValidateFormat} -returnCodes error -body {
+    scan {} {%2$s} x y
+} -result {variable is not assigned by any conversion specifiers}
+test scan-3.10 {ValidateFormat} -returnCodes error -body {
+    scan {} {%[a} x
+} -result {unmatched [ in format string}
+test scan-3.11 {ValidateFormat} -returnCodes error -body {
+    scan {} {%[^a} x
+} -result {unmatched [ in format string}
+test scan-3.12 {ValidateFormat} -returnCodes error -body {
+    scan {} {%[]a} x
+} -result {unmatched [ in format string}
+test scan-3.13 {ValidateFormat} -returnCodes error -body {
+    scan {} {%[^]a} x
+} -result {unmatched [ in format string}
 
-test scan-4.1 {Tcl_ScanObjCmd, argument checks} {
-    list [catch {scan} msg] $msg
-} {1 {wrong # args: should be "scan string format ?varName varName ...?"}}
-test scan-4.2 {Tcl_ScanObjCmd, argument checks} {
-    list [catch {scan string} msg] $msg
-} {1 {wrong # args: should be "scan string format ?varName varName ...?"}}
+test scan-4.1 {Tcl_ScanObjCmd, argument checks} -returnCodes error -body {
+    scan
+} -result {wrong # args: should be "scan string format ?varName ...?"}
+test scan-4.2 {Tcl_ScanObjCmd, argument checks} -returnCodes error -body {
+    scan string
+} -result {wrong # args: should be "scan string format ?varName ...?"}
 test scan-4.3 {Tcl_ScanObjCmd, argument checks} {
     # degenerate case, before changed from 8.2 to 8.3
     list [catch {scan string format} msg] $msg
@@ -193,95 +261,126 @@ test scan-4.29 {Tcl_ScanObjCmd, character scanning} {
     list [scan {abcdef} {%*c%n} x] $x
 } {1 1}
 
-test scan-4.30 {Tcl_ScanObjCmd, base-10 integer scanning} {
+test scan-4.30 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {1234567890a} {%3d} x] $x
-} {1 123}
-test scan-4.31 {Tcl_ScanObjCmd, base-10 integer scanning} {
+} -result {1 123}
+test scan-4.31 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {1234567890a} {%d} x] $x
-} {1 1234567890}
-test scan-4.32 {Tcl_ScanObjCmd, base-10 integer scanning} {
+} -result {1 1234567890}
+test scan-4.32 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {01234567890a} {%d} x] $x
-} {1 1234567890}
-test scan-4.33 {Tcl_ScanObjCmd, base-10 integer scanning} {
+} -result {1 1234567890}
+test scan-4.33 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {+01234} {%d} x] $x
-} {1 1234}
-test scan-4.34 {Tcl_ScanObjCmd, base-10 integer scanning} {
+} -result {1 1234}
+test scan-4.34 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {-01234} {%d} x] $x
-} {1 -1234}
-test scan-4.35 {Tcl_ScanObjCmd, base-10 integer scanning} {
+} -result {1 -1234}
+test scan-4.35 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {a01234} {%d} x] $x
-} {0 {}}
-test scan-4.36 {Tcl_ScanObjCmd, base-10 integer scanning} {
+} -result {0 {}}
+test scan-4.36 {Tcl_ScanObjCmd, base-10 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {0x10} {%d} x] $x
-} {1 0}
-test scan-4.37 {Tcl_ScanObjCmd, base-8 integer scanning} {
+} -result {1 0}
+test scan-4.37 {Tcl_ScanObjCmd, base-8 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {012345678} {%o} x] $x
-} {1 342391}
-test scan-4.38 {Tcl_ScanObjCmd, base-8 integer scanning} {
+} -result {1 342391}
+test scan-4.38 {Tcl_ScanObjCmd, base-8 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {+1238 -1239 123a} {%o%*s%o%*s%o} x y z] $x $y $z
-} {3 83 -83 83}
-test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} {
+} -result {3 83 -83 83}
+test scan-4.39 {Tcl_ScanObjCmd, base-16 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {+1238 -123a 0123} {%x%x%x} x y z] $x $y $z
-} {3 4664 -4666 291}
-test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} {
+} -result {3 4664 -4666 291}
+test scan-4.40 {Tcl_ScanObjCmd, base-16 integer scanning} -setup {
+    set x {}
+} -body {
     # The behavior changed in 8.4a4/8.3.4cvs (6 Feb) to correctly
     # return '1' for 0x1 scanned via %x, to comply with 8.0 and C scanf.
     # Bug #495213
-    set x {}
     list [scan {aBcDeF AbCdEf 0x1} {%x%x%x} x y z] $x $y $z
-} {3 11259375 11259375 1}
-test scan-4.40.1 {Tcl_ScanObjCmd, base-16 integer scanning} {
+} -result {3 11259375 11259375 1}
+test scan-4.40.1 {Tcl_ScanObjCmd, base-16 integer scanning} -setup {
     set x {}
+} -body {
     list [scan {0xF 0x00A0B 0X0XF} {%x %x %x} x y z] $x $y $z
-} {3 15 2571 0}
-test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} {
-    catch {unset x}
+} -result {3 15 2571 0}
+test scan-4.40.2 {Tcl_ScanObjCmd, base-16 integer scanning} -setup {
+    unset -nocomplain x
+} -body {
     list [scan {xF} {%x} x] [info exists x]
-} {0 0}
-test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} {
+} -result {0 0}
+test scan-4.40.3 {Tcl_ScanObjCmd, base-2 integer scanning} -setup {
     set x {}
-    list [scan {10 010 0x10} {%i%i%i} x y z] $x $y $z
-} {3 10 8 16}
-test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} {
+} -body {
+    list [scan {1001 0b101 100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000} {%b %b %llb} x y z] $x $y $z
+} -result {3 9 5 340282366920938463463374607431768211456}
+test scan-4.41 {Tcl_ScanObjCmd, base-unknown integer scanning} -setup {
     set x {}
+} -body {
+    list [scan {10 010 0x10 0b10} {%i%i%i%i} x y z t] $x $y $z $t
+} -result {4 10 8 16 0}
+test scan-4.42 {Tcl_ScanObjCmd, base-unknown integer scanning} -setup {
+    set x {}
+} -body {
     list [scan {10 010 0X10} {%i%i%i} x y z] $x $y $z
-} {3 10 8 16}
-test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} {
+} -result {3 10 8 16}
+test scan-4.43 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
     set x {}
+} -body {
     list [scan {+ } {%i} x] $x
-} {0 {}}
-test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} {
+} -result {0 {}}
+test scan-4.44 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
     set x {}
+} -body {
     list [scan {+} {%i} x] $x
-} {-1 {}}
-test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} {
+} -result {-1 {}}
+test scan-4.45 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
     set x {}
+} -body {
     list [scan {0x} {%i%s} x y] $x $y
-} {2 0 x}
-test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} {
+} -result {2 0 x}
+test scan-4.46 {Tcl_ScanObjCmd, integer scanning, odd cases} -setup {
     set x {}
+} -body {
     list [scan {0X} {%i%s} x y] $x $y
-} {2 0 X}
-test scan-4.47 {Tcl_ScanObjCmd, integer scanning, suppressed} {
+} -result {2 0 X}
+test scan-4.47 {Tcl_ScanObjCmd, integer scanning, suppressed} -setup {
     set x {}
+} -body {
     list [scan {123def} {%*i%s} x] $x
-} {1 def}
+} -result {1 def}
 test scan-4.48 {Tcl_ScanObjCmd, float scanning} {
     list [scan {1 2 3} {%e %f %g} x y z] $x $y $z
 } {3 1.0 2.0 3.0}
 test scan-4.49 {Tcl_ScanObjCmd, float scanning} {
     list [scan {.1 0.2 3.} {%e %f %g} x y z] $x $y $z
 } {3 0.1 0.2 3.0}
+test scan-4.49-uc-1 {Tcl_ScanObjCmd, float scanning} {
+    list [scan {0.5*0.75} {%E%c%G} x y z] $x $y $z
+} {3 0.5 42 0.75}
+test scan-4.49-uc-2 {Tcl_ScanObjCmd, float scanning} {
+    list [scan {5e-1*75E-2} {%E%c%G} x y z] $x $y $z
+} {3 0.5 42 0.75}
 test scan-4.50 {Tcl_ScanObjCmd, float scanning} {
     list [scan {1234567890a} %f x] $x
 } {1 1234567890.0}
@@ -297,284 +396,324 @@ test scan-4.53 {Tcl_ScanObjCmd, float scanning} {
 test scan-4.54 {Tcl_ScanObjCmd, float scanning} {
     list [scan {1.0e-1} %f x] $x
 } {1 0.1}
-test scan-4.55 {Tcl_ScanObjCmd, odd cases} {
+test scan-4.55 {Tcl_ScanObjCmd, odd cases} -setup {
     set x {}
+} -body {
     list [scan {+} %f x] $x
-} {-1 {}}
-test scan-4.56 {Tcl_ScanObjCmd, odd cases} {
+} -result {-1 {}}
+test scan-4.56 {Tcl_ScanObjCmd, odd cases} -setup {
     set x {}
+} -body {
     list [scan {1.0e} %f%s x y] $x $y
-} {2 1.0 e}
-test scan-4.57 {Tcl_ScanObjCmd, odd cases} {
+} -result {2 1.0 e}
+test scan-4.57 {Tcl_ScanObjCmd, odd cases} -setup {
     set x {}
+} -body {
     list [scan {1.0e+} %f%s x y] $x $y
-} {2 1.0 e+}
-test scan-4.58 {Tcl_ScanObjCmd, odd cases} {
+} -result {2 1.0 e+}
+test scan-4.58 {Tcl_ScanObjCmd, odd cases} -setup {
     set x {}
     set y {}
+} -body {
     list [scan {e1} %f%s x y] $x $y
-} {0 {} {}}
+} -result {0 {} {}}
 test scan-4.59 {Tcl_ScanObjCmd, float scanning} {
     list [scan {1.0e-1x} %*f%n x] $x
 } {1 6}
 
-test scan-4.60 {Tcl_ScanObjCmd, set errors} {
+test scan-4.60 {Tcl_ScanObjCmd, set errors} -setup {
     set x {}
     set y {}
-    catch {unset z}; array set z {}
-    set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \
-	    $msg $x $y]
-    unset z
-    set result
-} {1 {couldn't set variable "z"} abc ghi}
-test scan-4.61 {Tcl_ScanObjCmd, set errors} {
+    unset -nocomplain z
+} -body {
+    array set z {}
+    list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x $y
+} -cleanup {
+    unset -nocomplain z
+} -result {1 {can't set "z": variable is array} abc ghi}
+test scan-4.61 {Tcl_ScanObjCmd, set errors} -setup {
     set x {}
-    catch {unset y}; array set y {}
-    catch {unset z}; array set z {}
-    set result [list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] \
-	    $msg $x]
-    unset y
-    unset z
-    set result
-} {1 {couldn't set variable "z"couldn't set variable "y"} abc}
-
-# procedure that returns the range of integers
-
-proc int_range {} {
-    for { set MIN_INT 1 } { $MIN_INT > 0 } {} {
-	set MIN_INT [expr { $MIN_INT << 1 }]
-    }
-    set MAX_INT [expr { ~ $MIN_INT }]
-    return [list $MIN_INT $MAX_INT]
-}
+    unset -nocomplain y
+    unset -nocomplain z
+} -body {
+    array set y {}
+    array set z {}
+    list [catch {scan {abc def ghi} {%s%s%s} x z y} msg] $msg $x
+} -cleanup {
+    unset -nocomplain y
+    unset -nocomplain z
+} -result {1 {can't set "z": variable is array} abc}
 
 test scan-4.62 {scanning of large and negative octal integers} {
-    foreach { MIN_INT MAX_INT } [int_range] {}
+    lassign [int_range] MIN_INT MAX_INT
     set scanstring [format {%o %o %o} -1 $MIN_INT $MAX_INT]
     list [scan $scanstring {%o %o %o} a b c] \
 	[expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
 } {3 1 1 1}
 test scan-4.63 {scanning of large and negative hex integers} {
-    foreach { MIN_INT MAX_INT } [int_range] {}
+    lassign [int_range] MIN_INT MAX_INT
     set scanstring [format {%x %x %x} -1 $MIN_INT $MAX_INT]
     list [scan $scanstring {%x %x %x} a b c] \
 	[expr { $a == -1 }] [expr { $b == $MIN_INT }] [expr { $c == $MAX_INT }]
 } {3 1 1 1}
+test scan-4.64 {scanning of hex with %X} {
+    scan "123 abc f78" %X%X%X
+} {291 2748 3960}
 
-# clean up from last two tests
-
-catch {
-    rename int_range {}
-}
-
-test scan-5.1 {integer scanning} {
+test scan-5.1 {integer scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "-20 1476 \n33 0" "%d %d %d %d" a b c d] $a $b $c $d
-} {4 -20 1476 33 0}
-test scan-5.2 {integer scanning} {
+} -result {4 -20 1476 33 0}
+test scan-5.2 {integer scanning} -setup {
     set a {}; set b {}; set c {}
+} -body {
     list [scan "-45 16 7890 +10" "%2d %*d %10d %d" a b c] $a $b $c
-} {3 -4 16 7890}
-test scan-5.3 {integer scanning} {
+} -result {3 -4 16 7890}
+test scan-5.3 {integer scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "-45 16 +10 987" "%ld %d %ld %d" a b c d] $a $b $c $d
-} {4 -45 16 10 987}
-test scan-5.4 {integer scanning} {
+} -result {4 -45 16 10 987}
+test scan-5.4 {integer scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "14 1ab 62 10" "%d %x %lo %x" a b c d] $a $b $c $d
-} {4 14 427 50 16}
-test scan-5.5 {integer scanning} {
+} -result {4 14 427 50 16}
+test scan-5.5 {integer scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "12345670 1234567890ab cdefg" "%o	 %o %x %lx" a b c d] \
 	    $a $b $c $d
-} {4 2739128 342391 561323 52719}
-test scan-5.6 {integer scanning} {
+} -result {4 2739128 342391 561323 52719}
+test scan-5.6 {integer scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "ab123-24642" "%2x %3x %3o %2o" a b c d] $a $b $c $d
-} {4 171 291 -20 52}
-test scan-5.7 {integer scanning} {
+} -result {4 171 291 -20 52}
+test scan-5.7 {integer scanning} -setup {
     set a {}; set b {}
+} -body {
     list [scan "1234567 234 567  " "%*3x %x %*o %4o" a b] $a $b
-} {2 17767 375}
-test scan-5.8 {integer scanning} {
+} -result {2 17767 375}
+test scan-5.8 {integer scanning} -setup {
     set a {}; set b {}
+} -body {
     list [scan "a	1234" "%d %d" a b] $a $b
-} {0 {} {}}
-test scan-5.9 {integer scanning} {
-    set a {}; set b {}; set c {}; set d {};
+} -result {0 {} {}}
+test scan-5.9 {integer scanning} -setup {
+    set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "12345678" "%2d %2d %2ld %2d" a b c d] $a $b $c $d
-} {4 12 34 56 78}
-test scan-5.10 {integer scanning} {
+} -result {4 12 34 56 78}
+test scan-5.10 {integer scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "1 2 " "%hd %d %d %d" a b c d] $a $b $c $d
-} {2 1 2 {} {}}
+} -result {2 1 2 {} {}}
 #
-# The behavior for scaning intergers larger than MAX_INT is
-# not defined by the ANSI spec.  Some implementations wrap the
-# input (-16) some return MAX_INT.
+# The behavior for scaning intergers larger than MAX_INT is not defined by the
+# ANSI spec.  Some implementations wrap the input (-16) some return MAX_INT.
 #
-test scan-5.11 {integer scanning} {nonPortable} {
-    set a {}; set b {};
+test scan-5.11 {integer scanning} -constraints {nonPortable} -setup {
+    set a {}; set b {}
+} -body {
     list [scan "4294967280 4294967280" "%u %d" a b] $a \
 	    [expr {$b == -16 || $b == 0x7fffffff}]
-} {2 4294967280 1}
-test scan-5.12 {integer scanning} {wideIs64bit} {
+} -result {2 4294967280 1}
+test scan-5.12 {integer scanning} -constraints {wideIs64bit} -setup {
     set a {}; set b {}; set c {}
+} -body {
     list [scan "7810179016327718216,6c63546f6c6c6548,661432506755433062510" \
 	    %ld,%lx,%lo a b c] $a $b $c
-} {3 7810179016327718216 7810179016327718216 7810179016327718216}
+} -result {3 7810179016327718216 7810179016327718216 7810179016327718216}
 test scan-5.13 {integer scanning and overflow} {
     # This test used to fail on some 64-bit systems. [Bug 1011860]
     scan {300000000 3000000000 30000000000} {%ld %ld %ld}
 } {300000000 3000000000 30000000000}
 
-test scan-6.1 {floating-point scanning} {
+test scan-5.14 {integer scanning} {
+    scan 0xff %u
+} 0
+
+test scan-6.1 {floating-point scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "2.1 -3.0e8 .99962 a" "%f%g%e%f" a b c d] $a $b $c $d
-} {3 2.1 -300000000.0 0.99962 {}}
-test scan-6.2 {floating-point scanning} {
+} -result {3 2.1 -300000000.0 0.99962 {}}
+test scan-6.2 {floating-point scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "-1.2345 +8.2 9" "%3e %3lf %f %f" a b c d] $a $b $c $d
-} {4 -1.0 234.0 5.0 8.2}
-test scan-6.3 {floating-point scanning} {
+} -result {4 -1.0 234.0 5.0 8.2}
+test scan-6.3 {floating-point scanning} -setup {
     set a {}; set b {}; set c {}
+} -body {
     list [scan "1e00004 332E-4 3e+4" "%Lf %*2e %f %f" a b c] $a $c
-} {3 10000.0 30000.0}
+} -result {3 10000.0 30000.0}
 #
-# Some libc implementations consider 3.e- bad input.  The ANSI
-# spec states that digits must follow the - sign.
+# Some libc implementations consider 3.e- bad input.  The ANSI spec states
+# that digits must follow the - sign.
 #
-test scan-6.4 {floating-point scanning} {
+test scan-6.4 {floating-point scanning} -setup {
     set a {}; set b {}; set c {}
+} -body {
     list [scan "1. 47.6 2.e2 3.e-" "%f %*f %f %f" a b c] $a $b $c
-} {3 1.0 200.0 3.0}
-test scan-6.5 {floating-point scanning} {
+} -result {3 1.0 200.0 3.0}
+test scan-6.5 {floating-point scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "4.6 99999.7 876.43e-1 118" "%f %f %f %e" a b c d] $a $b $c $d
-} {4 4.6 99999.7 87.643 118.0}
-test scan-6.6 {floating-point scanning} {
+} -result {4 4.6 99999.7 87.643 118.0}
+test scan-6.6 {floating-point scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "1.2345 697.0e-3 124 .00005" "%f %e %f %e" a b c d] $a $b $c $d
-} {4 1.2345 0.697 124.0 5e-5}
-test scan-6.7 {floating-point scanning} {
+} -result {4 1.2345 0.697 124.0 5e-5}
+test scan-6.7 {floating-point scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "4.6abc" "%f %f %f %f" a b c d] $a $b $c $d
-} {1 4.6 {} {} {}}
-test scan-6.8 {floating-point scanning} {
+} -result {1 4.6 {} {} {}}
+test scan-6.8 {floating-point scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "4.6 5.2" "%f %f %f %f" a b c d] $a $b $c $d
-} {2 4.6 5.2 {} {}}
+} -result {2 4.6 5.2 {} {}}
 
-test scan-7.1 {string and character scanning} {
+test scan-7.1 {string and character scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "abc defghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
-} {4 abc def ghijk dum}
-test scan-7.2 {string and character scanning} {
+} -result {4 abc def ghijk dum}
+test scan-7.2 {string and character scanning} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "a       bcdef" "%c%c%1s %s" a b c d] $a $b $c $d
-} {4 97 32 b cdef}
-test scan-7.3 {string and character scanning} {
+} -result {4 97 32 b cdef}
+test scan-7.3 {string and character scanning} -setup {
     set a {}; set b {}; set c {}
+} -body {
     list [scan "123456 test " "%*c%*s %s %s %s" a b c] $a $b $c
-} {1 test {} {}}
-test scan-7.4 {string and character scanning} {
-    set a {}; set b {}; set c {}; set d
+} -result {1 test {} {}}
+test scan-7.4 {string and character scanning} -setup {
+    set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "ababcd01234  f 123450" {%4[abcd] %4[abcd] %[^abcdef] %[^0]} a b c d] $a $b $c $d
-} {4 abab cd {01234  } {f 12345}}
-test scan-7.5 {string and character scanning} {
+} -result {4 abab cd {01234  } {f 12345}}
+test scan-7.5 {string and character scanning} -setup {
     set a {}; set b {}; set c {}
+} -body {
     list [scan "aaaaaabc aaabcdefg  + +  XYZQR" {%*4[a] %s %*4[a]%s%*4[ +]%c} a b c] $a $b $c
-} {3 aabc bcdefg 43}
-test scan-7.6 {string and character scanning, unicode} {
+} -result {3 aabc bcdefg 43}
+test scan-7.6 {string and character scanning, unicode} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "abc d\u00c7fghijk dum " "%s %3s %20s %s" a b c d] $a $b $c $d
-} "4 abc d\u00c7f ghijk dum"
-test scan-7.7 {string and character scanning, unicode} {
+} -result "4 abc d\u00c7f ghijk dum"
+test scan-7.7 {string and character scanning, unicode} -setup {
     set a {}; set b {}
+} -body {
     list [scan "ab\u00c7cdef" "ab%c%c" a b] $a $b
-} "2 199 99"
-test scan-7.8 {string and character scanning, unicode} {
+} -result "2 199 99"
+test scan-7.8 {string and character scanning, unicode} -setup {
     set a {}; set b {}
+} -body {
     list [scan "ab\ufeffdef" "%\[ab\ufeff\]" a] $a
-} "1 ab\ufeff"
+} -result "1 ab\ufeff"
 
-test scan-8.1 {error conditions} {
-    catch {scan a}
-} 1
-test scan-8.2 {error conditions} {
-    catch {scan a} msg
-    set msg
-} {wrong # args: should be "scan string format ?varName varName ...?"}
-test scan-8.3 {error conditions} {
-    list [catch {scan a %D x} msg] $msg
-} {1 {bad scan conversion character "D"}}
-test scan-8.4 {error conditions} {
-    list [catch {scan a %O x} msg] $msg
-} {1 {bad scan conversion character "O"}}
-test scan-8.5 {error conditions} {
-    list [catch {scan a %X x} msg] $msg
-} {1 {bad scan conversion character "X"}}
-test scan-8.6 {error conditions} {
-    list [catch {scan a %F x} msg] $msg
-} {1 {bad scan conversion character "F"}}
-test scan-8.7 {error conditions} {
-    list [catch {scan a %E x} msg] $msg
-} {1 {bad scan conversion character "E"}}
-test scan-8.8 {error conditions} {
-    list [catch {scan a "%d %d" a} msg] $msg
-} {1 {different numbers of variable names and field specifiers}}
-test scan-8.9 {error conditions} {
-    list [catch {scan a "%d %d" a b c} msg] $msg
-} {1 {variable is not assigned by any conversion specifiers}}
-test scan-8.10 {error conditions} {
+test scan-8.1 {error conditions} -body {
+    scan a
+} -returnCodes error -match glob -result *
+test scan-8.2 {error conditions} -returnCodes error -body {
+    scan a
+} -result {wrong # args: should be "scan string format ?varName ...?"}
+test scan-8.3 {error conditions} -returnCodes error -body {
+    scan a %D x
+} -result {bad scan conversion character "D"}
+test scan-8.4 {error conditions} -returnCodes error -body {
+    scan a %O x
+} -result {bad scan conversion character "O"}
+test scan-8.5 {error conditions} -returnCodes error -body {
+    scan a %B x
+} -result {bad scan conversion character "B"}
+test scan-8.6 {error conditions} -returnCodes error -body {
+    scan a %F x
+} -result {bad scan conversion character "F"}
+test scan-8.7 {error conditions} -returnCodes error -body {
+    scan a %p x
+} -result {bad scan conversion character "p"}
+test scan-8.8 {error conditions} -returnCodes error -body {
+    scan a "%d %d" a
+} -result {different numbers of variable names and field specifiers}
+test scan-8.9 {error conditions} -returnCodes error -body {
+    scan a "%d %d" a b c
+} -result {variable is not assigned by any conversion specifiers}
+test scan-8.10 {error conditions} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [expr {[scan "  a" " a %d %d %d %d" a b c d] <= 0}] $a $b $c $d
-} {1 {} {} {} {}}
-test scan-8.11 {error conditions} {
+} -result {1 {} {} {} {}}
+test scan-8.11 {error conditions} -setup {
     set a {}; set b {}; set c {}; set d {}
+} -body {
     list [scan "1 2" "%d %d %d %d" a b c d] $a $b $c $d
-} {2 1 2 {} {}}
-test scan-8.12 {error conditions} {
-    catch {unset a}
+} -result {2 1 2 {} {}}
+test scan-8.12 {error conditions} -setup {
+    unset -nocomplain a
+} -body {
     set a(0) 44
-    list [catch {scan 44 %d a} msg] $msg
-} {1 {couldn't set variable "a"}}
-test scan-8.13 {error conditions} {
-    catch {unset a}
+    scan 44 %d a
+} -returnCodes error -cleanup {
+    unset -nocomplain a
+} -result {can't set "a": variable is array}
+test scan-8.13 {error conditions} -setup {
+    unset -nocomplain a
+} -body {
     set a(0) 44
-    list [catch {scan 44 %c a} msg] $msg
-} {1 {couldn't set variable "a"}}
-test scan-8.14 {error conditions} {
-    catch {unset a}
+    scan 44 %c a
+} -returnCodes error -cleanup {
+    unset -nocomplain a
+} -result {can't set "a": variable is array}
+test scan-8.14 {error conditions} -setup {
+    unset -nocomplain a
+} -body {
     set a(0) 44
-    list [catch {scan 44 %s a} msg] $msg
-} {1 {couldn't set variable "a"}}
-test scan-8.15 {error conditions} {
-    catch {unset a}
+    scan 44 %s a
+} -returnCodes error -cleanup {
+    unset -nocomplain a
+} -result {can't set "a": variable is array}
+test scan-8.15 {error conditions} -setup {
+    unset -nocomplain a
+} -body {
     set a(0) 44
-    list [catch {scan 44 %f a} msg] $msg
-} {1 {couldn't set variable "a"}}
-test scan-8.16 {error conditions} {
-    catch {unset a}
+    scan 44 %f a
+} -returnCodes error -cleanup {
+    unset -nocomplain a
+} -result {can't set "a": variable is array}
+test scan-8.16 {error conditions} -setup {
+    unset -nocomplain a
+} -body {
     set a(0) 44
-    list [catch {scan 44 %f a} msg] $msg
-} {1 {couldn't set variable "a"}}
-catch {unset a}
-test scan-8.17 {error conditions} {
-    list [catch {scan 44 %2c a} msg] $msg
-} {1 {field width may not be specified in %c conversion}}
-test scan-8.18 {error conditions} {
-    list [catch {scan abc {%[} x} msg] $msg
-} {1 {unmatched [ in format string}}
-test scan-8.19 {error conditions} {
-    list [catch {scan abc {%[^a} x} msg] $msg
-} {1 {unmatched [ in format string}}
-test scan-8.20 {error conditions} {
-    list [catch {scan abc {%[^]a} x} msg] $msg
-} {1 {unmatched [ in format string}}
-test scan-8.21 {error conditions} {
-    list [catch {scan abc {%[]a} x} msg] $msg
-} {1 {unmatched [ in format string}}
+    scan 44 %f a
+} -returnCodes error -cleanup {
+    unset -nocomplain a
+} -result {can't set "a": variable is array}
+test scan-8.17 {error conditions} -returnCodes error -body {
+    scan 44 %2c a
+} -result {field width may not be specified in %c conversion}
+test scan-8.18 {error conditions} -returnCodes error -body {
+    scan abc {%[} x
+} -result {unmatched [ in format string}
+test scan-8.19 {error conditions} -returnCodes error -body {
+    scan abc {%[^a} x
+} -result {unmatched [ in format string}
+test scan-8.20 {error conditions} -returnCodes error -body {
+    scan abc {%[^]a} x
+} -result {unmatched [ in format string}
+test scan-8.21 {error conditions} -returnCodes error -body {
+    scan abc {%[]a} x
+} -result {unmatched [ in format string}
 
 test scan-9.1 {lots of arguments} {
     scan "10 20 30 40 50 60 70 80 90 100 110 120 130 140 150 160 170 180 190 200" "%d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d" a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20
@@ -584,27 +723,38 @@ test scan-9.2 {lots of arguments} {
     set a20
 } 200
 
-test scan-10.1 {miscellaneous tests} {
+test scan-10.1 {miscellaneous tests} -setup {
     set a {}
+} -body {
     list [scan ab16c ab%dc a] $a
-} {1 16}
-test scan-10.2 {miscellaneous tests} {
+} -result {1 16}
+test scan-10.2 {miscellaneous tests} -setup {
     set a {}
+} -body {
     list [scan ax16c ab%dc a] $a
-} {0 {}}
-test scan-10.3 {miscellaneous tests} {
+} -result {0 {}}
+test scan-10.3 {miscellaneous tests} -setup {
     set a {}
+} -body {
     list [catch {scan ab%c114 ab%%c%d a} msg] $msg $a
-} {0 1 114}
-test scan-10.4 {miscellaneous tests} {
+} -result {0 1 114}
+test scan-10.4 {miscellaneous tests} -setup {
     set a {}
+} -body {
     list [catch {scan ab%c14 ab%%c%d a} msg] $msg $a
-} {0 1 14}
-test scan-10.5 {miscellaneous tests} {
-    catch {unset arr}
+} -result {0 1 14}
+test scan-10.5 {miscellaneous tests} -setup {
+    unset -nocomplain arr
+} -body {
     set arr(2) {}
     list [catch {scan ab%c14 ab%%c%d arr(2)} msg] $msg $arr(2)
-} {0 1 14}
+} -result {0 1 14}
+test scan-10.6 {miscellaneous tests} {
+    scan 5a {%i%[a]}
+} {5 a}
+test scan-10.7 {miscellaneous tests} {
+    scan {5 a} {%i%[a]}
+} {5 {}}
 
 test scan-11.1 {alignment in results array (TCL_ALIGN)} {
     scan "123 13.6" "%s %f" a b
@@ -658,9 +808,9 @@ test scan-13.1 {Tcl_ScanObjCmd, inline XPG case} {
 test scan-13.2 {Tcl_ScanObjCmd, inline XPG case} {
     scan abc {%1$c%2$c%3$c%4$c}
 } {97 98 99 {}}
-test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} {
-    list [catch {scan abc {%1$c%1$c}} msg] $msg
-} {1 {variable is assigned by multiple "%n$" conversion specifiers}}
+test scan-13.3 {Tcl_ScanObjCmd, inline XPG case} -returnCodes error -body {
+    scan abc {%1$c%1$c}
+} -result {variable is assigned by multiple "%n$" conversion specifiers}
 test scan-13.4 {Tcl_ScanObjCmd, inline XPG case} {
     scan abc {%2$s%1$c}
 } {{} abc}
@@ -679,6 +829,25 @@ test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
     list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
 } {200 10 20 30}
 
+# scan infinities - not working
+
+test scan-14.1 {positive infinity} {
+    scan Inf %g d
+    return $d
+} Inf
+test scan-14.2 {negative infinity} {
+    scan -Inf %g d
+    return $d
+} -Inf
+
+# TODO - also need to scan NaN's
+
+catch {rename int_range {}}
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/security.test b/tests/security.test
index 2549a4a..eeabc9c 100644
--- a/tests/security.test
+++ b/tests/security.test
@@ -1,18 +1,16 @@
 # security.test --
 #
-# Functionality covered: this file contains a collection of tests for the
-# auto loading and namespaces.
+# Functionality covered: this file contains a collection of tests for the auto
+# loading and namespaces.
 #
-# 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.
 # All rights reserved.
-#
-# RCS: @(#) $Id: security.test,v 1.6 2004/05/19 13:02:10 dkf Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
@@ -41,3 +39,7 @@ test security-1.1 {tcl_endOfPreviousWord} {
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/set-old.test b/tests/set-old.test
index 722dbb3..4c25ec5 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -12,8 +12,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: set-old.test,v 1.17 2003/03/27 21:44:05 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -21,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 proc ignore args {}
-
+
 # Simple variable operations.
 
 catch {unset a}
@@ -206,7 +204,7 @@ test set-old-7.2 {unset command} {
     list [catch {unset} msg] $msg
 } {0 {}}
 # Used to return:
-#{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName varName ...?"}}
+#{1 {wrong # args: should be "unset ?-nocomplain? ?--? ?varName ...?"}}
 test set-old-7.3 {unset command} {
     catch {unset a}
     list [catch {unset a} msg] $msg
@@ -312,10 +310,10 @@ test set-old-7.18 {unset command, -nocomplain (no abbreviation)} {
 
 test set-old-8.1 {array command} {
     list [catch {array} msg] $msg
-} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
+} {1 {wrong # args: should be "array subcommand ?arg ...?"}}
 test set-old-8.2 {array command} {
     list [catch {array a} msg] $msg
-} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
+} {1 {wrong # args: should be "array anymore arrayName searchId"}}
 test set-old-8.3 {array command} {
     catch {unset a}
     list [catch {array anymore a b} msg] $msg
@@ -337,7 +335,7 @@ test set-old-8.6 {array command} {
     catch {unset a}
     set a(22) 3
     list [catch {array gorp a} msg] $msg
-} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
+} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
 test set-old-8.7 {array command, anymore option} {
     catch {unset a}
     list [catch {array anymore a x} msg] $msg
@@ -387,7 +385,7 @@ test set-old-8.14 {array command, exists option, array doesn't exist yet but has
 } {0 0}
 test set-old-8.15 {array command, get option} {
     list [catch {array get} msg] $msg
-} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
+} {1 {wrong # args: should be "array get arrayName ?pattern?"}}
 test set-old-8.16 {array command, get option} {
     list [catch {array get a b c} msg] $msg
 } {1 {wrong # args: should be "array get arrayName ?pattern?"}}
@@ -550,7 +548,7 @@ test set-old-8.38.6 {array command, set with non-existent namespace} {
 } {1 {can't set "bogusnamespace::var": parent namespace doesn't exist}}
 test set-old-8.38.7 {array command, set with non-existent namespace} {
     list [catch {array set bogusnamespace::var(0) {a b}} msg] $msg
-} {1 {can't set "bogusnamespace::var(0)": variable isn't array}}
+} {1 {can't set "bogusnamespace::var(0)": parent namespace doesn't exist}}
 test set-old-8.39 {array command, size option} {
     catch {unset a}
     array size a
@@ -671,9 +669,20 @@ test set-old-8.55 {array command, array names -glob} {
     list [catch {array names a -glob} msg] $msg
 } {0 -glob}
 test set-old-8.56 {array command, array statistics on a non-array} {
-	catch {unset a}
-	list [catch {array statistics a} msg] $msg
+    catch {unset a}
+    list [catch {array statistics a} msg] $msg
 } [list 1 "\"a\" isn't an array"]
+test set-old-8.57 {array command, array get with trivial pattern} {
+    catch {unset a}
+    set a(x) 1
+    set a(y) 2
+    array get a x
+} {x 1}
+test set-old-8.58 {array command, array set with LVT and odd length literal} {
+    list [catch {apply {{} {
+	array set a {b c d}
+    }}} msg] $msg
+} {1 {list must have an even number of elements}}
 
 test set-old-9.1 {ids for array enumeration} {
     catch {unset a}
@@ -788,7 +797,7 @@ test set-old-9.12 {array enumeration with traced undefined elements} {
 
 test set-old-10.1 {array enumeration errors} {
     list [catch {array start} msg] $msg
-} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
+} {1 {wrong # args: should be "array startsearch arrayName"}}
 test set-old-10.2 {array enumeration errors} {
     list [catch {array start a b} msg] $msg
 } {1 {wrong # args: should be "array startsearch arrayName"}}
@@ -906,14 +915,19 @@ test set-old-12.2 {cleanup on procedure return} {
     }
     foo
 } 23456
-
+
 # Must delete variables when done, since these arrays get used as
 # scalars by other tests.
 catch {unset a}
 catch {unset b}
 catch {unset c}
 catch {unset aVaRnAmE}
+catch {rename foo {}}
 
 # cleanup
 ::tcltest::cleanupTests
 return 
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/set.test b/tests/set.test
index ce1d31a..18119f5 100644
--- a/tests/set.test
+++ b/tests/set.test
@@ -9,14 +9,17 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: set.test,v 1.9 2004/11/03 17:16:05 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testset2 [llength [info commands testset2]]
+
 catch {unset x}
 catch {unset i}
 
@@ -190,9 +193,9 @@ test set-1.22 {TclCompileSetCmd: doing assignment, large int} {
 } 200000
 test set-1.23 {TclCompileSetCmd: doing assignment, formatted int != int} {
     set i 25
-    set i 000012345     ;# an octal literal == 5349 decimal
+    set i 0o00012345     ;# an octal literal == 5349 decimal
     list $i [incr i]
-} {000012345 5350}
+} {0o00012345 5350}
 
 test set-1.24 {TclCompileSetCmd: too many arguments} {
     set i 10
@@ -233,7 +236,8 @@ test set-1.26 {TclCompileSetCmd: various array constructs} {
 {b c} foo 51}]; # " just a matching end quote
 
 test set-2.1 {set command: runtime error, bad variable name} {
-    list [catch {set {"foo}} msg] $msg $errorInfo
+    unset -nocomplain {"foo}
+    list [catch {set {"foo}} msg] $msg $::errorInfo
 } {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
     while executing
 "set {"foo}"}}
@@ -251,7 +255,7 @@ test set-2.4 {set command: runtime error, readonly variable} -body {
     proc readonly args {error "variable is read-only"}
     set x 123
     trace var x w readonly
-    list [catch {set x 1} msg] $msg $errorInfo
+    list [catch {set x 1} msg] $msg $::errorInfo
 } -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
 *
@@ -464,9 +468,9 @@ test set-3.22 {uncompiled set command: doing assignment, large int} {
 test set-3.23 {uncompiled set command: doing assignment, formatted int != int} {
     set z set
     $z i 25
-    $z i 000012345     ;# an octal literal == 5349 decimal
+    $z i 0o00012345     ;# an octal literal == 5349 decimal
     list $i [incr i]
-} {000012345 5350}
+} {0o00012345 5350}
 
 test set-3.24 {uncompiled set command: too many arguments} {
     set z set
@@ -476,8 +480,9 @@ test set-3.24 {uncompiled set command: too many arguments} {
 } {wrong # args: should be "set varName ?newValue?"}
 
 test set-4.1 {uncompiled set command: runtime error, bad variable name} {
+    unset -nocomplain {"foo}
     set z set
-    list [catch {$z {"foo}} msg] $msg $errorInfo
+    list [catch {$z {"foo}} msg] $msg $::errorInfo
 } {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
     while executing
 "$z {"foo}"}}
@@ -498,7 +503,7 @@ test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
     proc readonly args {error "variable is read-only"}
     $z x 123
     trace var x w readonly
-    list [catch {$z x 1} msg] $msg $errorInfo
+    list [catch {$z x 1} msg] $msg $::errorInfo
 } -match glob -result {1 {can't set "x": variable is read-only} {*variable is read-only
     while executing
 *
@@ -512,6 +517,18 @@ test set-4.6 {set command: runtime error, basic array operations} {
     list [catch {$z a} msg] $msg
 } {1 {can't read "a": variable is array}}
 
+test set-5.1 {error on malformed array name} testset2 {
+    unset -nocomplain z
+    catch {testset2 z(a) b} msg
+    catch {testset2 z(b) a} msg1
+    list $msg $msg1
+} {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
+
+# In a mem-debug build, this test will crash unless Bug 3602706 is fixed.
+test set-5.2 {Bug 3602706} -body {
+    testset2 ::tcl_platform not-in-there
+} -returnCodes error -result * -match glob
+
 # cleanup
 catch {unset a}
 catch {unset b}
diff --git a/tests/socket.test b/tests/socket.test
index 46a3cd2..51219e6 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1,59 +1,57 @@
 # Commands tested in this file: socket.
 #
-# 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) 1994-1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-2000 Ajuba Solutions.
 #
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: socket.test,v 1.37 2005/07/17 22:25:04 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 # Running socket tests with a remote server:
 # ------------------------------------------
-# 
+#
 # Some tests in socket.test depend on the existence of a remote server to
 # which they connect. The remote server must be an instance of tcltest and it
 # must run the script found in the file "remote.tcl" in this directory. You
 # can start the remote server on any machine reachable from the machine on
 # which you want to run the socket tests, by issuing:
-# 
+#
 #     tcltest remote.tcl -port 2048	# Or choose another port number.
-# 
+#
 # If the machine you are running the remote server on has several IP
 # interfaces, you can choose which interface the server listens on for
 # connections by specifying the -address command line flag, so:
-# 
+#
 #     tcltest remote.tcl -address your.machine.com
-# 
+#
 # These options can also be set by environment variables. On Unix, you can
 # type these commands to the shell from which the remote server is started:
-# 
+#
 #     shell% setenv serverPort 2048
 #     shell% setenv serverAddress your.machine.com
-# 
+#
 # and subsequently you can start the remote server with:
-# 
+#
 #     tcltest remote.tcl
-# 
+#
 # to have it listen on port 2048 on the interface your.machine.com.
-#     
+#
 # When the server starts, it prints out a detailed message containing its
 # configuration information, and it will block until killed with a Ctrl-C.
-# Once the remote server exists, you can run the tests in socket.test with
-# the server by setting two Tcl variables:
-# 
+# Once the remote server exists, you can run the tests in socket.test with the
+# server by setting two Tcl variables:
+#
 #     % set remoteServerIP <name or address of machine on which server runs>
 #     % set remoteServerPort 2048
-# 
+#
 # These variables are also settable from the environment. On Unix, you can:
-# 
+#
 #     shell% setenv remoteServerIP machine.where.server.runs
 #     shell% senetv remoteServerPort 2048
-# 
+#
 # The preamble of the socket.test file checks to see if the variables are set
 # either in Tcl or in the environment; if they are, it attempts to connect to
 # the server. If the connection is successful, the tests using the remote
@@ -65,12 +63,34 @@
 package require tcltest 2
 namespace import -force ::tcltest::*
 
-# Some tests require the testthread and exec commands
-testConstraint testthread [llength [info commands testthread]]
+# Some tests require the Thread package or exec command
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
 testConstraint exec [llength [info commands exec]]
 
-# If remoteServerIP or remoteServerPort are not set, check in the
-# environment variables for externally set values.
+# Produce a random port number in the Dynamic/Private range
+# from 49152 through 65535.
+proc randport {} { expr {int(rand()*16383+49152)} }
+
+# Test the latency of tcp connections over the loopback interface. Some OSes
+# (e.g. NetBSD) seem to use the Nagle algorithm and delayed ACKs, so it takes
+# up to 200ms for a packet sent to localhost to arrive. We're measuring this
+# here, so that OSes that don't have this problem can run the tests at full
+# speed.
+set server [socket -server {apply {{s a p} {set ::s1 $s}}} 0]
+set s2 [socket localhost [lindex [fconfigure $server -sockname] 2]]
+vwait s1; close $server
+fconfigure $s1 -buffering line
+fconfigure $s2 -buffering line
+set t1 [clock milliseconds]
+puts $s2 test1; gets $s1
+puts $s2 test2; gets $s1
+close $s1; close $s2
+set t2 [clock milliseconds]
+set latency [expr {($t2-$t1)*2}]; # doubled as a safety margin
+unset t1 t2 s1 s2 server
+
+# If remoteServerIP or remoteServerPort are not set, check in the environment
+# variables for externally set values.
 #
 
 if {![info exists remoteServerIP]} {
@@ -79,7 +99,7 @@ if {![info exists remoteServerIP]} {
     }
 }
 if {![info exists remoteServerPort]} {
-    if {[info exists env(remoteServerIP)]} {
+    if {[info exists env(remoteServerPort)]} {
 	set remoteServerPort $env(remoteServerPort)
     } else {
         if {[info exists remoteServerIP]} {
@@ -88,62 +108,91 @@ if {![info exists remoteServerPort]} {
     }
 }
 
+if 0 {
+    # activate this to time the tests
+    proc test {args} {
+        set name [lindex $args 0]
+        puts "[lindex [time {uplevel [linsert $args 0 tcltest::test]}] 0] @@@ $name"
+    }
+}
+
+foreach {af localhost} {
+    inet 127.0.0.1
+    inet6 ::1
+} {
+    # Check if the family is supported and set the constraint accordingly
+    testConstraint supported_$af [expr {![catch {socket -server foo -myaddr $localhost 0} sock]}]
+    catch {close $sock}
+}
+testConstraint supported_any [expr {[testConstraint supported_inet] || [testConstraint supported_inet6]}]
+
+set sock [socket -server foo -myaddr localhost 0]
+set sockname [fconfigure $sock -sockname]
+close $sock
+testConstraint localhost_v4 [expr {"127.0.0.1" in $sockname}]
+testConstraint localhost_v6 [expr {"::1" in $sockname}]
+
+
+foreach {af localhost} {
+    any 127.0.0.1
+    inet 127.0.0.1
+    inet6 ::1
+} {
+    set ::tcl::unsupported::socketAF $af
 #
 # Check if we're supposed to do tests against the remote server
 #
 
 set doTestsWithRemoteServer 1
 if {![info exists remoteServerIP]} {
-    set remoteServerIP 127.0.0.1
+    set remoteServerIP $localhost
 }
 if {($doTestsWithRemoteServer == 1) && (![info exists remoteServerPort])} {
-    set remoteServerPort 2048
+    set remoteServerPort [randport]
 }
 
-# Attempt to connect to a remote server if one is already running. If it
-# is not running or for some other reason the connect fails, attempt to
-# start the remote server on the local host listening on port 2048. This
-# is only done on platforms that support exec (i.e. not on the Mac). On
-# platforms that do not support exec, the remote server must be started
-# by the user before running the tests.
+# Attempt to connect to a remote server if one is already running. If it is
+# not running or for some other reason the connect fails, attempt to start the
+# remote server on the local host listening on port 2048. This is only done on
+# platforms that support exec (i.e. not on the Mac). On platforms that do not
+# support exec, the remote server must be started by the user before running
+# the tests.
 
 set remoteProcChan ""
 set commandSocket ""
 if {$doTestsWithRemoteServer} {
     catch {close $commandSocket}
-    if {[catch {set commandSocket [socket $remoteServerIP \
-						$remoteServerPort]}] != 0} {
-	if {[info commands exec] == ""} {
-	    set noRemoteTestReason "can't exec"
-	    set doTestsWithRemoteServer 0
-	} else {
-	    set remoteServerIP 127.0.0.1
-	    # Be *extra* careful in case this file is sourced from
-	    # a directory other than the current one...
-	    set remoteFile [file join [pwd] [file dirname [info script]] \
-		    remote.tcl]
-	    if {[catch {set remoteProcChan \
-				[open "|[list [interpreter] $remoteFile \
-					-serverIsSilent \
-					-port $remoteServerPort \
-					-address $remoteServerIP]" \
-					w+]} \
-		   msg] == 0} {
-		after 1000
-		if {[catch {set commandSocket [socket $remoteServerIP \
-				$remoteServerPort]} msg] == 0} {
-		    fconfigure $commandSocket -translation crlf -buffering line
-		} else {
-		    set noRemoteTestReason $msg
-		    set doTestsWithRemoteServer 0
-		}
+    if {![catch {
+	set commandSocket [socket $remoteServerIP $remoteServerPort]
+    }]} then {
+	fconfigure $commandSocket -translation crlf -buffering line
+    } elseif {![testConstraint exec]} {
+	set noRemoteTestReason "can't exec"
+	set doTestsWithRemoteServer 0
+    } else {
+	set remoteServerIP $localhost
+	# Be *extra* careful in case this file is sourced from
+	# a directory other than the current one...
+	set remoteFile [file join [pwd] [file dirname [info script]] \
+		remote.tcl]
+	if {![catch {
+	    set remoteProcChan [open "|[list \
+		    [interpreter] $remoteFile -serverIsSilent \
+		    -port $remoteServerPort -address $remoteServerIP]" w+]
+	} msg]} then {
+	    gets $remoteProcChan
+	    if {[catch {
+		set commandSocket [socket $remoteServerIP $remoteServerPort]
+	    } msg] == 0} then {
+		fconfigure $commandSocket -translation crlf -buffering line
 	    } else {
-		set noRemoteTestReason "$msg [interpreter]"
+		set noRemoteTestReason $msg
 		set doTestsWithRemoteServer 0
 	    }
+	} else {
+	    set noRemoteTestReason "$msg [interpreter]"
+	    set doTestsWithRemoteServer 0
 	}
-    } else {
-	fconfigure $commandSocket -translation crlf -buffering line
     }
 }
 
@@ -158,8 +207,7 @@ if {!$doTestsWithRemoteServer} {
 }
 
 #
-# If we do the tests, define a command to send a command to the
-# remote server.
+# If we do the tests, define a command to send a command to the remote server.
 #
 
 if {[testConstraint doTestsWithRemoteServer]} {
@@ -169,7 +217,6 @@ if {[testConstraint doTestsWithRemoteServer]} {
 	if {[eof $commandSocket]} {
 	    error "remote server disappeared"
 	}
-
 	if {[catch {puts $commandSocket $c} msg]} {
 	    error "remote server disappaered: $msg"
 	}
@@ -177,71 +224,73 @@ if {[testConstraint doTestsWithRemoteServer]} {
 	    error "remote server disappeared: $msg"
 	}
 
-	set resp ""
 	while {1} {
 	    set line [gets $commandSocket]
 	    if {[eof $commandSocket]} {
 		error "remote server disappaered"
 	    }
-	    if {[string compare $line "--Marker--Marker--Marker--"] == 0} {
-		if {[string compare [lindex $resp 0] error] == 0} {
-		    error [lindex $resp 1]
-		} else {
-		    return [lindex $resp 1]
-		}
-	    } else {
-		append resp $line "\n"
+	    if {$line eq "--Marker--Marker--Marker--"} {
+		lassign $result code info value
+                return -code $code -errorinfo $info $value
 	    }
+            append result $line "\n"
 	}
     }
 }
 
-test socket-1.1 {arg parsing for socket command} {socket} {
-    list [catch {socket -server} msg] $msg
-} {1 {no argument given for -server option}}
-test socket-1.2 {arg parsing for socket command} {socket} {
-    list [catch {socket -server foo} msg] $msg
-} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
-test socket-1.3 {arg parsing for socket command} {socket} {
-    list [catch {socket -myaddr} msg] $msg
-} {1 {no argument given for -myaddr option}}
-test socket-1.4 {arg parsing for socket command} {socket} {
-    list [catch {socket -myaddr 127.0.0.1} msg] $msg
-} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
-test socket-1.5 {arg parsing for socket command} {socket} {
-    list [catch {socket -myport} msg] $msg
-} {1 {no argument given for -myport option}}
-test socket-1.6 {arg parsing for socket command} {socket} {
-    list [catch {socket -myport xxxx} msg] $msg
-} {1 {expected integer but got "xxxx"}}
-test socket-1.7 {arg parsing for socket command} {socket} {
-    list [catch {socket -myport 2522} msg] $msg
-} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
-test socket-1.8 {arg parsing for socket command} {socket} {
-    list [catch {socket -froboz} msg] $msg
-} {1 {bad option "-froboz": must be -async, -myaddr, -myport, or -server}}
-test socket-1.9 {arg parsing for socket command} {socket} {
-    list [catch {socket -server foo -myport 2521 3333} msg] $msg
-} {1 {Option -myport is not valid for servers}}
-test socket-1.10 {arg parsing for socket command} {socket} {
-    list [catch {socket host 2528 -junk} msg] $msg
-} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
-test socket-1.11 {arg parsing for socket command} {socket} {
-    list [catch {socket -server callback 2520 --} msg] $msg
-} {1 {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}}
-test socket-1.12 {arg parsing for socket command} {socket} {
-    list [catch {socket foo badport} msg] $msg
-} {1 {expected integer but got "badport"}}
-test socket-1.13 {arg parsing for socket command} {socket} {
-list [catch {socket -async -server} msg] $msg
-} {1 {cannot set -async option for server sockets}}
-test socket-1.14 {arg parsing for socket command} {socket} {
-list [catch {socket -server foo -async} msg] $msg
-} {1 {cannot set -async option for server sockets}}
+proc getPort sock {
+    lindex [fconfigure $sock -sockname] 2
+}
+
+
+# ----------------------------------------------------------------------
+
+test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -server
+} -returnCodes error -result {no argument given for -server option}
+test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -server foo
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+test socket_$af-1.3 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -myaddr
+} -returnCodes error -result {no argument given for -myaddr option}
+test socket_$af-1.4 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -myaddr $localhost
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+test socket_$af-1.5 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -myport
+} -returnCodes error -result {no argument given for -myport option}
+test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -myport xxxx
+} -returnCodes error -result {expected integer but got "xxxx"}
+test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -myport 2522
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -froboz
+} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, or -server}
+test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -server foo -myport 2521 3333
+} -returnCodes error -result {option -myport is not valid for servers}
+test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket host 2528 -junk
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -server callback 2520 --
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+test socket_$af-1.12 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket foo badport
+} -returnCodes error -result {expected integer but got "badport"}
+test socket_$af-1.13 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -async -server
+} -returnCodes error -result {cannot set -async option for server sockets}
+test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+    socket -server foo -async
+} -returnCodes error -result {cannot set -async option for server sockets}
 
 set path(script) [makeFile {} script]
 
-test socket-2.1 {tcp connection} {socket stdio} {
+test socket_$af-2.1 {tcp connection} -constraints [list socket supported_$af stdio] -setup {
     file delete $path(script)
     set f [open $path(script) w]
     puts $f {
@@ -263,23 +312,17 @@ test socket-2.1 {tcp connection} {socket stdio} {
     set f [open "|[list [interpreter] $path(script)]" r]
     gets $f x
     gets $f listen
-    if {[catch {socket 127.0.0.1 $listen} msg]} {
-        set x $msg
-    } else {
-        lappend x [gets $f]
-        close $msg
-    }
+} -body {
+    # $x == "ready" at this point
+    set sock [socket $localhost $listen]
+    lappend x [gets $f]
+    close $sock
     lappend x [gets $f]
+} -cleanup {
     close $f
-    set x
-} {ready done {}}
-
-if [info exists port] {
-    incr port
-} else { 
-    set port [expr 2048 + [pid]%1024]
-}
-test socket-2.2 {tcp connection with client port specified} {socket stdio} {
+} -result {ready done {}}
+test socket_$af-2.2 {tcp connection with client port specified} -setup {
+    set port [randport]
     file delete $path(script)
     set f [open $path(script) w]
     puts $f {
@@ -301,32 +344,31 @@ test socket-2.2 {tcp connection with client port specified} {socket stdio} {
     set f [open "|[list [interpreter] $path(script)]" r]
     gets $f x
     gets $f listen
-    global port
-    if {[catch {socket -myport $port 127.0.0.1 $listen} sock]} {
-        set x $sock
-	close [socket 127.0.0.1 $listen]
-	puts stderr $sock
-    } else {
-        puts $sock hello
-	flush $sock
-        lappend x [gets $f]
-        close $sock
-    }
+} -constraints [list socket supported_$af stdio] -body {
+    # $x == "ready" at this point
+    set sock [socket -myport $port $localhost $listen]
+    puts $sock hello
+    flush $sock
+    lappend x [expr {[gets $f] eq "hello $port"}]
+    close $sock
+    return $x
+} -cleanup {
+    catch {close [socket $localhost $listen]}
     close $f
-    set x
-} [list ready "hello $port"]
-test socket-2.3 {tcp connection with client interface specified} {socket stdio} {
+} -result {ready 1}
+test socket_$af-2.3 {tcp connection with client interface specified} -setup {
     file delete $path(script)
     set f [open $path(script) w]
     puts $f {
 	set timer [after 2000 "set x done"]
-        set f [socket  -server accept 2830]
+        set f [socket  -server accept 0]
 	proc accept {file addr port} {
             global x
             puts "[gets $file] $addr"
             close $file
             set x done
 	}
+	puts [lindex [fconfigure $f -sockname] 2]
 	puts ready
 	vwait x
 	after cancel $timer
@@ -334,24 +376,26 @@ test socket-2.3 {tcp connection with client interface specified} {socket stdio}
     }
     close $f
     set f [open "|[list [interpreter] $path(script)]" r]
+    gets $f listen
     gets $f x
-    if {[catch {socket -myaddr 127.0.0.1 127.0.0.1 2830} sock]} {
-        set x $sock
-    } else {
-        puts $sock hello
-	flush $sock
-        lappend x [gets $f]
-        close $sock
-    }
+} -constraints [list socket supported_$af stdio] -body {
+    # $x == "ready" at this point
+    set sock [socket -myaddr $localhost $localhost $listen]
+    puts $sock hello
+    flush $sock
+    lappend x [gets $f]
+    close $sock
+    return $x
+} -cleanup {
     close $f
-    set x
-} {ready {hello 127.0.0.1}}
-test socket-2.4 {tcp connection with server interface specified} {socket stdio} {
+} -result [list ready [list hello $localhost]]
+test socket_$af-2.4 {tcp connection with server interface specified} -setup {
     file delete $path(script)
     set f [open $path(script) w]
+    puts $f [list set localhost $localhost]
     puts $f {
 	set timer [after 2000 "set x done"]
-        set f [socket -server accept -myaddr 127.0.0.1 0]
+        set f [socket -server accept -myaddr $localhost 0]
 	proc accept {file addr port} {
             global x
             puts "[gets $file]"
@@ -368,18 +412,18 @@ test socket-2.4 {tcp connection with server interface specified} {socket stdio}
     set f [open "|[list [interpreter] $path(script)]" r]
     gets $f x
     gets $f listen
-    if {[catch {socket 127.0.0.1 $listen} sock]} {
-        set x $sock
-    } else {
-        puts $sock hello
-	flush $sock
-        lappend x [gets $f]
-        close $sock
-    }
+} -constraints [list socket supported_$af stdio] -body {
+    # $x == "ready" at this point
+    set sock [socket $localhost $listen]
+    puts $sock hello
+    flush $sock
+    lappend x [gets $f]
+    close $sock
+    return $x
+} -cleanup {
     close $f
-    set x
-} {ready hello}
-test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
+} -result {ready hello}
+test socket_$af-2.5 {tcp connection with redundant server port} -setup {
     file delete $path(script)
     set f [open $path(script) w]
     puts $f {
@@ -401,28 +445,28 @@ test socket-2.5 {tcp connection with redundant server port} {socket stdio} {
     set f [open "|[list [interpreter] $path(script)]" r]
     gets $f x
     gets $f listen
-    if {[catch {socket 127.0.0.1 $listen} sock]} {
-        set x $sock
-    } else {
-        puts $sock hello
-	flush $sock
-        lappend x [gets $f]
-        close $sock
-    }
+} -constraints [list socket supported_$af stdio] -body {
+    # $x == "ready" at this point
+    set sock [socket $localhost $listen]
+    puts $sock hello
+    flush $sock
+    lappend x [gets $f]
+    close $sock
+    return $x
+} -cleanup {
     close $f
-    set x
-} {ready hello}
-test socket-2.6 {tcp connection} {socket} {
+} -result {ready hello}
+test socket_$af-2.6 {tcp connection} -constraints [list socket supported_$af] -body {
     set status ok
-    if {![catch {set sock [socket 127.0.0.1 2833]}]} {
+    if {![catch {set sock [socket $localhost [randport]]}]} {
 	if {![catch {gets $sock}]} {
 	    set status broken
 	}
 	close $sock
     }
     set status
-} ok
-test socket-2.7 {echo server, one line} {socket stdio} {
+} -result ok
+test socket_$af-2.7 {echo server, one line} -constraints [list socket supported_$af stdio] -setup {
     file delete $path(script)
     set f [open $path(script) w]
     puts $f {
@@ -453,18 +497,18 @@ test socket-2.7 {echo server, one line} {socket stdio} {
     set f [open "|[list [interpreter] $path(script)]" r]
     gets $f
     gets $f listen
-    set s [socket 127.0.0.1 $listen]
+} -body {
+    set s [socket $localhost $listen]
     fconfigure $s -buffering line -translation lf
     puts $s "hello abcdefghijklmnop"
-    after 1000
     set x [gets $s]
     close $s
-    set y [gets $f]
+    list $x [gets $f]
+} -cleanup {
     close $f
-    list $x $y
-} {{hello abcdefghijklmnop} done}
+} -result {{hello abcdefghijklmnop} done}
 removeFile script
-test socket-2.8 {echo server, loop 50 times, single connection} -constraints {socket stdio} -setup {
+test socket_$af-2.8 {echo server, loop 50 times, single connection} -setup {
     set path(script) [makeFile {
 	set f [socket -server accept 0]
 	proc accept {s a p} {
@@ -478,7 +522,7 @@ test socket-2.8 {echo server, loop 50 times, single connection} -constraints {so
                  global x
                  close $s
                  set x done
-             } else { 
+             } else {
 	         incr i
                  puts $s $l
              }
@@ -492,11 +536,11 @@ test socket-2.8 {echo server, loop 50 times, single connection} -constraints {so
 	close $f
 	puts "done $i"
     } script]
-} -body {
     set f [open "|[list [interpreter] $path(script)]" r]
     gets $f
     gets $f listen
-    set s [socket 127.0.0.1 $listen]
+} -constraints [list socket supported_$af stdio] -body {
+    set s [socket $localhost $listen]
     fconfigure $s -buffering line
     catch {
 	for {set x 0} {$x < 50} {incr x} {
@@ -506,30 +550,30 @@ test socket-2.8 {echo server, loop 50 times, single connection} -constraints {so
     }
     close $s
     catch {set x [gets $f]}
-    close $f
-    set x
+    return $x
 } -cleanup {
+    close $f
     removeFile script
 } -result {done 50}
 set path(script) [makeFile {} script]
-test socket-2.9 {socket conflict} {socket stdio} {
+test socket_$af-2.9 {socket conflict} -constraints [list socket supported_$af stdio] -body {
     set s [socket -server accept 0]
     file delete $path(script)
     set f [open $path(script) w]
-    puts -nonewline $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
+    puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF]
+    puts $f "socket -server accept [lindex [fconfigure $s -sockname] 2]"
     close $f
     set f [open "|[list [interpreter] $path(script)]" r]
     gets $f
     after 100
-    set x [list [catch {close $f} msg]]
-    regsub "\n.*$" $msg {} msg ; # cut part of the error message containing the port number
-    lappend x $msg
+    close $f
+} -returnCodes error -cleanup {
     close $s
-    set x
-} {1 {couldn't open socket: address already in use}}
-test socket-2.10 {close on accept, accepted socket lives} {socket} {
+} -match glob -result {couldn't open socket: address already in use*}
+test socket_$af-2.10 {close on accept, accepted socket lives} -setup {
     set done 0
     set timer [after 20000 "set done timed_out"]
+} -constraints [list socket supported_$af] -body {
     set ss [socket -server accept 0]
     proc accept {s a p} {
 	global ss
@@ -543,47 +587,51 @@ test socket-2.10 {close on accept, accepted socket lives} {socket} {
 	close $s
 	set done 1
     }
-    set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
+    set cs [socket $localhost [lindex [fconfigure $ss -sockname] 2]]
     puts $cs hello
     close $cs
     vwait done
+    return $done
+} -cleanup {
     after cancel $timer
-    set done
-} 1
-test socket-2.11 {detecting new data} {socket} {
+} -result 1
+test socket_$af-2.11 {detecting new data} -constraints [list socket supported_$af] -setup {
     proc accept {s a p} {
 	global sock
 	set sock $s
     }
-
     set s [socket -server accept 0]
     set sock ""
-    set s2 [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+} -body {
+    set s2 [socket $localhost [lindex [fconfigure $s -sockname] 2]]
     vwait sock
     puts $s2 one
     flush $s2
-    after 500
+    after idle {set x 1}
+    vwait x
     fconfigure $sock -blocking 0
     set result a:[gets $sock]
     lappend result b:[gets $sock]
     fconfigure $sock -blocking 1
     puts $s2 two
     flush $s2
+    after $latency {set x 1}; # NetBSD fails here if we do [after idle]
+    vwait x
     fconfigure $sock -blocking 0
     lappend result c:[gets $sock]
+} -cleanup {
     fconfigure $sock -blocking 1
     close $s2
     close $s
     close $sock
-    set result
-} {a:one b: c:two}
-
+} -result {a:one b: c:two}
 
-test socket-3.1 {socket conflict} {socket stdio} {
+test socket_$af-3.1 {socket conflict} -constraints [list socket supported_$af stdio] -setup {
     file delete $path(script)
     set f [open $path(script) w]
+    puts $f [list set localhost $localhost]
     puts $f {
-	set f [socket -server accept 0]
+	set f [socket -server accept -myaddr $localhost 0]
 	puts ready
 	puts [lindex [fconfigure $f -sockname] 2]
 	gets stdin
@@ -593,21 +641,22 @@ test socket-3.1 {socket conflict} {socket stdio} {
     set f [open "|[list [interpreter] $path(script)]" r+]
     gets $f
     gets $f listen
-    set x [list [catch {socket -server accept $listen} msg] \
-		$msg]
+} -body {
+    socket -server accept -myaddr $localhost $listen
+} -cleanup {
     puts $f bye
     close $f
-    set x
-} {1 {couldn't open socket: address already in use}}
-test socket-3.2 {server with several clients} {socket stdio} {
+} -returnCodes error -result {couldn't open socket: address already in use}
+test socket_$af-3.2 {server with several clients} -setup {
     file delete $path(script)
     set f [open $path(script) w]
+    puts $f [list set localhost $localhost]
     puts $f {
 	set t1 [after 30000 "set x timed_out"]
 	set t2 [after 31000 "set x timed_out"]
 	set t3 [after 32000 "set x timed_out"]
 	set counter 0
-	set s [socket -server accept 0]
+	set s [socket -server accept -myaddr $localhost 0]
 	proc accept {s a p} {
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line
@@ -637,11 +686,13 @@ test socket-3.2 {server with several clients} {socket stdio} {
     set f [open "|[list [interpreter] $path(script)]" r+]
     set x [gets $f]
     gets $f listen
-    set s1 [socket 127.0.0.1 $listen]
+} -constraints [list socket supported_$af stdio] -body {
+    # $x == "ready" here
+    set s1 [socket $localhost $listen]
     fconfigure $s1 -buffering line
-    set s2 [socket 127.0.0.1 $listen]
+    set s2 [socket $localhost $listen]
     fconfigure $s2 -buffering line
-    set s3 [socket 127.0.0.1 $listen]
+    set s3 [socket $localhost $listen]
     fconfigure $s3 -buffering line
     for {set i 0} {$i < 100} {incr i} {
 	puts $s1 hello,s1
@@ -655,16 +706,17 @@ test socket-3.2 {server with several clients} {socket stdio} {
     close $s2
     close $s3
     lappend x [gets $f]
+} -cleanup {
     close $f
-    set x
-} {ready done}
+} -result {ready done}
 
-test socket-4.1 {server with several clients} {socket stdio} {
+test socket_$af-4.1 {server with several clients} -setup {
     file delete $path(script)
     set f [open $path(script) w]
+    puts $f [list set localhost $localhost]
     puts $f {
 	set port [gets stdin]
-	set s [socket 127.0.0.1 $port]
+	set s [socket $localhost $port]
 	fconfigure $s -buffering line
 	for {set i 0} {$i < 100} {incr i} {
 	    puts $s hello
@@ -681,6 +733,7 @@ test socket-4.1 {server with several clients} {socket stdio} {
     fconfigure $p2 -buffering line
     set p3 [open "|[list [interpreter] $path(script)]" r+]
     fconfigure $p3 -buffering line
+} -constraints [list socket supported_$af stdio] -body {
     proc accept {s a p} {
 	fconfigure $s -buffering line
 	fileevent $s readable [list echo $s]
@@ -698,7 +751,7 @@ test socket-4.1 {server with several clients} {socket stdio} {
     set t1 [after 30000 "set x timed_out"]
     set t2 [after 31000 "set x timed_out"]
     set t3 [after 32000 "set x timed_out"]
-    set s [socket -server accept 0]
+    set s [socket -server accept -myaddr $localhost 0]
     set listen [lindex [fconfigure $s -sockname] 2]
     puts $p1 $listen
     puts $p2 $listen
@@ -714,52 +767,42 @@ test socket-4.1 {server with several clients} {socket stdio} {
     lappend l [list p1 [gets $p1] $x]
     lappend l [list p2 [gets $p2] $x]
     lappend l [list p3 [gets $p3] $x]
+} -cleanup {
     puts $p1 bye
     puts $p2 bye
     puts $p3 bye
     close $p1
     close $p2
     close $p3
-    set l
-} {{p1 bye done} {p2 bye done} {p3 bye done}}
-test socket-4.2 {byte order problems, socket numbers, htons} {socket} {
-    set x ok
-    if {[catch {socket -server dodo 0x3000} msg]} {
-	set x $msg
-    } else {
-	close $msg
-    }
-    set x
-} ok
+} -result {{p1 bye done} {p2 bye done} {p3 bye done}}
+test socket_$af-4.2 {byte order problems, socket numbers, htons} -body {
+    close [socket -server dodo -myaddr $localhost 0x3000]
+    return ok
+} -constraints [list socket supported_$af] -result ok
 
-test socket-5.1 {byte order problems, socket numbers, htons} \
-	{socket unix notRoot} {
-    set x {couldn't open socket: not owner}
+test socket_$af-5.1 {byte order problems, socket numbers, htons} -body {
     if {![catch {socket -server dodo 0x1} msg]} {
-        set x {htons problem, should be disallowed, are you running as SU?}
 	close $msg
+        return {htons problem, should be disallowed, are you running as SU?}
     }
-    set x
-} {couldn't open socket: not owner}
-test socket-5.2 {byte order problems, socket numbers, htons} {socket} {
-    set x {couldn't open socket: port number too high}
+    return {couldn't open socket: not owner}
+} -constraints [list socket supported_$af unix notRoot] -result {couldn't open socket: not owner}
+test socket_$af-5.2 {byte order problems, socket numbers, htons} -body {
     if {![catch {socket -server dodo 0x10000} msg]} {
-	set x {port resolution problem, should be disallowed}
 	close $msg
+	return {port resolution problem, should be disallowed}
     }
-    set x
-} {couldn't open socket: port number too high}
-test socket-5.3 {byte order problems, socket numbers, htons} \
-	{socket unix notRoot} {
-    set x {couldn't open socket: not owner}
+    return {couldn't open socket: port number too high}
+} -constraints [list socket supported_$af] -result {couldn't open socket: port number too high}
+test socket_$af-5.3 {byte order problems, socket numbers, htons} -body {
     if {![catch {socket -server dodo 21} msg]} {
-	set x {htons problem, should be disallowed, are you running as SU?}
 	close $msg
+	return {htons problem, should be disallowed, are you running as SU?}
     }
-    set x
-} {couldn't open socket: not owner}
+    return {couldn't open socket: not owner}
+} -constraints [list socket supported_$af unix notRoot] -result {couldn't open socket: not owner}
 
-test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
+test socket_$af-6.1 {accept callback error} -constraints [list socket supported_$af stdio] -setup {
     proc myHandler {msg options} {
 	variable x $msg
     }
@@ -768,26 +811,45 @@ test socket-6.1 {accept callback error} -constraints {socket stdio} -setup {
     file delete $path(script)
 } -body {
     set f [open $path(script) w]
+    puts $f [list set localhost $localhost]
     puts $f {
 	gets stdin port
-	socket 127.0.0.1 $port
+	socket $localhost $port
     }
     close $f
     set f [open "|[list [interpreter] $path(script)]" r+]
     proc accept {s a p} {expr 10 / 0}
-    set s [socket -server accept 0]
+    set s [socket -server accept -myaddr $localhost 0]
     puts $f [lindex [fconfigure $s -sockname] 2]
     close $f
     set timer [after 10000 "set x timed_out"]
     vwait x
     after cancel $timer
     close $s
-    set x
+    return $x
 } -cleanup {
     interp bgerror {} $handler
 } -result {divide by zero}
 
-test socket-7.1 {testing socket specific options} {socket stdio} {
+test socket_$af-6.2 {
+    readable fileevent on server socket
+} -setup {
+    set sock [socket -server dummy 0]
+} -constraints [list socket supported_$af] -body {
+    fileevent $sock readable dummy
+} -cleanup {
+    close $sock
+} -returnCodes 1 -result "channel is not readable"
+
+test socket_$af-6.3 {writable fileevent on server socket} -setup {
+    set sock [socket -server dummy 0]
+} -constraints [list socket supported_$af] -body {
+    fileevent $sock writable dummy
+} -cleanup {
+    close $sock
+} -returnCodes 1 -result "channel is not writable"
+
+test socket_$af-7.1 {testing socket specific options} -setup {
     file delete $path(script)
     set f [open $path(script) w]
     puts $f {
@@ -806,20 +868,23 @@ test socket-7.1 {testing socket specific options} {socket stdio} {
     set f [open "|[list [interpreter] $path(script)]" r]
     gets $f
     gets $f listen
-    set s [socket 127.0.0.1 $listen]
+    set l ""
+} -constraints [list socket supported_$af stdio] -body {
+    set s [socket $localhost $listen]
     set p [fconfigure $s -peername]
     close $s
-    close $f
-    set l ""
-    lappend l [string compare [lindex $p 0] 127.0.0.1]
+    lappend l [string compare [lindex $p 0] $localhost]
     lappend l [string compare [lindex $p 2] $listen]
     lappend l [llength $p]
-} {0 0 3}
-test socket-7.2 {testing socket specific options} {socket stdio} {
+} -cleanup {
+    close $f
+} -result {0 0 3}
+test socket_$af-7.2 {testing socket specific options} -setup {
     file delete $path(script)
     set f [open $path(script) w]
+    puts $f [list set ::tcl::unsupported::socketAF $::tcl::unsupported::socketAF]
     puts $f {
-	set ss [socket -server accept 2821]
+	set ss [socket -server accept 0]
 	proc accept args {
 	    global x
 	    set x done
@@ -834,39 +899,46 @@ test socket-7.2 {testing socket specific options} {socket stdio} {
     set f [open "|[list [interpreter] $path(script)]" r]
     gets $f
     gets $f listen
-    set s [socket 127.0.0.1 $listen]
+} -constraints [list socket supported_$af stdio] -body {
+    set s [socket $localhost $listen]
     set p [fconfigure $s -sockname]
     close $s
-    close $f
     list [llength $p] \
-	    [regexp {^(127\.0\.0\.1|0\.0\.0\.0)$} [lindex $p 0]] \
+	    [regexp {^(127\.0\.0\.1|0\.0\.0\.0|::1)$} [lindex $p 0]] \
 	    [expr {[lindex $p 2] == $listen}]
-} {3 1 0}
-test socket-7.3 {testing socket specific options} {socket} {
-    set s [socket -server accept 0]
+} -cleanup {
+    close $f
+} -result {3 1 0}
+test socket_$af-7.3 {testing socket specific options} -constraints [list socket supported_$af] -body {
+    set s [socket -server accept -myaddr $localhost 0]
     set l [fconfigure $s]
     close $s
     update
     llength $l
-} 14
-test socket-7.4 {testing socket specific options} {socket} {
-    set s [socket -server accept 0]
+} -result 14
+test socket_$af-7.4 {testing socket specific options} -constraints [list socket supported_$af] -setup {
+    set timer [after 10000 "set x timed_out"]
+    set l ""
+} -body {
+    set s [socket -server accept -myaddr $localhost 0]
     proc accept {s a p} {
 	global x
 	set x [fconfigure $s -sockname]
 	close $s
     }
     set listen [lindex [fconfigure $s -sockname] 2]
-    set s1 [socket [info hostname] $listen]
-    set timer [after 10000 "set x timed_out"]
+    set s1 [socket $localhost $listen]
     vwait x
+    lappend l [expr {[lindex $x 2] == $listen}] [llength $x]
+} -cleanup {
     after cancel $timer
     close $s
     close $s1
+} -result {1 3}
+test socket_$af-7.5 {testing socket specific options} -setup {
+    set timer [after 10000 "set x timed_out"]
     set l ""
-    lappend l [expr {[lindex $x 2] == $listen}] [llength $x]
-} {1 3}
-test socket-7.5 {testing socket specific options} {socket unixOrPc} {
+} -constraints [list socket supported_$af unixOrPc] -body {
     set s [socket -server accept 0]
     proc accept {s a p} {
 	global x
@@ -874,19 +946,18 @@ test socket-7.5 {testing socket specific options} {socket unixOrPc} {
 	close $s
     }
     set listen [lindex [fconfigure $s -sockname] 2]
-    set s1 [socket 127.0.0.1 $listen]
-    set timer [after 10000 "set x timed_out"]
+    set s1 [socket $localhost $listen]
     vwait x
+    lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x]
+} -cleanup {
     after cancel $timer
     close $s
     close $s1
-    set l ""
-    lappend l [lindex $x 0] [expr {[lindex $x 2] == $listen}] [llength $x]
-} {127.0.0.1 1 3}
+} -result [list $localhost 1 3]
 
-test socket-8.1 {testing -async flag on sockets} {socket} {
-    # NOTE: This test may fail on some Solaris 2.4 systems. If it does,
-    # check that you have these patches installed (using showrev -p):
+test socket_$af-8.1 {testing -async flag on sockets} -constraints [list socket supported_$af] -body {
+    # NOTE: This test may fail on some Solaris 2.4 systems. If it does, check
+    # that you have these patches installed (using showrev -p):
     #
     # 101907-05, 101925-02, 101945-14, 101959-03, 101969-05, 101973-03,
     # 101977-03, 101981-02, 101985-01, 102001-03, 102003-01, 102007-01,
@@ -895,29 +966,31 @@ test socket-8.1 {testing -async flag on sockets} {socket} {
     # 101878-03, 101879-01, 101880-03, 101933-01, 101950-01, 102030-01,
     # 102057-08, 102140-01, 101920-02, 101921-09, 101922-07, 101923-03
     #
-    # If after installing these patches you are still experiencing a
-    # problem, please email jyl@eng.sun.com. We have not observed this
-    # failure on Solaris 2.5, so another option (instead of installing
-    # these patches) is to upgrade to Solaris 2.5.
-    set s [socket -server accept 0]
+    # If after installing these patches you are still experiencing a problem,
+    # please email jyl@eng.sun.com. We have not observed this failure on
+    # Solaris 2.5, so another option (instead of installing these patches) is
+    # to upgrade to Solaris 2.5.
+    set s [socket -server accept -myaddr $localhost 0]
     proc accept {s a p} {
 	global x
 	puts $s bye
 	close $s
 	set x done
     }
-    set s1 [socket -async [info hostname] [lindex [fconfigure $s -sockname] 2]]
+    set s1 [socket -async $localhost [lindex [fconfigure $s -sockname] 2]]
     vwait x
-    set z [gets $s1]
+    gets $s1
+} -cleanup {
     close $s
     close $s1
-    set z
-} bye
+} -result bye
 
-test socket-9.1 {testing spurious events} {socket} {
+test socket_$af-9.1 {testing spurious events} -constraints [list socket supported_$af] -setup {
     set len 0
     set spurious 0
     set done 0
+    set timer [after 10000 "set done timed_out"]
+} -body {
     proc readlittle {s} {
 	global spurious done len
 	set l [read $s 1]
@@ -936,24 +1009,25 @@ test socket-9.1 {testing spurious events} {socket} {
 	fconfigure $s -buffering none -blocking off
 	fileevent $s readable [list readlittle $s]
     }
-    set s [socket -server accept 0]
-    set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
+    set s [socket -server accept -myaddr $localhost 0]
+    set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
     puts -nonewline $c 01234567890123456789012345678901234567890123456789
     close $c
-    set timer [after 10000 "set done timed_out"]
     vwait done
-    after cancel $timer
     close $s
     list $spurious $len
-} {0 50}
-test socket-9.2 {testing async write, fileevents, flush on close} {socket} {
+} -cleanup {
+    after cancel $timer
+} -result {0 50}
+test socket_$af-9.2 {testing async write, fileevents, flush on close} -constraints [list socket supported_$af] -setup {
     set firstblock ""
     for {set i 0} {$i < 5} {incr i} {set firstblock "a$firstblock$firstblock"}
     set secondblock ""
     for {set i 0} {$i < 16} {incr i} {
 	set secondblock "b$secondblock$secondblock"
     }
-    set l [socket -server accept 0]
+    set timer [after 10000 "set done timed_out"]
+    set l [socket -server accept -myaddr $localhost 0]
     proc accept {s a p} {
 	fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
 		-buffering line
@@ -962,19 +1036,20 @@ test socket-9.2 {testing async write, fileevents, flush on close} {socket} {
     proc readable {s} {
 	set l [gets $s]
 	fileevent $s readable {}
-	after 1000 respond $s
+	after idle respond $s
     }
     proc respond {s} {
 	global firstblock
 	puts -nonewline $s $firstblock
-	after 1000 writedata $s
+	after idle writedata $s
     }
     proc writedata {s} {
 	global secondblock
 	puts -nonewline $s $secondblock
 	close $s
     }
-    set s [socket [info hostname] [lindex [fconfigure $l -sockname] 2]]
+} -body {
+    set s [socket $localhost [lindex [fconfigure $l -sockname] 2]]
     fconfigure $s -blocking 0 -trans lf -buffering line
     set count 0
     puts $s hello
@@ -988,15 +1063,27 @@ test socket-9.2 {testing async write, fileevents, flush on close} {socket} {
 	}
     }
     fileevent $s readable "readit $s"
-    set timer [after 10000 "set done timed_out"]
     vwait done
-    after cancel $timer
+    return $count
+} -cleanup {
     close $l
-    set count
-} 65566
-test socket-9.3 {testing EOF stickyness} {socket} {
+    after cancel $timer
+} -result 65566
+test socket_$af-9.3 {testing EOF stickyness} -constraints [list socket supported_$af] -setup {
+    set count 0
+    set done false
+    proc write_then_close {s} {
+	puts $s bye
+	close $s
+    }
+    proc accept {s a p} {
+	fconfigure $s -buffering line -translation lf
+	fileevent $s writable "write_then_close $s"
+    }
+    set s [socket -server accept -myaddr $localhost 0]
+} -body {
     proc count_to_eof {s} {
-	global count done timer
+	global count done
 	set l [gets $s]
 	if {[eof $s]} {
 	    incr count
@@ -1004,41 +1091,30 @@ test socket-9.3 {testing EOF stickyness} {socket} {
 		close $s
 		set done true
 		set count {eof is sticky}
-		after cancel $timer
 	    }
 	}
     }
-    proc timerproc {} {
-	global done count c
+    proc timerproc {s} {
+	global done count
 	set done true
 	set count {timer went off, eof is not sticky}
-	close $c
-    }	
-    set count 0
-    set done false
-    proc write_then_close {s} {
-	puts $s bye
 	close $s
     }
-    proc accept {s a p} {
-	fconfigure $s -buffering line -translation lf
-	fileevent $s writable "write_then_close $s"
-    }
-    set s [socket -server accept 0]
-    set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
+    set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
     fconfigure $c -blocking off -buffering line -translation lf
     fileevent $c readable "count_to_eof $c"
-    set timer [after 1000 timerproc]
+    set timer [after 1000 timerproc $c]
     vwait done
+    return $count
+} -cleanup {
     close $s
-    set count
-} {eof is sticky}
+    after cancel $timer
+} -result {eof is sticky}
 
 removeFile script
 
-test socket-10.1 {testing socket accept callback error handling} -constraints {
-    socket
-} -setup {
+test socket_$af-10.1 {testing socket accept callback error handling} \
+    -constraints [list socket supported_$af] -setup {
     variable goterror 0
     proc myHandler {msg options} {
 	variable goterror 1
@@ -1046,68 +1122,64 @@ test socket-10.1 {testing socket accept callback error handling} -constraints {
     set handler [interp bgerror {}]
     interp bgerror {} [namespace which myHandler]
 } -body {
-    set s [socket -server accept 0]
+    set s [socket -server accept -myaddr $localhost 0]
     proc accept {s a p} {close $s; error}
-    set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
+    set c [socket $localhost [lindex [fconfigure $s -sockname] 2]]
     vwait goterror
     close $s
     close $c
-    set goterror
+    return $goterror
 } -cleanup {
     interp bgerror {} $handler
 } -result 1
 
-test socket-11.1 {tcp connection} {socket doTestsWithRemoteServer} {
-    sendCommand {
-	set socket9_1_test_server [socket -server accept 2834]
+test socket_$af-11.1 {tcp connection} -setup {
+    set port [sendCommand {
+	set server [socket -server accept 0]
 	proc accept {s a p} {
 	    puts $s done
 	    close $s
 	}
-    }
-    set s [socket $remoteServerIP 2834]
-    set r [gets $s]
+	getPort $server
+    }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+    set s [socket $remoteServerIP $port]
+    gets $s
+} -cleanup {
     close $s
-    sendCommand {close $socket9_1_test_server}
-    set r
-} done
-test socket-11.2 {client specifies its port} {socket doTestsWithRemoteServer} {
-    if {[info exists port]} {
-	incr port
-    } else {
-	set port [expr 2048 + [pid]%1024]
-    }
-    sendCommand {
-	set socket9_2_test_server [socket -server accept 2835]
+    sendCommand {close $server}
+} -result done
+test socket_$af-11.2 {client specifies its port} -setup {
+    set lport [randport]
+    set rport [sendCommand {
+	set server [socket -server accept 0]
 	proc accept {s a p} {
 	    puts $s $p
 	    close $s
 	}
-    }
-    set s [socket -myport $port $remoteServerIP 2835]
+	getPort $server
+    }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+    set s [socket -myport $lport $remoteServerIP $rport]
     set r [gets $s]
+    expr {$r==$lport ? "ok" : "broken: $r != $port"}
+} -cleanup {
     close $s
-    sendCommand {close $socket9_2_test_server}
-    if {$r == $port} {
-	set result ok
-    } else {
-	set result broken
-    }
-    set result
-} ok
-test socket-11.3 {trying to connect, no server} {socket doTestsWithRemoteServer} {
+    sendCommand {close $server}
+} -result ok
+test socket_$af-11.3 {trying to connect, no server} -body {
     set status ok
-    if {![catch {set s [socket $remoteServerIp 2836]}]} {
+    if {![catch {set s [socket $remoteServerIp [randport]]}]} {
 	if {![catch {gets $s}]} {
 	    set status broken
 	}
 	close $s
     }
-    set status
-} ok
-test socket-11.4 {remote echo, one line} {socket doTestsWithRemoteServer} {
-    sendCommand {
-	set socket10_6_test_server [socket -server accept 2836]
+    return $status
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -result ok
+test socket_$af-11.4 {remote echo, one line} -setup {
+    set port [sendCommand {
+	set server [socket -server accept 0]
 	proc accept {s a p} {
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line -translation crlf
@@ -1120,18 +1192,20 @@ test socket-11.4 {remote echo, one line} {socket doTestsWithRemoteServer} {
 		puts $s $l
 	    }
 	}
-    }
-    set f [socket $remoteServerIP 2836]
+	getPort $server
+    }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+    set f [socket $remoteServerIP $port]
     fconfigure $f -translation crlf -buffering line
     puts $f hello
-    set r [gets $f]
-    close $f
-    sendCommand {close $socket10_6_test_server}
-    set r
-} hello
-test socket-11.5 {remote echo, 50 lines} {socket doTestsWithRemoteServer} {
-    sendCommand {
-	set socket10_7_test_server [socket -server accept 2836]
+    gets $f
+} -cleanup {
+    catch {close $f}
+    sendCommand {close $server}
+} -result hello
+test socket_$af-11.5 {remote echo, 50 lines} -setup {
+    set port [sendCommand {
+	set server [socket -server accept 0]
 	proc accept {s a p} {
 	    fileevent $s readable [list echo $s]
 	    fconfigure $s -buffering line -translation crlf
@@ -1144,33 +1218,33 @@ test socket-11.5 {remote echo, 50 lines} {socket doTestsWithRemoteServer} {
 		puts $s $l
 	    }
 	}
-    }
-    set f [socket $remoteServerIP 2836]
+	getPort $server
+    }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+    set f [socket $remoteServerIP $port]
     fconfigure $f -translation crlf -buffering line
     for {set cnt 0} {$cnt < 50} {incr cnt} {
 	puts $f "hello, $cnt"
-	if {[string compare [gets $f] "hello, $cnt"] != 0} {
+	if {[gets $f] != "hello, $cnt"} {
 	    break
 	}
     }
+    return $cnt
+} -cleanup {
     close $f
-    sendCommand {close $socket10_7_test_server}
-    set cnt
-} 50
-test socket-11.6 {socket conflict} {socket doTestsWithRemoteServer} {
-    set s1 [socket -server accept 2836]
-    if {[catch {set s2 [socket -server accept 2836]} msg]} {
-	set result [list 1 $msg]
-    } else {
-	set result [list 0 [lindex [fconfigure $s2 -sockname] 2]]
-	close $s2
-    }
+    sendCommand {close $server}
+} -result 50
+test socket_$af-11.6 {socket conflict} -setup {
+    set s1 [socket -server accept -myaddr $localhost 0]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+    set s2 [socket -server accept -myaddr $localhost [getPort $s1]]
+    list [getPort $s2] [close $s2]
+} -cleanup {
     close $s1
-    set result
-} {1 {couldn't open socket: address already in use}}
-test socket-11.7 {server with several clients} {socket doTestsWithRemoteServer} {
-    sendCommand {
-	set socket10_9_test_server [socket -server accept 2836]
+} -returnCodes error -result {couldn't open socket: address already in use}
+test socket_$af-11.7 {server with several clients} -setup {
+    set port [sendCommand {
+	set server [socket -server accept 0]
 	proc accept {s a p} {
 	    fconfigure $s -buffering line
 	    fileevent $s readable [list echo $s]
@@ -1183,12 +1257,14 @@ test socket-11.7 {server with several clients} {socket doTestsWithRemoteServer}
 		puts $s $l
 	    }
 	}
-    }
-    set s1 [socket $remoteServerIP 2836]
+	getPort $server
+    }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+    set s1 [socket $remoteServerIP $port]
     fconfigure $s1 -buffering line
-    set s2 [socket $remoteServerIP 2836]
+    set s2 [socket $remoteServerIP $port]
     fconfigure $s2 -buffering line
-    set s3 [socket $remoteServerIP 2836]
+    set s3 [socket $remoteServerIP $port]
     fconfigure $s3 -buffering line
     for {set i 0} {$i < 100} {incr i} {
 	puts $s1 hello,s1
@@ -1198,28 +1274,31 @@ test socket-11.7 {server with several clients} {socket doTestsWithRemoteServer}
 	puts $s3 hello,s3
 	gets $s3
     }
+    return $i
+} -cleanup {
     close $s1
     close $s2
     close $s3
-    sendCommand {close $socket10_9_test_server}
-    set i
-} 100    
-test socket-11.8 {client with several servers} {socket doTestsWithRemoteServer} {
-    sendCommand {
-	set s1 [socket -server "accept 4003" 4003]
-	set s2 [socket -server "accept 4004" 4004]
-	set s3 [socket -server "accept 4005" 4005]
+    sendCommand {close $server}
+} -result 100
+test socket_$af-11.8 {client with several servers} -setup {
+    lassign [sendCommand {
+	set s1 [socket -server "accept server1" 0]
+	set s2 [socket -server "accept server2" 0]
+	set s3 [socket -server "accept server3" 0]
 	proc accept {mp s a p} {
 	    puts $s $mp
 	    close $s
 	}
-    }
-    set s1 [socket $remoteServerIP 4003]
-    set s2 [socket $remoteServerIP 4004]
-    set s3 [socket $remoteServerIP 4005]
-    set l ""
-    lappend l [gets $s1] [gets $s1] [eof $s1] [gets $s2] [gets $s2] [eof $s2] \
+	list [getPort $s1] [getPort $s2] [getPort $s3]
+    }] p1 p2 p3
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+    set s1 [socket $remoteServerIP $p1]
+    set s2 [socket $remoteServerIP $p2]
+    set s3 [socket $remoteServerIP $p3]
+    list [gets $s1] [gets $s1] [eof $s1] [gets $s2] [gets $s2] [eof $s2] \
 	[gets $s3] [gets $s3] [eof $s3]
+} -cleanup {
     close $s1
     close $s2
     close $s3
@@ -1228,55 +1307,56 @@ test socket-11.8 {client with several servers} {socket doTestsWithRemoteServer}
 	close $s2
 	close $s3
     }
-    set l
-} {4003 {} 1 4004 {} 1 4005 {} 1}
-test socket-11.9 {accept callback error} -constraints {
-    socket doTestsWithRemoteServer
-} -setup {
+} -result {server1 {} 1 server2 {} 1 server3 {} 1}
+test socket_$af-11.9 {accept callback error} -constraints [list socket supported_$af doTestsWithRemoteServer] -setup {
     proc myHandler {msg options} {
 	variable x $msg
     }
     set handler [interp bgerror {}]
     interp bgerror {} [namespace which myHandler]
+    set timer [after 10000 "set x timed_out"]
 } -body {
-    set s [socket -server accept 2836]
-    proc accept {s a p} {expr 10 / 0}
-    if {[catch {sendCommand {
+    set s [socket -server accept 0]
+    proc accept {s a p} {expr {10 / 0}}
+    sendCommand "set port [getPort $s]"
+    if {[catch {
+	sendCommand {
 	    set peername [fconfigure $callerSocket -peername]
-	    set s [socket [lindex $peername 0] 2836]
+	    set s [socket [lindex $peername 0] $port]
 	    close $s
-    	 }} msg]} {
+    	 }
+    } msg]} then {
 	close $s
 	error $msg
     }
-    set timer [after 10000 "set x timed_out"]
     vwait x
-    after cancel $timer
-    close $s
-    set x
+    return $x
 } -cleanup {
+    close $s
+    after cancel $timer
     interp bgerror {} $handler
 } -result {divide by zero}
-test socket-11.10 {testing socket specific options} {socket doTestsWithRemoteServer} {
-    sendCommand {
-	set socket10_12_test_server [socket -server accept 2836]
+test socket_$af-11.10 {testing socket specific options} -setup {
+    set port [sendCommand {
+	set server [socket -server accept 0]
 	proc accept {s a p} {close $s}
-    }
-    set s [socket $remoteServerIP 2836]
+	getPort $server
+    }]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+    set s [socket $remoteServerIP $port]
     set p [fconfigure $s -peername]
     set n [fconfigure $s -sockname]
-    set l ""
-    lappend l [lindex $p 2] [llength $p] [llength $p]
+    list [expr {[lindex $p 2] == $port}] [llength $p] [llength $n]
+} -cleanup {
     close $s
-    sendCommand {close $socket10_12_test_server}
-    set l
-} {2836 3 3}
-test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
-    sendCommand {
-	set socket10_13_test_server [socket -server accept 2836]
+    sendCommand {close $server}
+} -result {1 3 3}
+test socket_$af-11.11 {testing spurious events} -setup {
+    set port [sendCommand {
+	set server [socket -server accept 0]
 	proc accept {s a p} {
 	    fconfigure $s -translation "auto lf"
-	    after 100 writesome $s
+	    after idle writesome $s
 	}
 	proc writesome {s} {
 	    for {set i 0} {$i < 100} {incr i} {
@@ -1284,10 +1364,13 @@ test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
 	    }
 	    close $s
 	}
-    }
+	getPort $server
+    }]
     set len 0
     set spurious 0
     set done 0
+    set timer [after 40000 "set done timed_out"]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
     proc readlittle {s} {
 	global spurious done len
 	set l [read $s 1]
@@ -1302,61 +1385,52 @@ test socket-11.11 {testing spurious events} {socket doTestsWithRemoteServer} {
 	    incr len [string length $l]
 	}
     }
-    set c [socket $remoteServerIP 2836]
+    set c [socket $remoteServerIP $port]
     fileevent $c readable "readlittle $c"
-    set timer [after 10000 "set done timed_out"]
     vwait done
+    list $spurious $len $done
+} -cleanup {
     after cancel $timer
-    sendCommand {close $socket10_13_test_server}
-    list $spurious $len
-} {0 2690}
-
-test socket-11.12 {testing EOF stickyness} {socket doTestsWithRemoteServer} {
+    sendCommand {close $server}
+} -result {0 2690 1}
+test socket_$af-11.12 {testing EOF stickyness} -constraints [list socket supported_$af doTestsWithRemoteServer] -setup {
     set counter 0
     set done 0
+    set port [sendCommand {
+	set server [socket -server accept 0]
+	proc accept {s a p} {
+	    after idle close $s
+	}
+	getPort $server
+    }]
+    proc timed_out {} {
+	global c done
+	set done {timed_out, EOF is not sticky}
+	close $c
+    }
+    set after_id [after 1000 timed_out]
+} -body {
     proc count_up {s} {
-	global counter done after_id
+	global counter done
 	set l [gets $s]
 	if {[eof $s]} {
 	    incr counter
 	    if {$counter > 9} {
 		set done {EOF is sticky}
-		after cancel $after_id
 		close $s
 	    }
 	}
     }
-    proc timed_out {} {
-	global c done
-	set done {timed_out, EOF is not sticky}
-	close $c
-    }
-    sendCommand {
-	set socket10_14_test_server [socket -server accept 2836]
-	proc accept {s a p} {
-	    after 100 close $s
-	}
-    }
-    set c [socket $remoteServerIP 2836]
+    set c [socket $remoteServerIP $port]
     fileevent $c readable [list count_up $c]
-    set after_id [after 1000 timed_out]
     vwait done
-    sendCommand {close $socket10_14_test_server}
-    set done
-} {EOF is sticky}
-
-test socket-11.13 {testing async write, async flush, async close} \
-	{socket doTestsWithRemoteServer} {
-    proc readit {s} {
-	global count done
-	set l [read $s]
-	incr count [string length $l]
-	if {[eof $s]} {
-	    close $s
-	    set done 1
-	}
-    }
-    sendCommand {
+    return $done
+} -cleanup {
+    after cancel $after_id
+    sendCommand {close $server}
+} -result {EOF is sticky}
+test socket_$af-11.13 {testing async write, async flush, async close} -setup {
+    set port [sendCommand {
 	set firstblock ""
 	for {set i 0} {$i < 5} {incr i} {
 		set firstblock "a$firstblock$firstblock"
@@ -1365,7 +1439,7 @@ test socket-11.13 {testing async write, async flush, async close} \
 	for {set i 0} {$i < 16} {incr i} {
 	    set secondblock "b$secondblock$secondblock"
 	}
-	set l [socket -server accept 2845]
+	set l [socket -server accept 0]
 	proc accept {s a p} {
 	    fconfigure $s -blocking 0 -translation lf -buffersize 16384 \
 		-buffering line
@@ -1374,143 +1448,138 @@ test socket-11.13 {testing async write, async flush, async close} \
 	proc readable {s} {
 	    set l [gets $s]
 	    fileevent $s readable {}
-	    after 1000 respond $s
+	    after idle respond $s
 	}
 	proc respond {s} {
 	    global firstblock
 	    puts -nonewline $s $firstblock
-	    after 1000 writedata $s
+	    after idle writedata $s
 	}
 	proc writedata {s} {
 	    global secondblock
 	    puts -nonewline $s $secondblock
 	    close $s
 	}
+	getPort $l
+    }]
+    set timer [after 10000 "set done timed_out"]
+} -constraints [list socket supported_$af doTestsWithRemoteServer] -body {
+    proc readit {s} {
+	global count done
+	set l [read $s]
+	incr count [string length $l]
+	if {[eof $s]} {
+	    close $s
+	    set done 1
+	}
     }
-    set s [socket $remoteServerIP 2845]
+    set s [socket $remoteServerIP $port]
     fconfigure $s -blocking 0 -trans lf -buffering line
     set count 0
     puts $s hello
     fileevent $s readable "readit $s"
-    set timer [after 10000 "set done timed_out"]
     vwait done
+    return $count
+} -cleanup {
     after cancel $timer
     sendCommand {close $l}
-    set count
-} 65566
+} -result 65566
 
 set path(script1) [makeFile {} script1]
 set path(script2) [makeFile {} script2]
 
-test socket-12.1 {testing inheritance of server sockets} {socket stdio exec} {
+test socket_$af-12.1 {testing inheritance of server sockets} -setup {
     file delete $path(script1)
     file delete $path(script2)
-
-    # Script1 is just a 10 second delay.  If the server socket
-    # is inherited, it will be held open for 10 seconds
-
+    # Script1 is just a 10 second delay. If the server socket is inherited, it
+    # will be held open for 10 seconds
     set f [open $path(script1) w]
     puts $f {
+	fileevent stdin readable exit
 	after 10000 exit
 	vwait forever
     }
     close $f
-
-    # Script2 creates the server socket, launches script1,
-    # waits a second, and exits.  The server socket will now
-    # be closed unless script1 inherited it.
-
+    # Script2 creates the server socket, launches script1, and exits.
+    # The server socket will now be closed unless script1 inherited it.
     set f [open $path(script2) w]
     puts $f [list set tcltest [interpreter]]
-    puts -nonewline $f {
-	set f [socket -server accept 0]
-	puts [lindex [fconfigure $f -sockname] 2]
+    puts $f [list set delay $path(script1)]
+    puts $f [list set localhost $localhost]
+    puts $f {
+	set f [socket -server accept -myaddr $localhost 0]
 	proc accept { file addr port } {
 	    close $file
 	}
-	exec $tcltest }
-    puts $f [list $path(script1) &]
-    puts $f {
+	exec $tcltest $delay &
+	puts [lindex [fconfigure $f -sockname] 2]
 	close $f
-	after 1000 exit
-	vwait forever
+        exit
     }
     close $f
-	
+} -constraints [list socket supported_$af stdio exec] -body {
     # Launch script2 and wait 5 seconds
-
     ### exec [interpreter] script2 &
     set p [open "|[list [interpreter] $path(script2)]" r]
-    gets $p listen
-
-    after 5000 { set ok_to_proceed 1 }
-    vwait ok_to_proceed
-
     # If we can still connect to the server, the socket got inherited.
-
-    if {[catch {socket 127.0.0.1 $listen} msg]} {
-	set x {server socket was not inherited}
+    if {[catch {close [socket $localhost $listen]}]} {
+	return {server socket was not inherited}
     } else {
-	close $msg
-	set x {server socket was inherited}
+	return {server socket was inherited}
     }
-
-    close $p
-    set x
-} {server socket was not inherited}
-test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} {
+} -cleanup {
+    catch {close $p}
+} -result {server socket was not inherited}
+test socket_$af-12.2 {testing inheritance of client sockets} -setup {
     file delete $path(script1)
     file delete $path(script2)
-
-    # Script1 is just a 20 second delay.  If the server socket
-    # is inherited, it will be held open for 10 seconds
-
+    # Script1 is just a 20 second delay. If the server socket is inherited, it
+    # will be held open for 20 seconds
     set f [open $path(script1) w]
     puts $f {
+	fileevent stdin readable exit
 	after 20000 exit
 	vwait forever
     }
     close $f
-
-    # Script2 opens the client socket and writes to it.  It then
-    # launches script1 and exits.  If the child process inherited the
-    # client socket, the socket will still be open.
-
+    # Script2 opens the client socket and writes to it. It then launches
+    # script1 and exits. If the child process inherited the client socket, the
+    # socket will still be open.
     set f [open $path(script2) w]
     puts $f [list set tcltest [interpreter]]
-    puts -nonewline $f {
-        gets stdin port
-	set f [socket 127.0.0.1 $port]
-        exec $tcltest }
-    puts $f [list $path(script1) &]
+    puts $f [list set delay $path(script1)]
+    puts $f [list set localhost $localhost]
     puts $f {
+        gets stdin port
+	set f [socket $localhost $port]
+        exec $tcltest $delay &
 	puts $f testing
 	flush $f
-	after 1000 exit
-	vwait forever
+        exit
     }
     close $f
-
+    # If the socket doesn't hit end-of-file in 10 seconds, the script1 process
+    # must have inherited the client.
+    set failed 0
+    set after [after 10000 [list set failed 1]]
+} -constraints [list socket supported_$af stdio exec] -body {
     # Create the server socket
-
-    set server [socket -server accept 0]
+    set server [socket -server accept -myaddr $localhost 0]
     proc accept { file host port } {
 	# When the client connects, establish the read handler
 	global server
 	close $server
 	fileevent $file readable [list getdata $file]
 	fconfigure $file -buffering line -blocking 0
-	return
     }
     proc getdata { file } {
 	# Read handler on the accepted socket.
-	global x
-	global failed
+	global x failed
 	set status [catch {read $file} data]
 	if {$status != 0} {
 	    set x {read failed, error was $data}
 	    catch { close $file }
-	} elseif {[string compare {} $data]} {
+	} elseif {$data ne ""} {
 	} elseif {[fblocked $file]} {
 	} elseif {[eof $file]} {
 	    if {$failed} {
@@ -1523,80 +1592,56 @@ test socket-12.2 {testing inheritance of client sockets} {socket stdio exec} {
 	    set x {impossible case}
 	    catch { close $file }
 	}
-	return
     }
-
-    # If the socket doesn't hit end-of-file in 10 seconds, the
-    # script1 process must have inherited the client.
-
-    set failed 0
-    after 10000 [list set failed 1]
-
     # Launch the script2 process
     ### exec [interpreter] script2 &
-
     set p [open "|[list [interpreter] $path(script2)]" w]
     puts $p [lindex [fconfigure $server -sockname] 2] ; flush $p
-
     vwait x
-    if {!$failed} {
-	vwait failed
-    }
+    return $x
+} -cleanup {
+    after cancel $after
     close $p
-    set x
-} {client socket was not inherited}
-test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
+} -result {client socket was not inherited}
+test socket_$af-12.3 {testing inheritance of accepted sockets} -setup {
     file delete $path(script1)
     file delete $path(script2)
-
     set f [open $path(script1) w]
     puts $f {
+	fileevent stdin readable exit
 	after 10000 exit
 	vwait forever
     }
     close $f
-
     set f [open $path(script2) w]
     puts $f [list set tcltest [interpreter]]
-    puts -nonewline $f {
-	set server [socket -server accept 0]
-	puts stdout [lindex [fconfigure $server -sockname] 2]
-	proc accept { file host port } }
-    puts $f \{
-    puts -nonewline $f {
-	    global tcltest
-	    puts $file {test data on socket}
-	    exec $tcltest }
-    puts $f [list $path(script1) &]
+    puts $f [list set delay $path(script1)]
+    puts $f [list set localhost $localhost]
     puts $f {
-	    after 1000 exit
+	set server [socket -server accept -myaddr $localhost 0]
+	proc accept { file host port } {
+	    global tcltest delay
+	    puts $file {test data on socket}
+	    exec $tcltest $delay &
+            after idle exit
 	}
-    puts $f \} 
-    puts $f {
+	puts stdout [lindex [fconfigure $server -sockname] 2]
 	vwait forever
     }
     close $f
-
-    # Launch the script2 process and connect to it.  See how long
-    # the socket stays open
-
+} -constraints [list socket supported_$af stdio exec] -body {
+    # Launch the script2 process and connect to it. See how long the socket
+    # stays open
     ## exec [interpreter] script2 &
     set p [open "|[list [interpreter] $path(script2)]" r]
     gets $p listen
-
-    after 1000 set ok_to_proceed 1
-    vwait ok_to_proceed
-
-    set f [socket 127.0.0.1 $listen]
+    set f [socket $localhost $listen]
     fconfigure $f -buffering full -blocking 0
     fileevent $f readable [list getdata $f]
-
-    # If the socket is still open after 5 seconds, the script1 process
-    # must have inherited the accepted socket.
-
+    # If the socket is still open after 5 seconds, the script1 process must
+    # have inherited the accepted socket.
     set failed 0
-    after 5000 set failed 1
-
+    set after [after 5000 [list set failed 1]]
     proc getdata { file } {
 	# Read handler on the client socket.
 	global x
@@ -1620,20 +1665,17 @@ test socket-12.3 {testing inheritance of accepted sockets} {socket stdio exec} {
 	}
 	return
     }
-    
     vwait x
+    return $x
+} -cleanup {
+    after cancel $after
+    catch {close $p}
+} -result {accepted socket was not inherited}
 
-    close $p
-    set x
-} {accepted socket was not inherited}
-
-test socket-13.1 {Testing use of shared socket between two threads} \
-        -constraints {socket testthread} -setup {
-
-    threadReap
-
-    set path(script) [makeFile {
-        set f [socket -server accept 0]
+test socket_$af-13.1 {Testing use of shared socket between two threads} -body {
+    # create a thread
+    set serverthread [thread::create -preserved [string map [list @localhost@ $localhost] {
+        set f [socket -server accept -myaddr @localhost@ 0]
         set listen [lindex [fconfigure $f -sockname] 2]
         proc accept {s a p} {
             fileevent $s readable [list echo $s]
@@ -1654,46 +1696,193 @@ test socket-13.1 {Testing use of shared socket between two threads} \
         set i 0
         vwait x
         close $f
-
-        # thread cleans itself up.
-        testthread exit
-    } script]
-
-} -body {
-    # create a thread
-    set serverthread [testthread create [list source $path(script) ] ]
-    update
-    set port [testthread send $serverthread {set listen}]
-    update
-
-    after 1000
-    set s [socket 127.0.0.1 $port]
+	thread::wait
+    }]]
+    set port [thread::send $serverthread {set listen}]
+    set s [socket $localhost $port]
     fconfigure $s -buffering line
-
     catch {
         puts $s "hello"
         gets $s result
     }
     close $s
-    update
-
-    after 2000
-    lappend result [threadReap]
-} -cleanup {
-    removeFile script
-} -result {hello 1}
-
+    thread::release $serverthread
+    append result " " [llength [thread::names]]
+} -result {hello 1} -constraints [list socket supported_$af thread] 
+
+# ----------------------------------------------------------------------
 
 removeFile script1
 removeFile script2
 
 # cleanup
-if {[string match sock* $commandSocket] == 1} {
-   puts $commandSocket exit
-   flush $commandSocket
+if {$remoteProcChan ne ""} {
+    catch {sendCommand exit}
 }
 catch {close $commandSocket}
 catch {close $remoteProcChan}
+}
+unset ::tcl::unsupported::socketAF
+test socket-14.0 {[socket -async] when server only listens on IPv4} \
+    -constraints [list socket supported_any localhost_v4] \
+    -setup {
+        proc accept {s a p} {
+            global x
+            puts $s bye
+            close $s
+            set x ok
+        }
+        set server [socket -server accept -myaddr 127.0.0.1 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+    } -body {
+        set client [socket -async localhost $port]
+        set after [after 1000 {set x [fconfigure $client -error]}]
+        vwait x
+        set x
+    } -cleanup {
+        after cancel $after
+        close $server
+        close $client
+        unset x
+    } -result ok
+test socket-14.1 {[socket -async] fileevent while still connecting} \
+    -constraints [list socket supported_any] \
+    -setup {
+        proc accept {s a p} {
+            global x
+            puts $s bye
+            close $s
+	    lappend x ok
+        }
+        set server [socket -server accept -myaddr localhost 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+        set x ""
+    } -body {
+        set client [socket -async localhost $port]
+        fileevent $client writable {
+            lappend x [fconfigure $client -error]
+	    fileevent $client writable {}
+        }
+        set after [after 1000 {lappend x timeout}]
+        while {[llength $x] < 2 && "timeout" ni $x} {
+            vwait x
+        }
+        lsort $x; # we only want to see both events, the order doesn't matter
+    } -cleanup {
+        after cancel $after
+        close $server
+        close $client
+        unset x
+    } -result {{} ok}
+test socket-14.2 {[socket -async] fileevent connection refused} \
+    -constraints [list socket supported_any] \
+    -body {
+        if {[catch {socket -async localhost [randport]} client]} {
+	    regexp {[^:]*: (.*)} $client -> x
+	} else {
+            fileevent $client writable {set x [fconfigure $client -error]}
+            set after [after 1000 {set x timeout}]
+            vwait x
+	    after cancel $after
+            if {$x eq "timeout"} {
+                append x ": [fconfigure $client -error]"
+            }
+	    close $client
+	}
+        set x
+    } -cleanup {
+        unset x
+    } -result "connection refused"
+test socket-14.3 {[socket -async] when server only listens on IPv6} \
+    -constraints [list socket supported_any localhost_v6] \
+    -setup {
+        proc accept {s a p} {
+            global x
+            puts $s bye
+            close $s
+            set x ok
+        }
+        set server [socket -server accept -myaddr ::1 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+    } -body {
+        set client [socket -async localhost $port]
+        set after [after 1000 {set x [fconfigure $client -error]}]
+        vwait x
+        set x
+    } -cleanup {
+        after cancel $after
+        close $server
+        close $client
+        unset x
+    } -result ok
+test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
+    -constraints [list socket supported_any] \
+    -setup {
+        proc accept {s a p} {
+            puts $s bye
+            close $s
+        }
+        set server [socket -server accept -myaddr localhost 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+        set x ""
+    } -body {
+        set client [socket -async localhost $port]
+        fileevent $client writable {
+            lappend x [fconfigure $client -error]
+            fileevent $client writable {}
+        }
+        fileevent $client readable {lappend x [gets $client]}
+        set after [after 1000 {lappend x timeout}]
+        while {[llength $x] < 2 && "timeout" ni $x} {
+            vwait x
+        }
+        lsort $x
+    } -cleanup {
+        after cancel $after
+        close $client
+        close $server
+        unset x
+    } -result {{} bye}
+test socket-14.5 {[socket -async] which fails before any connect() can be made} \
+    -constraints [list socket supported_any] \
+    -body {
+        # address from rfc5737
+        socket -async -myaddr 192.0.2.42 127.0.0.1 [randport]
+    } \
+    -returnCodes 1 \
+    -result {couldn't open socket: cannot assign requested address}
+test socket-14.6 {[socket -async] with no event loop and [fconfigure -error] before the socket is connected} \
+    -constraints [list socket supported_inet supported_inet6] \
+    -setup {
+        proc accept {s a p} {
+            puts $s bye
+            close $s
+        }
+        set server [socket -server accept -myaddr 127.0.0.1 0]
+        set port [lindex [fconfigure $server -sockname] 2]
+        set x ""
+    } \
+    -body {
+        set client [socket -async localhost $port]
+        foreach _ {1 2} {
+            lappend x [lindex [fconfigure $client -sockname] 0]
+            lappend x [fconfigure $client -error]
+            update
+        }
+        lappend x [gets $client]
+    } \
+    -cleanup {
+        close $server
+        close $client
+        unset x
+    } \
+    -result [list ::1 "connection refused" 127.0.0.1 "" bye]
+
 ::tcltest::cleanupTests
 flush stdout
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/source.test b/tests/source.test
index 1d64034..0235bd1 100644
--- a/tests/source.test
+++ b/tests/source.test
@@ -11,8 +11,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: source.test,v 1.12 2004/03/17 18:14:18 das Exp $
 
 if {[catch {package require tcltest 2.1}]} {
     puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
@@ -20,13 +18,8 @@ if {[catch {package require tcltest 2.1}]} {
 }
 
 namespace eval ::tcl::test::source {
-    namespace import ::tcltest::test
-    namespace import ::tcltest::testConstraint
-    namespace import ::tcltest::cleanupTests
-    namespace import ::tcltest::makeFile
-    namespace import ::tcltest::removeFile
-    namespace import ::tcltest::customMatch
-
+    namespace import ::tcltest::*
+
 test source-1.1 {source command} -setup {
     set x "old x value"
     set y "old y value"
@@ -42,7 +35,6 @@ test source-1.1 {source command} -setup {
 } -cleanup {
     removeFile source.file
 } -result {22 33 44}
-
 test source-1.2 {source command} -setup {
     set sourcefile [makeFile {list result} source.file]
 } -body {
@@ -50,7 +42,6 @@ test source-1.2 {source command} -setup {
 } -cleanup {
     removeFile source.file
 } -result result
-
 test source-1.3 {source command} -setup {
     set sourcefile [makeFile {} source.file]
     set fd [open $sourcefile w]
@@ -94,7 +85,6 @@ test source-2.3 {source error conditions} -setup {
     (file "*source.file" line 3)
     invoked from within
 "source $sourcefile"}]
-
 test source-2.4 {source error conditions} -setup {
     set sourcefile [makeFile {break} source.file]
 } -body {
@@ -102,7 +92,6 @@ test source-2.4 {source error conditions} -setup {
 } -cleanup {
     removeFile source.file
 } -returnCodes break
-
 test source-2.5 {source error conditions} -setup {
     set sourcefile [makeFile {continue} source.file]
 } -body {
@@ -110,7 +99,6 @@ test source-2.5 {source error conditions} -setup {
 } -cleanup {
     removeFile source.file
 } -returnCodes continue
-
 test source-2.6 {source error conditions} -setup {
     set sourcefile [makeFile {} _non_existent_]
     removeFile _non_existent_
@@ -119,7 +107,19 @@ test source-2.6 {source error conditions} -setup {
 } -match listGlob -result [list 1 \
 	{couldn't read file "*_non_existent_": no such file or directory} \
 	{POSIX ENOENT {no such file or directory}}]
-
+test source-2.7 {utf-8 with BOM} -setup {
+    set sourcefile [makeFile {} source.file]
+} -body {
+    set out [open $sourcefile w]
+    fconfigure $out -encoding utf-8
+    puts $out "\ufeffset y new-y"
+    close $out
+    set y old-y
+    source -encoding utf-8 $sourcefile
+    return $y
+} -cleanup {
+    removeFile $sourcefile
+} -result {new-y}
 
 test source-3.1 {return in middle of source file} -setup {
     set sourcefile [makeFile {
@@ -135,7 +135,6 @@ test source-3.1 {return in middle of source file} -setup {
 } -cleanup {
     removeFile source.file
 } -result {new-x old-y allDone}
-
 test source-3.2 {return with special code etc.} -setup {
     set sourcefile [makeFile {
 	set x new-x
@@ -147,7 +146,6 @@ test source-3.2 {return with special code etc.} -setup {
 } -cleanup {
     removeFile source.file
 } -returnCodes break -result {Silly result}
-
 test source-3.3 {return with special code etc.} -setup {
     set sourcefile [makeFile {
 	set x new-x
@@ -161,7 +159,6 @@ test source-3.3 {return with special code etc.} -setup {
 } -result {1 {Simulated error} {Simulated error
     while executing
 "source $sourcefile"} NONE}
-
 test source-3.4 {return with special code etc.} -setup {
     set sourcefile [makeFile {
 	set x new-x
@@ -175,7 +172,6 @@ test source-3.4 {return with special code etc.} -setup {
 } -result {1 {} {Simulated errorInfo stuff
     invoked from within
 "source $sourcefile"} NONE}
-
 test source-3.5 {return with special code etc.} -setup {
     set sourcefile [makeFile {
 	set x new-x
@@ -191,6 +187,15 @@ test source-3.5 {return with special code etc.} -setup {
     invoked from within
 "source $sourcefile"} {a b c}}
 
+test source-4.1 {continuation line parsing} -setup {
+    set sourcefile [makeFile [string map {CL \\\n} {
+	format %s "[dict get [info frame 0] type]:CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]CL[dict get [info frame 0] line]"
+    }] source.file]
+} -body {
+    source $sourcefile
+} -cleanup {
+    removeFile source.file
+} -result {source: 3 4 5}
 
 test source-6.1 {source is binary ok} -setup {
     # Note [makeFile] writes in the system encoding.
@@ -203,7 +208,6 @@ test source-6.1 {source is binary ok} -setup {
 } -cleanup {
     removeFile source.file
 } -result 5
-
 test source-6.2 {source skips everything after Ctrl-Z: Bug 2040} -setup {
     set sourcefile [makeFile "set x ab\32c" source.file]
 } -body {
@@ -228,7 +232,6 @@ test source-7.1 {source -encoding test} -setup {
 } -cleanup {
     removeFile source.file
 } -result correct
-
 test source-7.2 {source -encoding test} -setup {
     # This tests for bad interactions between [source -encoding]
     # and use of the Control-Z character (\u001A) as a cross-platform
@@ -248,12 +251,10 @@ test source-7.2 {source -encoding test} -setup {
 } -cleanup {
     removeFile source.file
 } -result correct
-
 test source-7.3 {source -encoding: syntax} -body {
     # Have to spell out the -encoding option
     source -e utf-8 no_file
 } -returnCodes 1 -match glob -result {bad option*}
-
 test source-7.4 {source -encoding: syntax} -setup {
     set sourcefile [makeFile {} source.file]
 } -body {
@@ -261,7 +262,6 @@ test source-7.4 {source -encoding: syntax} -setup {
 } -cleanup {
     removeFile source.file
 } -returnCodes 1 -match glob -result {unknown encoding*}
-
 test source-7.5 {source -encoding: correct operation} -setup {
     set sourcefile [makeFile {} source.file]
     file delete $sourcefile
@@ -276,7 +276,6 @@ test source-7.5 {source -encoding: correct operation} -setup {
     removeFile source.file
     rename \u20ac {}
 } -result foo
-
 test source-7.6 {source -encoding: mismatch encoding error} -setup {
     set sourcefile [makeFile {} source.file]
     file delete $sourcefile
@@ -291,7 +290,23 @@ test source-7.6 {source -encoding: mismatch encoding error} -setup {
     removeFile source.file
 } -returnCodes error -match glob -result {invalid command name*}
 
+test source-8.1 {source and coroutine/yield} -setup {
+    set sourcefile [makeFile {} source.file]
+    file delete $sourcefile
+} -body {
+    makeFile {yield 1; yield 2; return 3;} $sourcefile
+    coroutine coro apply {f {yield;source $f}} $sourcefile
+    list [coro] [coro] [coro] [info exist coro]
+} -cleanup {
+    catch {rename coro {}}
+    removeFile source.file
+} -result {1 2 3 0}
+
 cleanupTests
 }
 namespace delete ::tcl::test::source
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/split.test b/tests/split.test
index 93b0cc4..778131f 100644
--- a/tests/split.test
+++ b/tests/split.test
@@ -1,23 +1,21 @@
 # Commands covered:  split
 #
-# 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-1996 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.
-#
-# RCS: @(#) $Id: split.test,v 1.9 2004/05/19 10:50:30 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-
+
 test split-1.1 {basic split commands} {
     split "a\n b\t\r c\n "
 } {a {} b {} {} c {} {}}
@@ -75,12 +73,16 @@ test split-1.14 {basic split commands} {
 
 test split-2.1 {split errors} {
     list [catch split msg] $msg $errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
+} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}
 test split-2.2 {split errors} {
     list [catch {split a b c} msg] $msg $errorCode
-} {1 {wrong # args: should be "split string ?splitChars?"} NONE}
-
+} {1 {wrong # args: should be "split string ?splitChars?"} {TCL WRONGARGS}}
+
 # cleanup
 catch {rename foo {}}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/stack.test b/tests/stack.test
index 64b669a..13bc524 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -8,73 +8,49 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: stack.test,v 1.18 2004/06/23 00:24:43 dkf Exp $
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2
-    namespace import -force ::tcltest::*
-}
 
-# Note that a failure in this test results in a crash of the executable.
-# In order to avoid that, we do a basic check of the current stacksize.
-# This size can be changed with ulimit (ksh/bash/sh) or limit (csh/tcsh).
+package require tcltest 2
+namespace import ::tcltest::*
 
-# This doesn't catch all cases, for example threads of lower stacksize
-# can still squeak through.  A core check is really needed. -- JH
+# Note that a failure in this test may result in a crash of the executable.
 
-if {[string equal $::tcl_platform(platform) "unix"]} {
-    set stackSize [exec /bin/sh -c "ulimit -s"]
-    if {[string is integer $stackSize] && ($stackSize < 2400)} {
-        puts stderr "WARNING: the default application stacksize of $stackSize\
-                may cause Tcl to\ncrash due to stack overflow before the\
-                recursion limit is reached.\nA minimum stacksize of 2400\
-                kbytes is recommended.\nSkipping infinite recursion test."
-        ::tcltest::testConstraint minStack2400 0
-    } else {
-        ::tcltest::testConstraint minStack2400 1
+test stack-1.1 {maxNestingDepth reached on infinite recursion} -body {
+    # do this in a sub process in case it segfaults
+    exec [interpreter] << {
+	proc recurse {} { recurse }
+	catch { recurse } rv
+	puts $rv
     }
-} else {
-    ::tcltest::testConstraint minStack2400 1
-}
-
-test stack-1.1 {maxNestingDepth reached on infinite recursion} {minStack2400} {
-    proc recurse {} { return [recurse] }
-    catch {recurse} rv
-    rename recurse {}
-    set rv
-} {too many nested evaluations (infinite loop?)}
-
-test stack-2.1 {maxNestingDepth reached on infinite recursion} {minStack2400} {
-    # do this in a slave to not mess with parent
-    set slave stack-2.1
-    interp create $slave
-    $slave eval { interp alias {} unknown {} notaknownproc }
-    set msg [$slave eval { catch {foo} msg ; set msg }]
-    interp delete $slave
-    set msg
-} {too many nested evaluations (infinite loop?)}
-
+} -result {too many nested evaluations (infinite loop?)}
+
+test stack-2.1 {maxNestingDepth reached on infinite recursion} -body {
+    # do this in a sub process in case it segfaults
+    exec [interpreter] << {
+	interp alias {} unknown {} notaknownproc
+	catch { unknown } msg
+	puts $msg
+    }
+} -result {too many nested evaluations (infinite loop?)}
+    
 # Make sure that there is enough stack to run regexp even if we're
 # close to the recursion limit. [Bug 947070] [Patch 746378]
-test stack-3.1 {enough room for regexp near recursion limit} -setup {
-    set limit [interp recursionlimit {} 10000]
-    set depth 0
-    proc a { max } {
-	if { [info level] < $max } {
-	    set ::depth [info level]
-	    a $max
-	} else {
-	    regexp {^ ?} x
+test stack-3.1 {enough room for regexp near recursion limit} -body {
+    # do this in a sub process in case it segfaults
+    exec [interpreter] << {
+	interp recursionlimit {} 10000
+	set depth 0
+	proc a { max } {
+	    if { [info level] < $max } {
+		set ::depth [info level]
+		a $max
+	    } else {
+		regexp {^ ?} x
+	    }
 	}
+	catch { a 10001 }
+	set depth2 $depth
+	puts [list [a $depth] [expr { $depth2 - $depth }]]
     }
-} -body {
-    catch { a 10001 }
-    set depth2 $depth
-    list [a $depth] [expr { $depth2 - $depth }]
-} -cleanup {
-    interp recursionlimit {} $limit
-    rename a {}
 } -result {1 1}
 
 # cleanup
diff --git a/tests/string.test b/tests/string.test
index 2402657..cf658a2 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -11,25 +11,29 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: string.test,v 1.51 2005/07/28 18:42:33 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 # Some tests require the testobj command
 
 testConstraint testobj [expr {[info commands testobj] != {}}]
 testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
 
+# Used for constraining memory leak tests
+testConstraint memory [llength [info commands memory]]
+
 test string-1.1 {error conditions} {
     list [catch {string gorp a b} msg] $msg
-} {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
 test string-1.2 {error conditions} {
     list [catch {string} msg] $msg
-} {1 {wrong # args: should be "string option arg ?arg ...?"}}
+} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
 
 test string-2.1 {string compare, too few args} {
     list [catch {string compare a} msg] $msg
@@ -173,13 +177,13 @@ test string-3.8 {string equal with length, unequal strings} {
 
 test string-4.1 {string first, too few args} {
     list [catch {string first a} msg] $msg
-} {1 {wrong # args: should be "string first subString string ?startIndex?"}}
+} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
 test string-4.2 {string first, bad args} {
     list [catch {string first a b c} msg] $msg
 } {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
 test string-4.3 {string first, too many args} {
     list [catch {string first a b 5 d} msg] $msg
-} {1 {wrong # args: should be "string first subString string ?startIndex?"}}
+} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
 test string-4.4 {string first} {
     string first bq abcdefgbcefgbqrs
 } 12
@@ -274,12 +278,12 @@ test string-5.16 {string index, bytearray object with string obj shimmering} {
     binary scan $str H* dump
     string compare [string index $str 10] \x00
 } 0
-test string-5.17 {string index, bad integer} {
-    list [catch {string index "abc" 08} msg] $msg
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-test string-5.18 {string index, bad integer} {
-    list [catch {string index "abc" end-00289} msg] $msg
-} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
+test string-5.17 {string index, bad integer} -body {
+    list [catch {string index "abc" 0o8} msg] $msg
+} -match glob -result {1 {*invalid octal number*}}
+test string-5.18 {string index, bad integer} -body {
+    list [catch {string index "abc" end-0o0289} msg] $msg
+} -match glob -result {1 {*invalid octal number*}}
 test string-5.19 {string index, bytearray object out of bounds} {
     string index [binary format I* {0x50515253 0x52}] -1
 } {}
@@ -293,7 +297,7 @@ proc largest_int {} {
     # so we can test for overflow properly below on >32 bit systems
     set int 1
     set exp 7; # assume we get at least 8 bits
-    while {$int > 0} { set int [expr {wide(1) << [incr exp]}] }
+    while {wide($int) > 0} { set int [expr {wide(1) << [incr exp]}] }
     return [expr {$int-1}]
 }
 
@@ -311,10 +315,10 @@ test string-6.4 {string is, too many args} {
 } {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
 test string-6.5 {string is, class check} {
     list [catch {string is bogus str} msg] $msg
-} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
+} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
 test string-6.6 {string is, ambiguous class} {
     list [catch {string is al str} msg] $msg
-} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
+} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
 test string-6.7 {string is alpha, all ok} {
     string is alpha -strict -failindex var abc
 } 1
@@ -337,9 +341,7 @@ test string-6.12 {string is alnum, true} {
 test string-6.13 {string is alnum, false} {
     list [string is alnum -failindex var abc1.23] $var
 } {0 4}
-test string-6.14 {string is alnum, unicode} {
-    string is alnum abcü
-} 1
+test string-6.14 {string is alnum, unicode} "string is alnum abc\xfc" 1
 test string-6.15 {string is alpha, true} {
     string is alpha abc
 } 1
@@ -350,11 +352,11 @@ test string-6.17 {string is alpha, unicode} {
     string is alpha abc\374
 } 1
 test string-6.18 {string is ascii, true} {
-    string is ascii abc\u007Fend
+    string is ascii abc\u007Fend\u0000
 } 1
 test string-6.19 {string is ascii, false} {
-    list [string is ascii -fail var abcdef\u0080more] $var
-} {0 6}
+    list [string is ascii -fail var abc\u0000def\u0080more] $var
+} {0 7}
 test string-6.20 {string is boolean, true} {
     string is boolean true
 } 1
@@ -371,7 +373,7 @@ test string-6.24 {string is digit, true} {
     string is digit 0123456789
 } 1
 test string-6.25 {string is digit, false} {
-    list [string is digit -fail var 0123Ü567] $var
+    list [string is digit -fail var 0123\u00dc567] $var
 } {0 4}
 test string-6.26 {string is digit, false} {
     list [string is digit -fail var +123567] $var
@@ -406,10 +408,15 @@ test string-6.35 {string is double, false} {
 test string-6.36 {string is double, false} {
     list [string is double -fail var "\n"] $var
 } {0 0}
-test string-6.37 {string is double, false on int overflow} {
+test string-6.37 {string is double, false on int overflow} -setup {
+    set var priorValue
+} -body {
     # Make it the largest int recognizable, with one more digit for overflow
+    # Since bignums arrived in Tcl 8.5, the sense of this test changed.
+    # Now integer values that exceed native limits become bignums, and
+    # bignums can convert to doubles without error.
     list [string is double -fail var [largest_int]0] $var
-} {0 -1}
+} -result {1 priorValue}
 # string-6.38 removed, underflow on input is no longer an error.
 test string-6.39 {string is double, false} {
     # This test is non-portable because IRIX thinks 
@@ -477,8 +484,11 @@ test string-6.57 {string is integer, false} {
     list [string is integer -fail var "    "] $var
 } {0 0}
 test string-6.58 {string is integer, false on bad octal} {
-    list [string is integer -fail var 036963] $var
-} {0 3}
+    list [string is integer -fail var 0o36963] $var
+} {0 4}
+test string-6.58.1 {string is integer, false on bad octal} {
+    list [string is integer -fail var 0o36963] $var
+} {0 4}
 test string-6.59 {string is integer, false on bad hex} {
     list [string is integer -fail var 0X345XYZ] $var
 } {0 5}
@@ -486,7 +496,7 @@ test string-6.60 {string is lower, true} {
     string is lower abc
 } 1
 test string-6.61 {string is lower, unicode true} {
-    string is lower abcüue
+    string is lower abc\u00fcue
 } 1
 test string-6.62 {string is lower, false} {
     list [string is lower -fail var aBc] $var
@@ -495,7 +505,7 @@ test string-6.63 {string is lower, false} {
     list [string is lower -fail var abc1] $var
 } {0 3}
 test string-6.64 {string is lower, unicode false} {
-    list [string is lower -fail var abÜUE] $var
+    list [string is lower -fail var ab\u00dcUE] $var
 } {0 2}
 test string-6.65 {string is space, true} {
     string is space " \t\n\v\f"
@@ -533,7 +543,7 @@ test string-6.75 {string is upper, true} {
     string is upper ABC
 } 1
 test string-6.76 {string is upper, unicode true} {
-    string is upper ABCÜUE
+    string is upper ABC\u00dcUE
 } 1
 test string-6.77 {string is upper, false} {
     list [string is upper -fail var AbC] $var
@@ -542,13 +552,13 @@ test string-6.78 {string is upper, false} {
     list [string is upper -fail var AB2C] $var
 } {0 2}
 test string-6.79 {string is upper, unicode false} {
-    list [string is upper -fail var ABCüue] $var
+    list [string is upper -fail var ABC\u00fcue] $var
 } {0 3}
 test string-6.80 {string is wordchar, true} {
     string is wordchar abc_123
 } 1
 test string-6.81 {string is wordchar, unicode true} {
-    string is wordchar abcüabÜAB\u5001
+    string is wordchar abc\u00fcab\u00dcAB\u5001
 } 1
 test string-6.82 {string is wordchar, false} {
     list [string is wordchar -fail var abcd.ef] $var
@@ -587,7 +597,7 @@ test string-6.90 {string is integer, bad integers} {
     foreach num $numbers {
 	lappend result [string is int -strict $num]
     }
-    set result
+    return $result
 } {1 1 0 0 0 1 0 0}
 test string-6.91 {string is double, bad doubles} {
     set result ""
@@ -595,20 +605,20 @@ test string-6.91 {string is double, bad doubles} {
     foreach num $numbers {
 	lappend result [string is double -strict $num]
     }
-    set result
+    return $result
 } {1 1 0 0 0 1 0 0}
-test string-6.92 {string is double, 32-bit overflow} {
+test string-6.92 {string is integer, 32-bit overflow} {
     # Bug 718878
     set x 0x100000000
     list [string is integer -failindex var $x] $var
 } {0 -1}
-test string-6.93 {string is double, 32-bit overflow} {
+test string-6.93 {string is integer, 32-bit overflow} {
     # Bug 718878
     set x 0x100000000
     append x ""
     list [string is integer -failindex var $x] $var
 } {0 -1}
-test string-6.94 {string is double, 32-bit overflow} {
+test string-6.94 {string is integer, 32-bit overflow} {
     # Bug 718878
     set x 0x100000000
     list [string is integer -failindex var [expr {$x}]] $var
@@ -644,8 +654,11 @@ test string-6.104 {string is wideinteger, false} {
     list [string is wideinteger -fail var "    "] $var
 } {0 0}
 test string-6.105 {string is wideinteger, false on bad octal} {
-    list [string is wideinteger -fail var 036963] $var
-} {0 3}
+    list [string is wideinteger -fail var 0o36963] $var
+} {0 4}
+test string-6.105.1 {string is wideinteger, false on bad octal} {
+    list [string is wideinteger -fail var 0o36963] $var
+} {0 4}
 test string-6.106 {string is wideinteger, false on bad hex} {
     list [string is wideinteger -fail var 0X345XYZ] $var
 } {0 5}
@@ -656,20 +669,100 @@ test string-6.107 {string is integer, bad integers} {
     foreach num $numbers {
 	lappend result [string is wideinteger -strict $num]
     }
-    set result
+    return $result
+} {1 1 0 0 0 1 0 0}
+test string-6.108 {string is double, Bug 1382287} {
+    set x 2turtledoves
+    string is double $x
+    string is double $x
+} 0
+test string-6.109 {string is double, Bug 1360532} {
+    string is double 1\u00a0
+} 0
+test string-6.110 {string is entier, true} {
+    string is entier +1234567890
+} 1
+test string-6.111 {string is entier, true on type} {
+    string is entier [expr wide(50.0)]
+} 1
+test string-6.112 {string is entier, true} {
+    string is entier [list -10]
+} 1
+test string-6.113 {string is entier, true as hex} {
+    string is entier 0xabcdef
+} 1
+test string-6.114 {string is entier, true as octal} {
+    string is entier 0123456
+} 1
+test string-6.115 {string is entier, true with whitespace} {
+    string is entier "  \n1234\v"
+} 1
+test string-6.116 {string is entier, false} {
+    list [string is entier -fail var 123abc] $var
+} {0 3}
+test string-6.117 {string is entier, false} {
+    list [string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc] $var
+} {0 84}
+test string-6.118 {string is entier, false} {
+    list [string is entier -fail var [expr double(1)]] $var
+} {0 1}
+test string-6.119 {string is entier, false} {
+    list [string is entier -fail var "    "] $var
+} {0 0}
+test string-6.120 {string is entier, false on bad octal} {
+    list [string is entier -fail var 0o36963] $var
+} {0 4}
+test string-6.121.1 {string is entier, false on bad octal} {
+    list [string is entier -fail var 0o36963] $var
+} {0 4}
+test string-6.122 {string is entier, false on bad hex} {
+    list [string is entier -fail var 0X345XYZ] $var
+} {0 5}
+test string-6.123 {string is entier, bad integers} {
+    # SF bug #634856
+    set result ""
+    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
+    foreach num $numbers {
+	lappend result [string is entier -strict $num]
+    }
+    return $result
 } {1 1 0 0 0 1 0 0}
+test string-6.124 {string is entier, true} {
+    string is entier +1234567890123456789012345678901234567890
+} 1
+test string-6.125 {string is entier, true} {
+    string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]
+} 1
+test string-6.126 {string is entier, true as hex} {
+    string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef
+} 1
+test string-6.127 {string is entier, true as octal} {
+    string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456
+} 1
+test string-6.128 {string is entier, true with whitespace} {
+    string is entier "  \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"
+} 1
+test string-6.129 {string is entier, false on bad octal} {
+    list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
+} {0 87}
+test string-6.130.1 {string is entier, false on bad octal} {
+    list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
+} {0 87}
+test string-6.131 {string is entier, false on bad hex} {
+    list [string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ] $var
+} {0 88}
 
 catch {rename largest_int {}}
 
 test string-7.1 {string last, too few args} {
     list [catch {string last a} msg] $msg
-} {1 {wrong # args: should be "string last subString string ?startIndex?"}}
+} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
 test string-7.2 {string last, bad args} {
     list [catch {string last a b c} msg] $msg
 } {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
 test string-7.3 {string last, too many args} {
     list [catch {string last a b c d} msg] $msg
-} {1 {wrong # args: should be "string last subString string ?startIndex?"}}
+} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
 test string-7.4 {string last} {
     string la xxx xxxx123xx345x678
 } 1
@@ -804,10 +897,10 @@ test string-10.18 {string map, empty argument} {
 test string-10.19 {string map, empty arguments} {
     string map -nocase {{} abc f bar {} def} foo
 } baroo
-test string-10.20 {string map, dictionaries can alter map ordering} {
+test string-10.20 {string map, dictionaries don't alter map ordering} {
     set map {aa X a Y}
     list [string map [dict create aa X a Y] aaa] [string map $map aaa] [dict size $map] [string map $map aaa]
-} {YYY XY 2 XY}
+} {XY XY 2 XY}
 test string-10.21 {string map, ABR checks} {
     string map {longstring foob} long
 } long
@@ -870,9 +963,54 @@ test string-11.8 {string match} {
 test string-11.9 {string match} {
     string match *3*6*9 0123456789
 } 1
+test string-11.9.1 {string match} {
+    string match *3*6*89 0123456789
+} 1
+test string-11.9.2 {string match} {
+    string match *3*456*89 0123456789
+} 1
+test string-11.9.3 {string match} {
+    string match *3*6* 0123456789
+} 1
+test string-11.9.4 {string match} {
+    string match *3*56* 0123456789
+} 1
+test string-11.9.5 {string match} {
+    string match *3*456*** 0123456789
+} 1
+test string-11.9.6 {string match} {
+    string match **3*456** 0123456789
+} 1
+test string-11.9.7 {string match} {
+    string match *3***456* 0123456789
+} 1
+test string-11.9.8 {string match} {
+    string match *3***\[456]* 0123456789
+} 1
+test string-11.9.9 {string match} {
+    string match *3***\[4-6]* 0123456789
+} 1
+test string-11.9.10 {string match} {
+    string match *3***\[4-6] 0123456789
+} 0
+test string-11.9.11 {string match} {
+    string match *3***\[4-6] 0123456
+} 1
 test string-11.10 {string match} {
     string match *3*6*9 01234567890
 } 0
+test string-11.10.1 {string match} {
+    string match *3*6*89 01234567890
+} 0
+test string-11.10.2 {string match} {
+    string match *3*456*89 01234567890
+} 0
+test string-11.10.3 {string match} {
+    string match **3*456*89 01234567890
+} 0
+test string-11.10.4 {string match} {
+    string match *3*456***89 01234567890
+} 0
 test string-11.11 {string match} {
     string match a?c abc
 } 1
@@ -963,6 +1101,21 @@ test string-11.38 {string match case, reverse range} {
 test string-11.39 {string match, *\ case} {
     string match {*\abc} abc
 } 1
+test string-11.39.1 {string match, *\ case} {
+    string match {*ab\c} abc
+} 1
+test string-11.39.2 {string match, *\ case} {
+    string match {*ab\*} ab*
+} 1
+test string-11.39.3 {string match, *\ case} {
+    string match {*ab\*} abc
+} 0
+test string-11.39.4 {string match, *\ case} {
+    string match {*ab\\*} {ab\c}
+} 1
+test string-11.39.5 {string match, *\ case} {
+    string match {*ab\\*} {ab\*}
+} 1
 test string-11.40 {string match, *special case} {
     string match {*[ab]} abc
 } 0
@@ -1098,6 +1251,27 @@ test string-12.19 {string range, bytearray object} {
 test string-12.20 {string range, out of bounds indices} {
     string range \u00ff 0 1
 } \u00ff
+# Bug 1410553
+test string-12.21 {string range, regenerates correct reps, bug 1410553} {
+    set bytes "\x00 \x03 \x41"
+    set rxBuffer {}
+    foreach ch $bytes {
+	append rxBuffer $ch
+	if {$ch eq "\x03"} {
+	    string length $rxBuffer
+	}
+    }
+    set rxCRC [string range $rxBuffer end-1 end]
+    binary scan [join $bytes {}] "H*" input_hex
+    binary scan $rxBuffer "H*" rxBuffer_hex
+    binary scan $rxCRC "H*" rxCRC_hex
+    list $input_hex $rxBuffer_hex $rxCRC_hex
+} {000341 000341 0341}
+test string-12.22 {string range, shimmering binary/index} {
+    set s 0000000001
+    binary scan $s a* x
+    string range $s $s end
+} 000000001
 
 test string-13.1 {string repeat} {
     list [catch {string repeat} msg] $msg
@@ -1224,6 +1398,9 @@ test string-15.9 {string tolower} {
 test string-15.10 {string tolower, unicode} {
      string tolower ABCabc\xc7\xe7
 } "abcabc\xe7\xe7"
+test string-15.11 {string tolower, compiled} {
+    lindex [string tolower [list A B [list C]]] 1
+} b
 
 test string-16.1 {string toupper} {
     list [catch {string toupper} msg] $msg
@@ -1255,6 +1432,9 @@ test string-16.9 {string toupper} {
 test string-16.10 {string toupper, unicode} {
     string toupper ABCabc\xc7\xe7
 } "ABCABC\xc7\xc7"
+test string-16.11 {string toupper, compiled} {
+    lindex [string toupper [list a b [list c]]] 1
+} B
 
 test string-17.1 {string totitle} {
     list [catch {string totitle} msg] $msg
@@ -1277,6 +1457,9 @@ test string-17.6 {string totitle, unicode} {
 test string-17.7 {string totitle, unicode} {
     string totitle \u01f3BCabc\xc7\xe7
 } "\u01f2bcabc\xe7\xe7"
+test string-17.8 {string totitle, compiled} {
+    lindex [string totitle [list aa bb [list cc]]] 0
+} Aa
 
 test string-18.1 {string trim} {
     list [catch {string trim} msg] $msg
@@ -1311,6 +1494,9 @@ test string-18.10 {string trim} {
 test string-18.11 {string trim, unicode} {
     string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
 } " AB\xe7C "
+test string-18.12 {string trim, unicode default} {
+    string trim \ufeff\x00\u0085\u00a0\u1680\u180eABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000
+} ABC\u1361
 
 test string-19.1 {string trimleft} {
     list [catch {string trimleft} msg] $msg
@@ -1318,13 +1504,16 @@ test string-19.1 {string trimleft} {
 test string-19.2 {string trimleft} {
     string trimleft "    XYZ      "
 } {XYZ      }
+test string-19.3 {string trimleft, unicode default} {
+    string trimleft \ufeff\u0085\u00a0\x00\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000\u1361ABC
+} \u1361ABC
 
 test string-20.1 {string trimright errors} {
     list [catch {string trimright} msg] $msg
 } {1 {wrong # args: should be "string trimright string ?chars?"}}
 test string-20.2 {string trimright errors} {
     list [catch {string trimg a} msg] $msg
-} {1 {bad option "trimg": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
 test string-20.3 {string trimright} {
     string trimright "    XYZ      "
 } {    XYZ}
@@ -1334,6 +1523,9 @@ test string-20.4 {string trimright} {
 test string-20.5 {string trimright} {
     string trimright ""
 } {}
+test string-20.6 {string trimright, unicode default} {
+    string trimright ABC\u1361\u0085\x00\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000
+} ABC\u1361
 
 test string-21.1 {string wordend} {
     list [catch {string wordend a} msg] $msg
@@ -1380,7 +1572,7 @@ test string-21.14 {string wordend, unicode} {
 
 test string-22.1 {string wordstart} {
     list [catch {string word a} msg] $msg
-} {1 {ambiguous option "word": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {unknown or ambiguous subcommand "word": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
 test string-22.2 {string wordstart} {
     list [catch {string wordstart a} msg] $msg
 } {1 {wrong # args: should be "string wordstart string index"}}
@@ -1423,7 +1615,6 @@ test string-23.0 {string is boolean, Bug 1187123} testindexobj {
     catch {testindexobj $x foo bar soom}
     string is boolean $x
 } 0
-
 test string-23.1 {string is command with empty string} {
     set s ""
     list \
@@ -1447,7 +1638,6 @@ test string-23.1 {string is command with empty string} {
         [string is xdigit $s] \
 
 } {1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1}
-
 test string-23.2 {string is command with empty string} {
     set s ""
     list \
@@ -1472,7 +1662,316 @@ test string-23.2 {string is command with empty string} {
 
 } {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
 
+test string-24.1 {string reverse command} -body {
+    string reverse
+} -returnCodes error -result "wrong # args: should be \"string reverse string\""
+test string-24.2 {string reverse command} -body {
+    string reverse a b
+} -returnCodes error -result "wrong # args: should be \"string reverse string\""
+test string-24.3 {string reverse command - shared string} {
+    set x abcde
+    string reverse $x
+} edcba
+test string-24.4 {string reverse command - unshared string} {
+    set x abc
+    set y de
+    string reverse $x$y
+} edcba
+test string-24.5 {string reverse command - shared unicode string} {
+    set x abcde\udead
+    string reverse $x
+} \udeadedcba
+test string-24.6 {string reverse command - unshared string} {
+    set x abc
+    set y de\udead
+    string reverse $x$y
+} \udeadedcba
+test string-24.7 {string reverse command - simple case} {
+    string reverse a
+} a
+test string-24.8 {string reverse command - simple case} {
+    string reverse \udead
+} \udead
+test string-24.9 {string reverse command - simple case} {
+    string reverse {}
+} {}
+test string-24.10 {string reverse command - corner case} {
+    set x \ubeef\udead
+    string reverse $x
+} \udead\ubeef
+test string-24.11 {string reverse command - corner case} {
+    set x \ubeef
+    set y \udead
+    string reverse $x$y
+} \udead\ubeef
+test string-24.12 {string reverse command - corner case} {
+    set x \ubeef
+    set y \udead
+    string is ascii [string reverse $x$y]
+} 0
+test string-24.13 {string reverse command - pure Unicode string} {
+    string reverse [string range \ubeef\udead\ubeef\udead\ubeef\udead 1 5]
+} \udead\ubeef\udead\ubeef\udead
+test string-24.14 {string reverse command - pure bytearray} {
+    binary scan [string reverse [binary format H* 010203]] H* x
+    set x
+} 030201
+test string-24.15 {string reverse command - pure bytearray} {
+    binary scan [tcl::string::reverse [binary format H* 010203]] H* x
+    set x
+} 030201
+
+test string-25.1 {string is list} {
+    string is list {a b c}
+} 1
+test string-25.2 {string is list} {
+    string is list "a \{b c"
+} 0
+test string-25.3 {string is list} {
+    string is list {a {b c}d e}
+} 0
+test string-25.4 {string is list} {
+    string is list {}
+} 1
+test string-25.5 {string is list} {
+    string is list -strict {a b c}
+} 1
+test string-25.6 {string is list} {
+    string is list -strict "a \{b c"
+} 0
+test string-25.7 {string is list} {
+    string is list -strict {a {b c}d e}
+} 0
+test string-25.8 {string is list} {
+    string is list -strict {}
+} 1
+test string-25.9 {string is list} {
+    set x {}
+    list [string is list -failindex x {a b c}] $x
+} {1 {}}
+test string-25.10 {string is list} {
+    set x {}
+    list [string is list -failindex x "a \{b c"] $x
+} {0 2}
+test string-25.11 {string is list} {
+    set x {}
+    list [string is list -failindex x {a b {b c}d e}] $x
+} {0 4}
+test string-25.12 {string is list} {
+    set x {}
+    list [string is list -failindex x {}] $x
+} {1 {}}
+test string-25.13 {string is list} {
+    set x {}
+    list [string is list -failindex x {  {b c}d e}] $x
+} {0 2}
+test string-25.14 {string is list} {
+    set x {}
+    list [string is list -failindex x "\uabcd {b c}d e"] $x
+} {0 2}
+
+test string-26.1 {tcl::prefix, too few args} -body {
+    tcl::prefix match a
+} -returnCodes 1 -result {wrong # args: should be "tcl::prefix match ?options? table string"}
+test string-26.2 {tcl::prefix, bad args} -body {
+    tcl::prefix match a b c
+} -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message}
+test string-26.2.1 {tcl::prefix, empty table} -body {
+    tcl::prefix match {} foo
+} -returnCodes 1 -result {bad option "foo": no valid options}
+test string-26.3 {tcl::prefix, bad args} -body {
+    tcl::prefix match -error "{}x" -exact str1 str2
+} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
+test string-26.3.1 {tcl::prefix, bad args} -body {
+    tcl::prefix match -error "x" -exact str1 str2
+} -returnCodes 1 -result {error options must have an even number of elements}
+test string-26.3.2 {tcl::prefix, bad args} -body {
+    tcl::prefix match -error str1 str2
+} -returnCodes 1 -result {missing value for -error}
+test string-26.4 {tcl::prefix, bad args} -body {
+    tcl::prefix match -message str1 str2
+} -returnCodes 1 -result {missing value for -message}
+test string-26.5 {tcl::prefix} {
+    tcl::prefix match {apa bepa cepa depa} cepa
+} cepa
+test string-26.6 {tcl::prefix} {
+    tcl::prefix match {apa bepa cepa depa} be
+} bepa
+test string-26.7 {tcl::prefix} -body {
+    tcl::prefix match -exact {apa bepa cepa depa} be
+} -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa}
+test string-26.8 {tcl::prefix} -body {
+    tcl::prefix match -message switch {apa bepa bear depa} be
+} -returnCodes 1 -result {ambiguous switch "be": must be apa, bepa, bear, or depa}
+test string-26.9 {tcl::prefix} -body {
+    tcl::prefix match -error {} {apa bepa bear depa} be
+} -returnCodes 0 -result {}
+test string-26.10 {tcl::prefix} -body {
+    tcl::prefix match -error {-level 1} {apa bepa bear depa} be
+} -returnCodes 2 -result {ambiguous option "be": must be apa, bepa, bear, or depa}
+test string-26.10.1 {tcl::prefix} -setup {
+    proc _testprefix {args} {
+        array set opts {-a x -b y -c y}
+        foreach {opt val} $args {
+            set opt [tcl::prefix match -error {-level 1} {-a -b -c} $opt]
+            set opts($opt) $val
+        }
+        array get opts
+    }
+} -body {
+    set a [catch {_testprefix -x u} result options]
+    dict get $options -errorinfo
+} -cleanup {
+    rename _testprefix {}
+} -result {bad option "-x": must be -a, -b, or -c
+    while executing
+"_testprefix -x u"}
+
+# Helper for memory stress tests
+# Repeat each body in a local space checking that memory does not increase
+proc MemStress {args} {
+    set res {}
+    foreach body $args {
+        set end 0
+        for {set i 0} {$i < 5} {incr i} { 
+            proc MemStress_Body {} $body
+            uplevel 1 MemStress_Body
+            rename MemStress_Body {}
+            set tmp $end
+            set end [lindex [lindex [split [memory info] "\n"] 3] 3]
+        }
+        lappend res [expr {$end - $tmp}]
+    }
+    return $res
+}
+
+test string-26.11 {tcl::prefix: testing for leaks} -body {
+    # This test is made to stress object reference management
+    MemStress {
+        set table {hejj miff gurk}
+        set item [lindex $table 1]
+        # If not careful, this can cause a circular reference
+        # that will cause a leak.
+        tcl::prefix match $table $item
+    } {
+        # A similar case with nested lists
+        set table2 {hejj {miff maff} gurk}
+        set item [lindex [lindex $table2 1] 0]
+        tcl::prefix match $table2 $item
+    } {
+        # A similar case with dict
+        set table3 {hejj {miff maff} gurk2}
+        set item [lindex [dict keys [lindex $table3 1]] 0]
+        tcl::prefix match $table3 $item
+    }
+} -constraints memory -result {0 0 0}
+
+test string-26.12 {tcl::prefix: testing for leaks} -body {
+    # This is a memory leak test in a form that might actually happen
+    # in real code.  The shared literal "miff" causes a connection
+    # between the item and the table.
+    MemStress {
+        proc stress1 {item} {
+            set table [list hejj miff gurk]
+            tcl::prefix match $table $item
+        }
+        proc stress2 {} {
+            stress1 miff
+        }
+        stress2
+        rename stress1 {}
+        rename stress2 {}
+    }
+} -constraints memory -result 0
+
+test string-26.13 {tcl::prefix: testing for leaks} -body {
+    # This test is made to stress object reference management
+    MemStress {
+        set table [list hejj miff]
+        set item $table
+        set error $table
+        # Use the same objects in all places
+        catch {
+            tcl::prefix match -error $error $table $item
+        }
+    }
+} -constraints memory -result {0}
+
+test string-27.1 {tcl::prefix all, too few args} -body {
+    tcl::prefix all a
+} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
+test string-27.2 {tcl::prefix all, bad args} -body {
+    tcl::prefix all a b c
+} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
+test string-27.3 {tcl::prefix all, bad args} -body {
+    tcl::prefix all "{}x" str2
+} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
+test string-27.4 {tcl::prefix all} {
+    tcl::prefix all {apa bepa cepa depa} c
+} cepa
+test string-27.5 {tcl::prefix all} {
+    tcl::prefix all {apa bepa cepa depa} cepa
+} cepa
+test string-27.6 {tcl::prefix all} {
+    tcl::prefix all {apa bepa cepa depa} cepax
+} {}
+test string-27.7 {tcl::prefix all} {
+    tcl::prefix all {apa aska appa} a
+} {apa aska appa}
+test string-27.8 {tcl::prefix all} {
+    tcl::prefix all {apa aska appa} ap
+} {apa appa}
+test string-27.9 {tcl::prefix all} {
+    tcl::prefix all {apa aska appa} p
+} {}
+test string-27.10 {tcl::prefix all} {
+    tcl::prefix all {apa aska appa} {}
+} {apa aska appa}
+
+test string-28.1 {tcl::prefix longest, too few args} -body {
+    tcl::prefix longest a
+} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
+test string-28.2 {tcl::prefix longest, bad args} -body {
+    tcl::prefix longest a b c
+} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
+test string-28.3 {tcl::prefix longest, bad args} -body {
+    tcl::prefix longest "{}x" str2
+} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
+test string-28.4 {tcl::prefix longest} {
+    tcl::prefix longest {apa bepa cepa depa} c
+} cepa
+test string-28.5 {tcl::prefix longest} {
+    tcl::prefix longest {apa bepa cepa depa} cepa
+} cepa
+test string-28.6 {tcl::prefix longest} {
+    tcl::prefix longest {apa bepa cepa depa} cepax
+} {}
+test string-28.7 {tcl::prefix longest} {
+    tcl::prefix longest {apa aska appa} a
+} a
+test string-28.8 {tcl::prefix longest} {
+    tcl::prefix longest {apa aska appa} ap
+} ap
+test string-28.9 {tcl::prefix longest} {
+    tcl::prefix longest {apa bska appa} a
+} ap
+test string-28.10 {tcl::prefix longest} {
+    tcl::prefix longest {apa bska appa} {}
+} {}
+test string-28.11 {tcl::prefix longest} {
+    tcl::prefix longest {{} bska appa} {}
+} {}
+test string-28.12 {tcl::prefix longest} {
+    tcl::prefix longest {apa {} appa} {}
+} {}
+test string-28.13 {tcl::prefix longest} {
+    # Test UTF8 handling
+    tcl::prefix longest {ax\x90 bep ax\x91} a
+} ax
+
 # cleanup
+rename MemStress {}
+catch {rename foo {}}
 ::tcltest::cleanupTests
 return
 
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 2580d0a..165ef20 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -14,26 +14,43 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: stringComp.test,v 1.10 2005/05/10 18:35:24 kennykb Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 # Some tests require the testobj command
 
 testConstraint testobj [expr {[info commands testobj] != {}}]
-
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+    proc getbytes {} {
+	set lines [split [memory info] \n]
+	return [lindex $lines 3 3]
+    }
+    proc leaktest {script {iterations 3}} {
+	set end [getbytes]
+	for {set i 0} {$i < $iterations} {incr i} {
+	    uplevel 1 $script
+	    set tmp $end
+	    set end [getbytes]
+	}
+	return [expr {$end - $tmp}]
+    }
+}
+
 test stringComp-1.1 {error conditions} {
     proc foo {} {string gorp a b}
     list [catch {foo} msg] $msg
-} {1 {bad option "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, tolower, toupper, totitle, trim, trimleft, trimright, wordend, or wordstart}}
+} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
 test stringComp-1.2 {error conditions} {
     proc foo {} {string}
     list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string option arg ?arg ...?"}}
+} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
 test stringComp-1.3 {error condition - undefined method during compile} {
     # We don't want this to complain about 'never' because it may never
     # be called, or string may get redefined.  This must compile OK.
@@ -44,185 +61,171 @@ test stringComp-1.3 {error condition - undefined method during compile} {
     foo abc 0
 } a
 
-test stringComp-2.1 {string compare, too few args} {
-    proc foo {} {string compare a}
-    list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
-test stringComp-2.2 {string compare, bad args} {
-    proc foo {} {string compare a b c}
-    list [catch {foo} msg] $msg
-} {1 {bad option "a": must be -nocase or -length}}
-test stringComp-2.3 {string compare, bad args} {
-    list [catch {string compare -length -nocase str1 str2} msg] $msg
-} {1 {expected integer but got "-nocase"}}
-test stringComp-2.4 {string compare, too many args} {
-    list [catch {string compare -length 10 -nocase str1 str2 str3} msg] $msg
-} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
-test stringComp-2.5 {string compare with length unspecified} {
-    list [catch {string compare -length 10 10} msg] $msg
-} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
-test stringComp-2.6 {string compare} {
-    proc foo {} {string compare abcde abdef}
-    foo
-} -1
-test stringComp-2.7 {string compare, shortest method name} {
-    proc foo {} {string c abcde ABCDE}
-    foo
-} 1
-test stringComp-2.8 {string compare} {
-    proc foo {} {string compare abcde abcde}
-    foo
-} 0
-test stringComp-2.9 {string compare with length} {
-    proc foo {} {string compare -length 2 abcde abxyz}
-    foo
-} 0
-test stringComp-2.10 {string compare with special index} {
-    proc foo {} {string compare -length end-3 abcde abxyz}
-    list [catch {foo} msg] $msg
-} {1 {expected integer but got "end-3"}}
-test stringComp-2.11 {string compare, unicode} {
-    proc foo {} {string compare ab\u7266 ab\u7267}
-    foo
-} -1
-test stringComp-2.12 {string compare, high bit} {
-    # This test will fail if the underlying comparaison
-    # is using signed chars instead of unsigned chars.
-    # (like SunOS's default memcmp thus the compat/memcmp.c)
-    proc foo {} {string compare "\x80" "@"}
-    foo
-    # Nb this tests works also in utf8 space because \x80 is
-    # translated into a 2 or more bytelength but whose first byte has
-    # the high bit set.
-} 1
-test stringComp-2.13 {string compare -nocase} {
-    proc foo {} {string compare -nocase abcde abdef}
-    foo
-} -1
-test stringComp-2.14 {string compare -nocase} {
-    proc foo {} {string c -nocase abcde ABCDE}
-    foo
-} 0
-test stringComp-2.15 {string compare -nocase} {
-    proc foo {} {string compare -nocase abcde abcde}
-    foo
-} 0
-test stringComp-2.16 {string compare -nocase with length} {
-    proc foo {} {string compare -length 2 -nocase abcde Abxyz}
-    foo
-} 0
-test stringComp-2.17 {string compare -nocase with length} {
-    proc foo {} {string compare -nocase -length 3 abcde Abxyz}
-    foo
-} -1
-test stringComp-2.18 {string compare -nocase with length <= 0} {
-    proc foo {} {string compare -nocase -length -1 abcde AbCdEf}
-    foo
-} -1
-test stringComp-2.19 {string compare -nocase with excessive length} {
-    proc foo {} {string compare -nocase -length 50 AbCdEf abcde}
-    foo
-} 1
-test stringComp-2.20 {string compare -len unicode} {
-    # These are strings that are 6 BYTELENGTH long, but the length
-    # shouldn't make a different because there are actually 3 CHARS long
-    proc foo {} {string compare -len 5 \334\334\334 \334\334\374}
-    foo
-} -1
-test stringComp-2.21 {string compare -nocase with special index} {
-    proc foo {} {string compare -nocase -length end-3 Abcde abxyz}
-    list [catch {foo} msg] $msg
-} {1 {expected integer but got "end-3"}}
-test stringComp-2.22 {string compare, null strings} {
-    proc foo {} {string compare "" ""}
-    foo
-} 0
-test stringComp-2.23 {string compare, null strings} {
-    proc foo {} {string compare "" foo}
-    foo
-} -1
-test stringComp-2.24 {string compare, null strings} {
-    proc foo {} {string compare foo ""}
-    foo
-} 1
-test stringComp-2.25 {string compare -nocase, null strings} {
-    proc foo {} {string compare -nocase "" ""}
-    foo
-} 0
-test stringComp-2.26 {string compare -nocase, null strings} {
-    proc foo {} {string compare -nocase "" foo}
-    foo
-} -1
-test stringComp-2.27 {string compare -nocase, null strings} {
-    proc foo {} {string compare -nocase foo ""}
-    foo
-} 1
-test stringComp-2.28 {string compare with length, unequal strings} {
-    proc foo {} {string compare -length 2 abc abde}
-    foo
-} 0
-test stringComp-2.29 {string compare with length, unequal strings} {
-    proc foo {} {string compare -length 2 ab abde}
-    foo
-} 0
-test stringComp-2.30 {string compare with NUL character vs. other ASCII} {
-    # Be careful here, since UTF-8 rep comparison with memcmp() of
-    # these puts chars in the wrong order
-    proc foo {} {string compare \x00 \x01}
-    foo
-} -1
-test stringComp-2.31 {string compare, high bit} {
-    proc foo {} {string compare "a\x80" "a@"}
-    foo
-} 1
-test stringComp-2.32 {string compare, high bit} {
-    proc foo {} {string compare "a\x00" "a\x01"}
-    foo
-} -1
-test stringComp-2.33 {string compare, high bit} {
-    proc foo {} {string compare "\x00\x00" "\x00\x01"}
-    foo
-} -1
+## Test string compare|equal over equal constraints
+## Use result for string compare, and negate it for string equal
+## The body will be tested both in and outside a proc
+set i 0
+foreach {tname tbody tresult tcode} {
+    {too few args} {
+	string compare a
+    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
+    {bad args} {
+	string compare a b c
+    } {bad option "a": must be -nocase or -length} {error}
+    {bad args} {
+	string compare -length -nocase str1 str2
+    } {expected integer but got "-nocase"} {error}
+    {too many args} {
+	string compare -length 10 -nocase str1 str2 str3
+    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
+    {compare with length unspecified} {
+	string compare -length 10 10
+    } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
+    {basic operation fail} {
+	string compare abcde abdef
+    } {-1} {}
+    {basic operation success} {
+	string compare abcde abcde
+    } {0} {}
+    {with length} {
+	string compare -length 2 abcde abxyz
+    } {0} {}
+    {with special index} {
+	string compare -length end-3 abcde abxyz
+    } {expected integer but got "end-3"} {error}
+    {unicode} {
+	string compare ab\u7266 ab\u7267
+    } {-1} {}
+    {unicode} {string compare \334 \u00dc} 0 {}
+    {unicode} {string compare \334 \u00fc} -1 {}
+    {unicode} {string compare \334\334\334\374\374 \334\334\334\334\334} 1 {}
+    {high bit} {
+	# This test will fail if the underlying comparaison
+	# is using signed chars instead of unsigned chars.
+	# (like SunOS's default memcmp thus the compat/memcmp.c)
+	string compare "\x80" "@"
+	# Nb this tests works also in utf8 space because \x80 is
+	# translated into a 2 or more bytelength but whose first byte has
+	# the high bit set.
+    } {1} {}
+    {-nocase 1} {string compare -nocase abcde abdef} {-1} {}
+    {-nocase 2} {string compare -nocase abcde Abdef} {-1} {}
+    {-nocase 3} {string compare -nocase abcde ABCDE} {0} {}
+    {-nocase 4} {string compare -nocase abcde abcde} {0} {}
+    {-nocase unicode} {
+	string compare -nocase \334 \u00dc
+    } 0 {}
+    {-nocase unicode} {
+	string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334
+    } 0 {}
+    {-nocase with length} {
+	string compare -length 2 -nocase abcde Abxyz
+    } {0} {}
+    {-nocase with length} {
+	string compare -nocase -length 3 abcde Abxyz
+    } {-1} {}
+    {-nocase with length <= 0} {
+	string compare -nocase -length -1 abcde AbCdEf
+    } {-1} {}
+    {-nocase with excessive length} {
+	string compare -nocase -length 50 AbCdEf abcde
+    } {1} {}
+    {-len unicode} {
+	# These are strings that are 6 BYTELENGTH long, but the length
+	# shouldn't make a different because there are actually 3 CHARS long
+	string compare -len 5 \334\334\334 \334\334\374
+    } -1 {}
+    {-nocase with special index} {
+	string compare -nocase -length end-3 Abcde abxyz
+    } {expected integer but got "end-3"} error
+    {null strings} {
+	string compare "" ""
+    } 0 {}
+    {null strings} {
+	string compare "" foo
+    } -1 {}
+    {null strings} {
+	string compare foo ""
+    } 1 {}
+    {-nocase null strings} {
+	string compare -nocase "" ""
+    } 0 {}
+    {-nocase null strings} {
+	string compare -nocase "" foo
+    } -1 {}
+    {-nocase null strings} {
+	string compare -nocase foo ""
+    } 1 {}
+    {with length, unequal strings} {
+	string compare -length 2 abc abde
+    } 0 {}
+    {with length, unequal strings} {
+	string compare -length 2 ab abde
+    } 0 {}
+    {with NUL character vs. other ASCII} {
+	# Be careful here, since UTF-8 rep comparison with memcmp() of
+	# these puts chars in the wrong order
+	string compare \x00 \x01
+    } -1 {}
+    {high bit} {
+	string compare "a\x80" "a@"
+    } 1 {}
+    {high bit} {
+	string compare "a\x00" "a\x01"
+    } -1 {}
+    {high bit} {
+	string compare "\x00\x00" "\x00\x01"
+    } -1 {}
+    {binary equal} {
+	string compare [binary format a100 0] [binary format a100 0]
+    } 0 {}
+    {binary neq} {
+	string compare [binary format a100a 0 1] [binary format a100a 0 0]
+    } 1 {}
+    {binary neq inequal length} {
+	string compare [binary format a20a 0 1] [binary format a100a 0 0]
+    } 1 {}
+} {
+    if {$tname eq ""} { continue }
+    if {$tcode eq ""} { set tcode ok }
+    test stringComp-2.[incr i] "string compare, $tname" \
+	-body [list eval $tbody] \
+	-returnCodes $tcode -result $tresult
+    test stringComp-2.[incr i] "string compare bc, $tname" \
+	-body "[list proc foo {} $tbody];foo" \
+	-returnCodes $tcode -result $tresult
+    if {"error" ni $tcode} {
+	set tresult [expr {!$tresult}]
+    } else {
+	set tresult [string map {compare equal} $tresult]
+    }
+    set tbody [string map {compare equal} $tbody]
+    test stringComp-2.[incr i] "string equal, $tname" \
+	-body [list eval $tbody] \
+	-returnCodes $tcode -result $tresult
+    test stringComp-2.[incr i] "string equal bc, $tname" \
+	-body "[list proc foo {} $tbody];foo" \
+	-returnCodes $tcode -result $tresult
+}
 
-# only need a few tests on equal, since it uses the same code as
-# string compare, but just modifies the return output
-test stringComp-3.1 {string equal} {
-    proc foo {} {string equal abcde abdef}
-    foo
-} 0
-test stringComp-3.2 {string equal} {
-    proc foo {} {string eq abcde ABCDE}
-    foo
-} 0
-test stringComp-3.3 {string equal} {
-    proc foo {} {string equal abcde abcde}
-    foo
-} 1
-test stringComp-3.4 {string equal -nocase} {
-    proc foo {} {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334}
+# need a few extra tests short abbr cmd
+test stringComp-3.1 {string compare, shortest method name} {
+    proc foo {} {string c abcde ABCDE}
     foo
 } 1
-test stringComp-3.5 {string equal -nocase} {
-    proc foo {} {string equal -nocase abcde abdef}
+test stringComp-3.2 {string equal, shortest method name} {
+    proc foo {} {string e abcde ABCDE}
     foo
 } 0
-test stringComp-3.6 {string equal -nocase} {
+test stringComp-3.3 {string equal -nocase} {
     proc foo {} {string eq -nocase abcde ABCDE}
     foo
 } 1
-test stringComp-3.7 {string equal -nocase} {
-    proc foo {} {string equal -nocase abcde abcde}
-    foo
-} 1
-test stringComp-3.8 {string equal with length, unequal strings} {
-    proc foo {} {string equal -length 2 abc abde}
-    foo
-} 1
 
 test stringComp-4.1 {string first, too few args} {
     proc foo {} {string first a}
     list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string first subString string ?startIndex?"}}
+} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
 test stringComp-4.2 {string first, bad args} {
     proc foo {} {string first a b c}
     list [catch {foo} msg] $msg
@@ -230,7 +233,7 @@ test stringComp-4.2 {string first, bad args} {
 test stringComp-4.3 {string first, too many args} {
     proc foo {} {string first a b 5 d}
     list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string first subString string ?startIndex?"}}
+} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
 test stringComp-4.4 {string first} {
     proc foo {} {string first bq abcdefgbcefgbqrs}
     foo
@@ -349,14 +352,14 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering}
     }
     foo
 } 0
-test stringComp-5.17 {string index, bad integer} {
-    proc foo {} {string index "abc" 08}
+test stringComp-5.17 {string index, bad integer} -body {
+    proc foo {} {string index "abc" 0o8}
     list [catch {foo} msg] $msg
-} {1 {bad index "08": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
-test stringComp-5.18 {string index, bad integer} {
-    proc foo {} {string index "abc" end-00289}
+} -match glob -result {1 {*invalid octal number*}}
+test stringComp-5.18 {string index, bad integer} -body {
+    proc foo {} {string index "abc" end-0o0289}
     list [catch {foo} msg] $msg
-} {1 {bad index "end-00289": must be integer?[+-]integer? or end?[+-]integer? (looks like invalid octal number)}}
+} -match glob -result {1 {*invalid octal number*}}
 test stringComp-5.19 {string index, bytearray object out of bounds} {
     proc foo {} {string index [binary format I* {0x50515253 0x52}] -1}
     foo
@@ -690,13 +693,33 @@ test stringComp-11.54 {string match, failure} {
 } {0 1 1 1 0 0}
 
 ## string range
-## not yet bc
+test stringComp-12.1 {Bug 3588366: end-offsets before start} {
+    apply {s {
+	string range $s 0 end-5
+    }} 12345
+} {}
 
 ## string repeat
 ## not yet bc
 
 ## string replace
-## not yet bc
+test stringComp-14.1 {Bug 82e7f67325} {
+    apply {x {
+	set a [join $x {}]
+	lappend b [string length [string replace ___! 0 2 $a]]
+	lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+    }} {a b}
+} {3 3}
+test stringComp-14.2 {Bug 82e7f67325} memory {
+    # As in stringComp-14.1, but make sure we don't retain too many refs
+    leaktest {
+	apply {x {
+	    set a [join $x {}]
+	    lappend b [string length [string replace ___! 0 2 $a]]
+	    lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+	}} {a b}
+    }
+} {0}
 
 ## string tolower
 ## not yet bc
@@ -712,7 +735,12 @@ test stringComp-11.54 {string match, failure} {
 
 ## string word*
 ## not yet bc
-
+
 # cleanup
+catch {rename foo {}}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 90ec9c3..6f331d3 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -1,26 +1,28 @@
 # Commands covered: none
 #
-# This file contains tests for the procedures in tclStringObj.c
-# that implement the Tcl type manager for the string type.
+# This file contains tests for the procedures in tclStringObj.c that implement
+# the Tcl type manager for the string type.
 #
-# 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) 1995-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.
-#
-# RCS: @(#) $Id: stringObj.test,v 1.16 2004/05/19 20:15:32 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
-testConstraint testobj [llength [info commands testobj]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
+testConstraint testobj [llength [info commands testobj]]
+testConstraint testdstring [llength [info commands testdstring]]
+
 test stringObj-1.1 {string type registration} testobj {
     set t [testobj types]
     set first [string first "string" $t]
@@ -39,7 +41,7 @@ test stringObj-3.1 {Tcl_SetStringObj, existing "empty string" object} testobj {
     set result ""
     lappend result [testobj freeallvars]
     lappend result [testobj newobj 1]
-    lappend result [teststringobj set 1 xyz] ;# makes existing obj a string
+    lappend result [teststringobj set 1 xyz]	;# makes existing obj a string
     lappend result [testobj type 1]
     lappend result [testobj refcount 1]
 } {{} {} xyz string 2}
@@ -47,7 +49,7 @@ test stringObj-3.2 {Tcl_SetStringObj, existing non-"empty string" object} testob
     set result ""
     lappend result [testobj freeallvars]
     lappend result [testintobj set 1 512]
-    lappend result [teststringobj set 1 foo]  ;# makes existing obj a string
+    lappend result [teststringobj set 1 foo]	;# makes existing obj a string
     lappend result [testobj type 1]
     lappend result [testobj refcount 1]
 } {{} 512 foo string 2}
@@ -135,7 +137,7 @@ test stringObj-6.5 {Tcl_AppendStringsToObj procedure, don't double space if init
     testobj newobj 1
     teststringobj appendstrings 1 123 abcdefg
     list [teststringobj length 1] [teststringobj length2 1] [teststringobj get 1]
-} {10 10 123abcdefg}
+} {10 20 123abcdefg}
 test stringObj-6.6 {Tcl_AppendStringsToObj procedure, space reallocation} testobj {
     testobj freeallvars
     teststringobj set 1 abc
@@ -160,6 +162,12 @@ test stringObj-6.8 {Tcl_AppendStringsToObj procedure, object totally empty} test
     teststringobj appendstrings 1 {}
     list [teststringobj length2 1] [teststringobj get 1]
 } {0 {}}
+test stringObj-6.9 {Tcl_AppendStringToObj, pure unicode} testobj {
+    testobj freeallvars
+    teststringobj set2 1 [string replace abc 1 1 d]
+    teststringobj appendstrings 1 foo bar soom
+    teststringobj get 1
+} adcfoobarsoom
 
 test stringObj-7.1 {SetStringFromAny procedure} testobj {
     testobj freeallvars
@@ -192,24 +200,24 @@ test stringObj-8.1 {DupStringInternalRep procedure} testobj {
     teststringobj append 1 abcde -1
     testobj duplicate 1 2
     list [teststringobj length 1] [teststringobj length2 1] \
-	    [teststringobj ualloc 1] [teststringobj get 1] \
+	    [teststringobj maxchars 1] [teststringobj get 1] \
 	    [teststringobj length 2] [teststringobj length2 2] \
-	    [teststringobj ualloc 2] [teststringobj get 2]
+	    [teststringobj maxchars 2] [teststringobj get 2]
 } {5 10 0 abcde 5 5 0 abcde}
 test stringObj-8.2 {DupUnicodeInternalRep, mixed width chars} testobj {
-    set x abcï¿®ghi
+    set x abc\u00ef\u00bf\u00aeghi
     string length $x
     set y $x
-    list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
+    list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \
 	    [set y] [testobj objtype $x] [testobj objtype $y]
-} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
+} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string"
 test stringObj-8.3 {DupUnicodeInternalRep, mixed width chars} testobj {
-    set x abcï¿®ghi
+    set x abc\u00ef\u00bf\u00aeghi
     set y $x
     string length $x
-    list [testobj objtype $x] [testobj objtype $y] [append x "®¿ï"] \
+    list [testobj objtype $x] [testobj objtype $y] [append x "\u00ae\u00bf\u00ef"] \
 	    [set y] [testobj objtype $x] [testobj objtype $y]
-} {string string abcï¿®ghi®¿ï abcï¿®ghi string string}
+} "string string abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef abc\u00ef\u00bf\u00aeghi string string"
 test stringObj-8.4 {DupUnicodeInternalRep, all byte-size chars} testobj {
     set x abcdefghi
     string length $x
@@ -225,31 +233,37 @@ test stringObj-8.5 {DupUnicodeInternalRep, all byte-size chars} testobj {
 	    [set y] [testobj objtype $x] [testobj objtype $y]
 } {string string abcdefghijkl abcdefghi string string}
 
-test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} testobj {
-    set x abcï¿®ghi
-    set y ®¿ï
+test stringObj-9.1 {TclAppendObjToObj, mixed src & dest} {testobj testdstring} {
+    set x abc\u00ef\u00bf\u00aeghi
+    testdstring free
+    testdstring append \u00ae\u00bf\u00ef -1
+    set y [testdstring get]
     string length $x
     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 	    [set y] [testobj objtype $x] [testobj objtype $y]
-} {string none abcï¿®ghi®¿ï ®¿ï string none}
+} "string none abc\u00ef\u00bf\u00aeghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none"
 test stringObj-9.2 {TclAppendObjToObj, mixed src & dest} testobj {
-    set x abcï¿®ghi
+    set x abc\u00ef\u00bf\u00aeghi
     string length $x
     list [testobj objtype $x] [append x $x] [testobj objtype $x] \
 	    [append x $x] [testobj objtype $x]
-} {string abcï¿®ghiabcï¿®ghi string\
-abcï¿®ghiabcï¿®ghiabcï¿®ghiabcï¿®ghi\
-string}
-test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} testobj {
+} "string abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi string\
+abc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghiabc\u00ef\u00bf\u00aeghi\
+string"
+test stringObj-9.3 {TclAppendObjToObj, mixed src & 1-byte dest} {testobj testdstring} {
     set x abcdefghi
-    set y ®¿ï
+    testdstring free
+    testdstring append \u00ae\u00bf\u00ef -1
+    set y [testdstring get]
     string length $x
     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 	    [set y] [testobj objtype $x] [testobj objtype $y]
-} {string none abcdefghi®¿ï ®¿ï string none}
-test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} testobj {
+} "string none abcdefghi\u00ae\u00bf\u00ef \u00ae\u00bf\u00ef string none"
+test stringObj-9.4 {TclAppendObjToObj, 1-byte src & dest} {testobj testdstring} {
     set x abcdefghi
-    set y jkl
+    testdstring free
+    testdstring append jkl -1
+    set y [testdstring get]
     string length $x
     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 	    [set y] [testobj objtype $x] [testobj objtype $y]
@@ -261,13 +275,15 @@ test stringObj-9.5 {TclAppendObjToObj, 1-byte src & dest} testobj {
 	    [append x $x] [testobj objtype $x]
 } {string abcdefghiabcdefghi string abcdefghiabcdefghiabcdefghiabcdefghi\
 string}
-test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} testobj {
-    set x abcï¿®ghi
-    set y jkl
+test stringObj-9.6 {TclAppendObjToObj, 1-byte src & mixed dest} {testobj testdstring} {
+    set x abc\u00ef\u00bf\u00aeghi
+    testdstring free
+    testdstring append jkl -1
+    set y [testdstring get]
     string length $x
     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 	    [set y] [testobj objtype $x] [testobj objtype $y]
-} {string none abcï¿®ghijkl jkl string none}
+} "string none abc\u00ef\u00bf\u00aeghijkl jkl string none"
 test stringObj-9.7 {TclAppendObjToObj, integer src & dest} testobj {
     set x [expr {4 * 5}]
     set y [expr {4 + 5}]
@@ -288,20 +304,19 @@ test stringObj-9.9 {TclAppendObjToObj, integer src & 1-byte dest} testobj {
 	    [set y] [testobj objtype $x] [testobj objtype $y]
 } {string int abcdefghi9 9 string int}
 test stringObj-9.10 {TclAppendObjToObj, integer src & mixed dest} testobj {
-    set x abcï¿®ghi
+    set x abc\u00ef\u00bf\u00aeghi
     set y [expr {4 + 5}]
     string length $x
     list [testobj objtype $x] [testobj objtype $y] [append x $y] \
 	    [set y] [testobj objtype $x] [testobj objtype $y]
-} {string int abcï¿®ghi9 9 string int}
+} "string int abc\u00ef\u00bf\u00aeghi9 9 string int"
 test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} testobj {
     # bug 2678, in <=8.2.0, the second obj (the one to append) in
-    # Tcl_AppendObjToObj was not correctly checked to see if it was
-    # all one byte chars, so a unicode string would be added as one
-    # byte chars.
+    # Tcl_AppendObjToObj was not correctly checked to see if it was all one
+    # byte chars, so a unicode string would be added as one byte chars.
     set x abcdef
     set len [string length $x]
-    set y aübåcï
+    set y a\u00fcb\u00e5c\u00ef
     set len [string length $y]
     append x $y
     string length $x
@@ -310,20 +325,24 @@ test stringObj-9.11 {TclAppendObjToObj, mixed src & 1-byte dest index check} tes
 	lappend q [string index $x $i]
     }
     set q
-} {a b c d e f a ü b å c ï}
+} "a b c d e f a \u00fc b \u00e5 c \u00ef"
 
-test stringObj-10.1 {Tcl_GetRange with all byte-size chars} testobj {
-    set x "abcdef"
+test stringObj-10.1 {Tcl_GetRange with all byte-size chars} {testobj testdstring} {
+    testdstring free
+    testdstring append abcdef -1
+    set x [testdstring get]
     list [testobj objtype $x] [set y [string range $x 1 end-1]] \
 	    [testobj objtype $x] [testobj objtype $y]
 } [list none bcde string string]
-test stringObj-10.2 {Tcl_GetRange with some mixed width chars} testobj {
+test stringObj-10.2 {Tcl_GetRange with some mixed width chars} {testobj testdstring} {
     # Because this test does not use \uXXXX notation below instead of
-    # hardcoding the values, it may fail in multibyte locales.  However,
-    # we need to test that the parser produces untyped objects even when there
-    # are high-ASCII characters in the input (like "ï").  I don't know what
+    # hardcoding the values, it may fail in multibyte locales. However, we
+    # need to test that the parser produces untyped objects even when there
+    # are high-ASCII characters in the input (like "ï"). I don't know what
     # else to do but inline those characters here.
-    set x "abcïïdef"
+    testdstring free
+    testdstring append "abc\u00ef\u00efdef" -1
+    set x [testdstring get]
     list [testobj objtype $x] [set y [string range $x 1 end-1]] \
 	    [testobj objtype $x] [testobj objtype $y]
 } [list none "bc\u00EF\u00EFde" string string]
@@ -372,15 +391,15 @@ test stringObj-12.3 {Tcl_GetUniChar with byte-size chars} testobj {
     list [string index $x end] [string index $x end-1]
 } {i h}
 test stringObj-12.4 {Tcl_GetUniChar with mixed width chars} testobj {
-    string index "ïa¿b®c®¿dï" 0
-} "ï"
+    string index "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef" 0
+} "\u00ef"
 test stringObj-12.5 {Tcl_GetUniChar} testobj {
-    set x "ïa¿b®c®¿dï"
+    set x "\u00efa\u00bfb\u00aec\u00ae\u00bfd\u00ef"
     list [string index $x 4] [string index $x 0]
-} {® ï}
+} "\u00ae \u00ef"
 test stringObj-12.6 {Tcl_GetUniChar} testobj {
-    string index "ïa¿b®cï¿d®" end
-} "®"
+    string index "\u00efa\u00bfb\u00aec\u00ef\u00bfd\u00ae" end
+} "\u00ae"
 
 test stringObj-13.1 {Tcl_GetCharLength with byte-size chars} testobj {
     set a ""
@@ -394,7 +413,7 @@ test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj {
     list [string length $a] [string length $a]
 } {6 6}
 test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj {
-    string length "®" 
+    string length "\u00ae" 
 } 1
 test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj {
     # string length "￮￮" 
@@ -428,6 +447,40 @@ test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} testobj {
     teststringobj get 1
 } {bar}
 
+test stringObj-15.1 {Tcl_Append*ToObj: self appends} testobj {
+    teststringobj set 1 foo
+    teststringobj appendself 1 0
+} foofoo
+test stringObj-15.2 {Tcl_Append*ToObj: self appends} testobj {
+    teststringobj set 1 foo
+    teststringobj appendself 1 1
+} foooo
+test stringObj-15.3 {Tcl_Append*ToObj: self appends} testobj {
+    teststringobj set 1 foo
+    teststringobj appendself 1 2
+} fooo
+test stringObj-15.4 {Tcl_Append*ToObj: self appends} testobj {
+    teststringobj set 1 foo
+    teststringobj appendself 1 3
+} foo
+test stringObj-15.5 {Tcl_Append*ToObj: self appends} testobj {
+    teststringobj set 1 foo
+    teststringobj appendself2 1 0
+} foofoo
+test stringObj-15.6 {Tcl_Append*ToObj: self appends} testobj {
+    teststringobj set 1 foo
+    teststringobj appendself2 1 1
+} foooo
+test stringObj-15.7 {Tcl_Append*ToObj: self appends} testobj {
+    teststringobj set 1 foo
+    teststringobj appendself2 1 2
+} fooo
+test stringObj-15.8 {Tcl_Append*ToObj: self appends} testobj {
+    teststringobj set 1 foo
+    teststringobj appendself2 1 3
+} foo
+
+
 if {[testConstraint testobj]} {
     testobj freeallvars
 }
diff --git a/tests/subst.test b/tests/subst.test
index a336c1b..7466895 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -10,20 +10,18 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: subst.test,v 1.18 2004/10/26 21:52:41 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
     namespace import -force ::tcltest::*
 }
-
-test subst-1.1 {basics} {
-    list [catch {subst} msg] $msg
-} {1 {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}}
-test subst-1.2 {basics} {
-    list [catch {subst a b c} msg] $msg
-} {1 {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}}
+
+test subst-1.1 {basics} -returnCodes error -body {
+    subst
+} -result {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}
+test subst-1.2 {basics} -returnCodes error -body {
+    subst a b c
+} -result {bad switch "a": must be -nobackslashes, -nocommands, or -novariables}
 
 test subst-2.1 {simple strings} {
     subst {}
@@ -56,12 +54,13 @@ test subst-4.2 {variable substitutions} {
     set a 44
     subst {x$a.y{$a}.z}
 } {x44.y{44}.z}
-test subst-4.3 {variable substitutions} {
+test subst-4.3 {variable substitutions} -setup {
     catch {unset a}
+} -body {
     set a(13) 82
     set i 13
     subst {x.$a($i)}
-} {x.82}
+} -result {x.82}
 catch {unset a}
 set long {This is a very long string, intentionally made so long that it
 	will overflow the static character size for dstrings, so that
@@ -70,9 +69,9 @@ set long {This is a very long string, intentionally made so long that it
 	an error, there will be memory that isn't freed (this will be
 	detected when the tests are run under a checking memory allocator
 	such as Purify).}
-test subst-4.4 {variable substitutions} {
-    list [catch {subst {$long $a}} msg] $msg
-} {1 {can't read "a": no such variable}}
+test subst-4.4 {variable substitutions} -returnCodes error -body {
+    subst {$long $a}
+} -result {can't read "a": no such variable}
 
 test subst-5.1 {command substitutions} {
     subst {[concat {}]}
@@ -113,20 +112,20 @@ test subst-5.10 {command substitutions} {
     list [catch {exec [info nameofexecutable] << $script} msg] $msg 
 } {1 {missing close-bracket}}
 
-test subst-6.1 {clear the result after command substitution} {
+test subst-6.1 {clear the result after command substitution} -body {
     catch {unset a}
-    list [catch {subst {[concat foo] $a}} msg] $msg
-} {1 {can't read "a": no such variable}}
+    subst {[concat foo] $a}
+} -returnCodes error -result {can't read "a": no such variable}
 
-test subst-7.1 {switches} {
-    list [catch {subst foo bar} msg] $msg
-} {1 {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}}
-test subst-7.2 {switches} {
-    list [catch {subst -no bar} msg] $msg
-} {1 {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}}
-test subst-7.3 {switches} {
-    list [catch {subst -bogus bar} msg] $msg
-} {1 {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}}
+test subst-7.1 {switches} -returnCodes error -body {
+    subst foo bar
+} -result {bad switch "foo": must be -nobackslashes, -nocommands, or -novariables}
+test subst-7.2 {switches} -returnCodes error -body {
+    subst -no bar
+} -result {ambiguous switch "-no": must be -nobackslashes, -nocommands, or -novariables}
+test subst-7.3 {switches} -returnCodes error -body {
+    subst -bogus bar
+} -result {bad switch "-bogus": must be -nobackslashes, -nocommands, or -novariables}
 test subst-7.4 {switches} {
     set x 123
     subst -nobackslashes {abc $x [expr 1+2] \\\x41}
@@ -159,28 +158,30 @@ test subst-8.4 {return in a subst} {
 test subst-8.5 {return in a subst} {
     subst {foo [return {]}; bogus code] bar}
 } {foo ] bar}
-test subst-8.6 {return in a subst} {
-    list [catch {subst {foo [return {x}; bogus code bar}} msg] $msg
-} {1 {missing close-bracket}}
+test subst-8.6 {return in a subst} -returnCodes error -body {
+    subst "foo \[return {x}; bogus code bar"
+} -result {missing close-bracket}
 test subst-8.7 {return in a subst, parse error} -body {
-    subst {foo [return {x} ; set a {}" ; stuff] bar}
+    subst {foo [return {x} ; set a {}"" ; stuff] bar} 
 } -returnCodes error -result {extra characters after close-brace}
 test subst-8.8 {return in a subst, parse error} -body {
-    subst {foo [return {x} ; set bar baz ; set a {}" ; stuff] bar}
+    subst {foo [return {x} ; set bar baz ; set a {}"" ; stuff] bar}
 } -returnCodes error -result {extra characters after close-brace}
 test subst-8.9 {return in a variable subst} {
     subst {foo $var([return {x}]) bar}
 } {foo x bar}
 
-test subst-9.1 {error in a subst} {
-    list [catch {subst {[error foo; bogus code]bar}} msg] $msg
-} {1 foo}
-test subst-9.2 {error in a subst} {
-    list [catch {subst {[if 1 { error foo; bogus code}]bar}} msg] $msg
-} {1 foo}
-test subst-9.3 {error in a variable subst} {
-    list [catch {subst {foo $var([error foo]) bar}} msg] $msg
-} {1 foo}
+test subst-9.1 {error in a subst} -body {
+    subst {[error foo; bogus code]bar}
+} -returnCodes error -result foo
+test subst-9.2 {error in a subst} -body {
+    subst {[if 1 { error foo; bogus code}]bar}
+} -returnCodes error -result foo
+test subst-9.3 {error in a variable subst} -setup {
+    catch {unset var}
+} -body {
+    subst {foo $var([error foo]) bar}
+} -returnCodes error -result foo
 
 test subst-10.1 {break in a subst} {
     subst {foo [break; bogus code] bar}
@@ -225,14 +226,14 @@ test subst-12.1 {nasty case, Bug 1036649} {
 	set res [list [catch {subst "\[subst {};"} msg] $msg]
 	if {$msg ne "missing close-bracket"} break
     }
-    set res
+    return $res
 } {1 {missing close-bracket}}
 test subst-12.2 {nasty case, Bug 1036649} {
     for {set i 0} {$i < 10} {incr i} {
 	set res [list [catch {subst "\[subst {}; "} msg] $msg]
 	if {$msg ne "missing close-bracket"} break
     }
-    set res
+    return $res
 } {1 {missing close-bracket}}
 test subst-12.3 {nasty case, Bug 1036649} {
     set x 0
@@ -240,25 +241,67 @@ test subst-12.3 {nasty case, Bug 1036649} {
 	set res [list [catch {subst "\[incr x;"} msg] $msg]
 	if {$msg ne "missing close-bracket"} break
     }
-    list $res $x
-} {{1 {missing close-bracket}} 10}
+    lappend res $x
+} {1 {missing close-bracket} 10}
 test subst-12.4 {nasty case, Bug 1036649} {
     set x 0
     for {set i 0} {$i < 10} {incr i} {
 	set res [list [catch {subst "\[incr x; "} msg] $msg]
 	if {$msg ne "missing close-bracket"} break
     }
-    list $res $x
-} {{1 {missing close-bracket}} 10}
+    lappend res $x
+} {1 {missing close-bracket} 10}
 test subst-12.5 {nasty case, Bug 1036649} {
     set x 0
     for {set i 0} {$i < 10} {incr i} {
 	set res [list [catch {subst "\[incr x"} msg] $msg]
 	if {$msg ne "missing close-bracket"} break
     }
-    list $res $x
-} {{1 {missing close-bracket}} 0}
+    lappend res $x
+} {1 {missing close-bracket} 0}
+test subst-12.6 {nasty case with compilation} {
+    set x unset
+    set y unset
+    list [eval [list subst {[set x 1;break;incr x][set y $x]}]] $x $y
+} {{} 1 unset}
+test subst-12.7 {nasty case with compilation} {
+    set x unset
+    set y unset
+    list [eval [list subst {[set x 1;continue;incr x][set y $x]}]] $x $y
+} {1 1 1}
 
+test subst-13.1 {Bug 3081065} -setup {
+    set script [makeFile {
+	proc demo {string} {
+	    subst $string
+	}
+	demo name2
+    } subst13.tcl]
+} -body {
+    interp create slave
+    slave eval [list source $script]
+    interp delete slave
+    interp create slave
+    slave eval {
+	set count 400
+	while {[incr count -1]} {
+	    lappend bloat [expr {rand()}]
+	}
+    }
+    slave eval [list source $script]
+    interp delete slave
+} -cleanup {
+    removeFile subst13.tcl
+}
+test subst-13.2 {Test for segfault} -body {
+    subst {[}
+} -returnCodes error -result * -match glob
+
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/switch.test b/tests/switch.test
index ed1d38a..a03948b 100644
--- a/tests/switch.test
+++ b/tests/switch.test
@@ -10,184 +10,175 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: switch.test,v 1.14 2005/06/20 07:49:12 mdejong Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
-
+
 test switch-1.1 {simple patterns} {
-    switch a a {format 1} b {format 2} c {format 3} default {format 4}
+    switch a a {subst 1} b {subst 2} c {subst 3} default {subst 4}
 } 1
 test switch-1.2 {simple patterns} {
-    switch b a {format 1} b {format 2} c {format 3} default {format 4}
+    switch b a {subst 1} b {subst 2} c {subst 3} default {subst 4}
 } 2
 test switch-1.3 {simple patterns} {
-    switch x a {format 1} b {format 2} c {format 3} default {format 4}
+    switch x a {subst 1} b {subst 2} c {subst 3} default {subst 4}
 } 4
 test switch-1.4 {simple patterns} {
-    switch x a {format 1} b {format 2} c {format 3}
+    switch x a {subst 1} b {subst 2} c {subst 3}
 } {}
 test switch-1.5 {simple pattern matches many times} {
-    switch b a {format 1} b {format 2} b {format 3} b {format 4}
+    switch b a {subst 1} b {subst 2} b {subst 3} b {subst 4}
 } 2
 test switch-1.6 {simple patterns} {
-    switch default a {format 1} default {format 2} c {format 3} default {format 4}
+    switch default a {subst 1} default {subst 2} c {subst 3} default {subst 4}
 } 2
 test switch-1.7 {simple patterns} {
-    switch x a {format 1} default {format 2} c {format 3} default {format 4}
+    switch x a {subst 1} default {subst 2} c {subst 3} default {subst 4}
 } 4
 test switch-1.8 {simple patterns with -nocase} {
-    switch -nocase b a {format 1} b {format 2} c {format 3} default {format 4}
+    switch -nocase b a {subst 1} b {subst 2} c {subst 3} default {subst 4}
 } 2
 test switch-1.9 {simple patterns with -nocase} {
-    switch -nocase B a {format 1} b {format 2} c {format 3} default {format 4}
+    switch -nocase B a {subst 1} b {subst 2} c {subst 3} default {subst 4}
 } 2
 test switch-1.10 {simple patterns with -nocase} {
-    switch -nocase b a {format 1} B {format 2} c {format 3} default {format 4}
+    switch -nocase b a {subst 1} B {subst 2} c {subst 3} default {subst 4}
 } 2
 test switch-1.11 {simple patterns with -nocase} {
-    switch -nocase x a {format 1} default {format 2} c {format 3} default {format 4}
+    switch -nocase x a {subst 1} default {subst 2} c {subst 3} default {subst 4}
 } 4
 
 test switch-2.1 {single-argument form for pattern/command pairs} {
     switch b {
-	a {format 1}
-	b {format 2}
-	default {format 6}
+	a {subst 1}
+	b {subst 2}
+	default {subst 6}
     }
 } {2}
-test switch-2.2 {single-argument form for pattern/command pairs} {
-    list [catch {switch z {a 2 b}} msg] $msg
-} {1 {extra switch pattern with no body}}
+test switch-2.2 {single-argument form for pattern/command pairs} -body {
+    switch z {a 2 b}
+} -returnCodes error -result {extra switch pattern with no body}
 
 test switch-3.1 {-exact vs. -glob vs. -regexp} {
     switch -exact aaaab {
-	^a*b$	{concat regexp}
-	*b	{concat glob}
-	aaaab	{concat exact}
-	default	{concat none}
+	^a*b$	{subst regexp}
+	*b	{subst glob}
+	aaaab	{subst exact}
+	default	{subst none}
     }
 } exact
 test switch-3.2 {-exact vs. -glob vs. -regexp} {
     switch -regexp aaaab {
-	^a*b$	{concat regexp}
-	*b	{concat glob}
-	aaaab	{concat exact}
-	default	{concat none}
+	^a*b$	{subst regexp}
+	*b	{subst glob}
+	aaaab	{subst exact}
+	default	{subst none}
     }
 } regexp
 test switch-3.3 {-exact vs. -glob vs. -regexp} {
     switch -glob aaaab {
-	^a*b$	{concat regexp}
-	*b	{concat glob}
-	aaaab	{concat exact}
-	default	{concat none}
+	^a*b$	{subst regexp}
+	*b	{subst glob}
+	aaaab	{subst exact}
+	default	{subst none}
     }
 } glob
 test switch-3.4 {-exact vs. -glob vs. -regexp} {
-    switch aaaab {^a*b$} {concat regexp} *b {concat glob} \
-	    aaaab {concat exact} default {concat none}
+    switch aaaab {^a*b$} {subst regexp} *b {subst glob} \
+	    aaaab {subst exact} default {subst none}
 } exact
 test switch-3.5 {-exact vs. -glob vs. -regexp} {
     switch -- -glob {
-	^g.*b$	{concat regexp}
-	-*	{concat glob}
-	-glob	{concat exact}
-	default {concat none}
+	^g.*b$	{subst regexp}
+	-*	{subst glob}
+	-glob	{subst exact}
+	default {subst none}
     }
 } exact
-test switch-3.6 {-exact vs. -glob vs. -regexp} {
-    list [catch {switch -foo a b c} msg] $msg
-} {1 {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --}}
+test switch-3.6 {-exact vs. -glob vs. -regexp} -body {
+    switch -foo a b c
+} -returnCodes error -result {bad option "-foo": must be -exact, -glob, -indexvar, -matchvar, -nocase, -regexp, or --}
 test switch-3.7 {-exact vs. -glob vs. -regexp with -nocase} {
     switch -exact -nocase aaaab {
-	^a*b$	{concat regexp}
-	*b	{concat glob}
-	aaaab	{concat exact}
-	default	{concat none}
+	^a*b$	{subst regexp}
+	*b	{subst glob}
+	aaaab	{subst exact}
+	default	{subst none}
     }
 } exact
 test switch-3.8 {-exact vs. -glob vs. -regexp with -nocase} {
     switch -regexp -nocase aaaab {
-	^a*b$	{concat regexp}
-	*b	{concat glob}
-	aaaab	{concat exact}
-	default	{concat none}
+	^a*b$	{subst regexp}
+	*b	{subst glob}
+	aaaab	{subst exact}
+	default	{subst none}
     }
 } regexp
 test switch-3.9 {-exact vs. -glob vs. -regexp with -nocase} {
     switch -glob -nocase aaaab {
-	^a*b$	{concat regexp}
-	*b	{concat glob}
-	aaaab	{concat exact}
-	default	{concat none}
+	^a*b$	{subst regexp}
+	*b	{subst glob}
+	aaaab	{subst exact}
+	default	{subst none}
     }
 } glob
 test switch-3.10 {-exact vs. -glob vs. -regexp with -nocase} {
-    switch -nocase aaaab {^a*b$} {concat regexp} *b {concat glob} \
-	    aaaab {concat exact} default {concat none}
+    switch -nocase aaaab {^a*b$} {subst regexp} *b {subst glob} \
+	    aaaab {subst exact} default {subst none}
 } exact
 test switch-3.11 {-exact vs. -glob vs. -regexp with -nocase} {
     switch -nocase -- -glob {
-	^g.*b$	{concat regexp}
-	-*	{concat glob}
-	-glob	{concat exact}
-	default {concat none}
+	^g.*b$	{subst regexp}
+	-*	{subst glob}
+	-glob	{subst exact}
+	default {subst none}
     }
 } exact
-
-test switch-3.7 {-exact vs. -glob vs. -regexp} {
-    list [catch {switch -exa Foo Foo {set result OK}} msg] $msg
-} {0 OK}
-
-test switch-3.8 {-exact vs. -glob vs. -regexp} {
-    list [catch {switch -gl Foo Fo? {set result OK}} msg] $msg
-} {0 OK}
-
-test switch-3.9 {-exact vs. -glob vs. -regexp} {
-    list [catch {switch -re Foo Fo. {set result OK}} msg] $msg
-} {0 OK}
-
-test switch-3.10 {-exact vs. -glob vs. -regexp} {
-    list [catch {switch -exact -exact Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-exact": -exact option already found}}
-
-test switch-3.11 {-exact vs. -glob vs. -regexp} {
-    list [catch {switch -exact -glob Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-glob": -exact option already found}}
-
 test switch-3.12 {-exact vs. -glob vs. -regexp} {
-    list [catch {switch -glob -regexp Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-regexp": -glob option already found}}
-
+    switch -exa Foo Foo {set result OK}
+} OK
 test switch-3.13 {-exact vs. -glob vs. -regexp} {
-    list [catch {switch -regexp -glob Foo Foo {set result OK}} msg] $msg
-} {1 {bad option "-glob": -regexp option already found}}
+    switch -gl Foo Fo? {set result OK}
+} OK
+test switch-3.14 {-exact vs. -glob vs. -regexp} {
+    switch -re Foo Fo. {set result OK}
+} OK
+test switch-3.15 {-exact vs. -glob vs. -regexp} -body {
+    switch -exact -exact Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-exact": -exact option already found}
+test switch-3.16 {-exact vs. -glob vs. -regexp} -body {
+    switch -exact -glob Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-glob": -exact option already found}
+test switch-3.17 {-exact vs. -glob vs. -regexp} -body {
+    switch -glob -regexp Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-regexp": -glob option already found}
+test switch-3.18 {-exact vs. -glob vs. -regexp} -body {
+    switch -regexp -glob Foo Foo {set result OK}
+} -returnCodes error -result {bad option "-glob": -regexp option already found}
 
 test switch-4.1 {error in executed command} {
-    list [catch {switch a a {error "Just a test"} default {format 1}} msg] \
-	    $msg $errorInfo
+    list [catch {switch a a {error "Just a test"} default {subst 1}} msg] \
+	    $msg $::errorInfo
 } {1 {Just a test} {Just a test
     while executing
 "error "Just a test""
     ("a" arm line 1)
     invoked from within
-"switch a a {error "Just a test"} default {format 1}"}}
-test switch-4.2 {error: not enough args} {
-    list [catch {switch} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
-test switch-4.3 {error: pattern with no body} {
-    list [catch {switch a b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-4.4 {error: pattern with no body} {
-    list [catch {switch a b {format 1} c} msg] $msg
-} {1 {extra switch pattern with no body}}
+"switch a a {error "Just a test"} default {subst 1}"}}
+test switch-4.2 {error: not enough args} -returnCodes error -body {
+    switch
+} -result {wrong # args: should be "switch ?-switch ...? string ?pattern body ...? ?default body?"}
+test switch-4.3 {error: pattern with no body} -body {
+    switch a b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-4.4 {error: pattern with no body} -body {
+    switch a b {subst 1} c
+} -returnCodes error -result {extra switch pattern with no body}
 test switch-4.5 {error in default command} {
     list [catch {switch foo a {error switch1} b {error switch 3} \
-	    default {error switch2}} msg] $msg $errorInfo
+	    default {error switch2}} msg] $msg $::errorInfo
 } {1 switch2 {switch2
     while executing
 "error switch2"
@@ -195,30 +186,30 @@ test switch-4.5 {error in default command} {
     invoked from within
 "switch foo a {error switch1} b {error switch 3}  default {error switch2}"}}
 
-test switch-5.1 {errors in -regexp matching} {
-    list [catch {switch -regexp aaaab {
-	*b	{concat glob}
-	aaaab	{concat exact}
-	default	{concat none}
-    }} msg] $msg
-} {1 {couldn't compile regular expression pattern: quantifier operand invalid}}
+test switch-5.1 {errors in -regexp matching} -returnCodes error -body {
+    switch -regexp aaaab {
+	*b	{subst glob}
+	aaaab	{subst exact}
+	default	{subst none}
+    }
+} -result {couldn't compile regular expression pattern: quantifier operand invalid}
 
 test switch-6.1 {backslashes in patterns} {
     switch -exact {\a\$\.\[} {
-	\a\$\.\[	{concat first}
-	\a\\$\.\\[	{concat second}
-	\\a\\$\\.\\[	{concat third}
-	{\a\\$\.\\[}	{concat fourth}
-	{\\a\\$\\.\\[}	{concat fifth}
-	default		{concat none}
+	\a\$\.\[	{subst first}
+	\a\\$\.\\[	{subst second}
+	\\a\\$\\.\\[	{subst third}
+	{\a\\$\.\\[}	{subst fourth}
+	{\\a\\$\\.\\[}	{subst fifth}
+	default		{subst none}
     }
 } third
 test switch-6.2 {backslashes in patterns} {
     switch -exact {\a\$\.\[} {
-	\a\$\.\[	{concat first}
-	{\a\$\.\[}	{concat second}
-	{{\a\$\.\[}}	{concat third}
-	default		{concat none}
+	\a\$\.\[	{subst first}
+	{\a\$\.\[}	{subst second}
+	{{\a\$\.\[}}	{subst third}
+	default		{subst none}
     }
 } second
 
@@ -226,37 +217,31 @@ test switch-7.1 {"-" bodies} {
     switch a {
 	a -
 	b -
-	c {concat 1}
-	default {concat 2}
+	c {subst 1}
+	default {subst 2}
     }
 } 1
-test switch-7.2 {"-" bodies} {
-    list [catch {
-	switch a {
-	    a -
-	    b -
-	    c -
-	}
-    } msg] $msg
-} {1 {no body specified for pattern "c"}}
-test switch-7.3 {"-" bodies} {
-    list [catch {
-	switch a {
-	    a -
-	    b -foo
-	    c -
-	}
-    } msg] $msg
-} {1 {no body specified for pattern "c"}}
-test switch-7.4 {"-" bodies} {
-    list [catch {
-	switch a {
-	    a -
-	    b -foo
-	    c {}
-	}
-    } msg] $msg
-} {1 {invalid command name "-foo"}}
+test switch-7.2 {"-" bodies} -body {
+    switch a {
+	a -
+	b -
+	c -
+    }
+} -returnCodes error -result {no body specified for pattern "c"}
+test switch-7.3 {"-" bodies} -body {
+    switch a {
+	a -
+	b -foo
+	c -
+    }
+} -returnCodes error -result {no body specified for pattern "c"}
+test switch-7.4 {"-" bodies} -body {
+    switch a {
+	a -
+	b -foo
+	c {}
+    }
+} -returnCodes error -result {invalid command name "-foo"}
 
 test switch-8.1 {empty body} {
     set msg {}
@@ -266,18 +251,15 @@ test switch-8.1 {empty body} {
         default {set msg 2}
     }
 } {}
-
 proc test_switch_body {} {
     return "INVOKED"
 }
-
 test switch-8.2 {weird body text, variable} {
     set cmd {test_switch_body}
     switch Foo {
     	Foo $cmd
     }
 } {INVOKED}
-
 test switch-8.3 {weird body text, variable} {
     set cmd {test_switch_body}
     switch Foo {
@@ -285,54 +267,63 @@ test switch-8.3 {weird body text, variable} {
     }
 } {INVOKED}
 
-test switch-9.1 {empty pattern/body list} {
-    list [catch {switch x} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
-test switch-9.2 {empty pattern/body list} {
-    list [catch {switch -- x} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string pattern body ... ?default body?"}}
-test switch-9.3 {empty pattern/body list} {
-    list [catch {switch x {}} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
-test switch-9.4 {empty pattern/body list} {
-    list [catch {switch -- x {}} msg] $msg
-} {1 {wrong # args: should be "switch ?switches? string {pattern body ... ?default body?}"}}
-test switch-9.5 {unpaired pattern} {
-    list [catch {switch x a {} b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.6 {unpaired pattern} {
-    list [catch {switch x {a {} b}} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.7 {unpaired pattern} {
-    list [catch {switch x a {} # comment b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.8 {unpaired pattern} {
-    list [catch {switch x {a {} # comment b}} msg] $msg
-} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
-test switch-9.9 {unpaired pattern} {
-    list [catch {switch x a {} x {} # comment b} msg] $msg
-} {1 {extra switch pattern with no body}}
-test switch-9.10 {unpaired pattern} {
-    list [catch {switch x {a {} x {} # comment b}} msg] $msg
-} {1 {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}}
+test switch-9.1 {empty pattern/body list} -returnCodes error -body {
+    switch x
+} -result {wrong # args: should be "switch ?-switch ...? string ?pattern body ...? ?default body?"}
+test switch-9.2 {unpaired pattern} -returnCodes error -body {
+    switch -- x
+} -result {extra switch pattern with no body}
+test switch-9.3 {empty pattern/body list} -body {
+    switch x {}
+} -returnCodes error -result {wrong # args: should be "switch ?-switch ...? string {?pattern body ...? ?default body?}"}
+test switch-9.4 {empty pattern/body list} -body {
+    switch -- x {}
+} -returnCodes error -result {wrong # args: should be "switch ?-switch ...? string {?pattern body ...? ?default body?}"}
+test switch-9.5 {unpaired pattern} -body {
+    switch x a {} b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.6 {unpaired pattern} -body {
+    switch x {a {} b}
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.7 {unpaired pattern} -body {
+    switch x a {} # comment b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.8 {unpaired pattern} -returnCodes error -body {
+    switch x {a {} # comment b}
+} -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}
+test switch-9.9 {unpaired pattern} -body {
+    switch x a {} x {} # comment b
+} -returnCodes error -result {extra switch pattern with no body}
+test switch-9.10 {unpaired pattern} -returnCodes error -body {
+    switch x {a {} x {} # comment b}
+} -result {extra switch pattern with no body, this may be due to a comment incorrectly placed outside of a switch body - see the "switch" documentation}
 
 test switch-10.1 {compiled -exact switch} {
-    if 1 {switch -exact -- a {a {format 1} b {format 2}}}
+    if 1 {switch -exact -- a {a {subst 1} b {subst 2}}}
+} 1
+test switch-10.1a {compiled -exact switch} {
+    if 1 {switch -exact a {a {subst 1} b {subst 2}}}
 } 1
 test switch-10.2 {compiled -exact switch} {
-    if 1 {switch -exact -- b {a {format 1} b {format 2}}}
+    if 1 {switch -exact -- b {a {subst 1} b {subst 2}}}
+} 2
+test switch-10.2a {compiled -exact switch} {
+    if 1 {switch -exact b {a {subst 1} b {subst 2}}}
 } 2
 test switch-10.3 {compiled -exact switch} {
-    if 1 {switch -exact -- c {a {format 1} b {format 2}}}
+    if 1 {switch -exact -- c {a {subst 1} b {subst 2}}}
+} {}
+test switch-10.3a {compiled -exact switch} {
+    if 1 {switch -exact c {a {subst 1} b {subst 2}}}
 } {}
 test switch-10.4 {compiled -exact switch} {
     if 1 {
 	set x 0
-	switch -exact -- c {a {format 1} b {format 2}}
+	switch -exact -- c {a {subst 1} b {subst 2}}
     }
 } {}
 test switch-10.5 {compiled -exact switch} {
-    if 1 {switch -exact -- a {a - aa {format 1} b {format 2}}}
+    if 1 {switch -exact -- a {a - aa {subst 1} b {subst 2}}}
 } 1
 test switch-10.6 {compiled -exact switch} {
     if 1 {switch -exact -- b {a {
@@ -344,7 +335,7 @@ test switch-10.6 {compiled -exact switch} {
 	set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1
 	set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1
 	set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1;set x 1
-    } b {format 2}}}
+    } b {subst 2}}}
 } 2
 
 # Command variants are:
@@ -354,7 +345,7 @@ test switch-10.6 {compiled -exact switch} {
 proc cswtest-glob s {
     set x 0; set y 0
     foreach c [split $s {}] {
-	switch -glob -- $c {
+	switch -glob $c {
 	    a {incr x}
 	    b {incr y}
 	}
@@ -368,7 +359,7 @@ proc cswtest-glob s {
 proc iswtest-glob s {
     set x 0; set y 0; set switch switch
     foreach c [split $s {}] {
-	$switch -glob -- $c {
+	$switch -glob $c {
 	    a {incr x}
 	    b {incr y}
 	}
@@ -382,7 +373,7 @@ proc iswtest-glob s {
 proc cswtest-exact s {
     set x 0; set y 0
     foreach c [split $s {}] {
-	switch -exact -- $c {
+	switch -exact $c {
 	    a {incr x}
 	    b {incr y}
 	}
@@ -396,7 +387,7 @@ proc cswtest-exact s {
 proc iswtest-exact s {
     set x 0; set y 0; set switch switch
     foreach c [split $s {}] {
-	$switch -exact -- $c {
+	$switch -exact $c {
 	    a {incr x}
 	    b {incr y}
 	}
@@ -410,7 +401,7 @@ proc iswtest-exact s {
 proc cswtest2-glob s {
     set x 0; set y 0; set z 0
     foreach c [split $s {}] {
-	switch -glob -- $c {
+	switch -glob $c {
 	    a {incr x}
 	    b {incr y}
 	    default {incr z}
@@ -425,7 +416,7 @@ proc cswtest2-glob s {
 proc iswtest2-glob s {
     set x 0; set y 0; set z 0; set switch switch
     foreach c [split $s {}] {
-	$switch -glob -- $c {
+	$switch -glob $c {
 	    a {incr x}
 	    b {incr y}
 	    default {incr z}
@@ -440,7 +431,7 @@ proc iswtest2-glob s {
 proc cswtest2-exact s {
     set x 0; set y 0; set z 0
     foreach c [split $s {}] {
-	switch -exact -- $c {
+	switch -exact $c {
 	    a {incr x}
 	    b {incr y}
 	    default {incr z}
@@ -455,7 +446,7 @@ proc cswtest2-exact s {
 proc iswtest2-exact s {
     set x 0; set y 0; set z 0; set switch switch
     foreach c [split $s {}] {
-	$switch -exact -- $c {
+	$switch -exact $c {
 	    a {incr x}
 	    b {incr y}
 	    default {incr z}
@@ -508,6 +499,12 @@ rename cswtest-exact {}
 rename iswtest-exact {}
 rename cswtest2-exact {}
 rename iswtest2-exact {}
+# Bug 1891827
+test switch-10.15 {(not) compiled exact nocase regression} {
+    apply {{} {
+	switch -nocase -- A { a {return yes} default {return no} }
+    }}
+} yes
 
 # Added due to TIP#75
 test switch-11.1 {regexp matching with -matchvar} {
@@ -539,7 +536,7 @@ test switch-11.6 {-matchvar unwritable} {
 
 test switch-12.1 {regexp matching with -indexvar} {
     switch -regexp -indexvar x -- abc {.(.). {set x}}
-} {{0 3} {1 2}}
+} {{0 2} {1 1}}
 test switch-12.2 {regexp matching with -indexvar} {
     set x GOOD
     switch -regexp -indexvar x -- abc {.(.).. {list $x z}}
@@ -547,7 +544,7 @@ test switch-12.2 {regexp matching with -indexvar} {
 } GOOD
 test switch-12.3 {regexp matching with -indexvar} {
     switch -regexp -indexvar x -- "a b c" {.(.). {set x}}
-} {{0 3} {1 2}}
+} {{0 2} {1 1}}
 test switch-12.4 {regexp matching with -indexvar} {
     set x BAD
     switch -regexp -indexvar x -- "a b c" {
@@ -563,22 +560,32 @@ test switch-12.6 {-indexvar unwritable} {
     set x {}
     list [catch {switch -regexp -indexvar x(x) -- abc . {set x}} msg] $x $msg
 } {1 {} {can't set "x(x)": variable isn't array}}
+test switch-12.7 {[Bug 3106532] -indexvar should be directly usable with [string range]} {
+    set str abcdef
+    switch -regexp -indexvar x -- $str ^... {string range $str {*}[lindex $x 0]}
+} abc
+test switch-12.8 {-indexvar and matched empty strings} {
+    switch -regexp -indexvar x -- abcdef ^...(x?) {return $x}
+} {{0 2} {3 2}}
+test switch-12.9 {-indexvar and unmatched strings} {
+    switch -regexp -indexvar x -- abcdef ^...(x)? {return $x}
+} {{0 2} {-1 -1}}
 
 test switch-13.1 {-indexvar -matchvar combinations} {
     switch -regexp -indexvar x -matchvar y abc {
 	. {list $x $y}
     }
-} {{{0 1}} a}
+} {{{0 0}} a}
 test switch-13.2 {-indexvar -matchvar combinations} {
     switch -regexp -indexvar x -matchvar y abc {
 	.$ {list $x $y}
     }
-} {{{2 3}} c}
+} {{{2 2}} c}
 test switch-13.3 {-indexvar -matchvar combinations} {
     switch -regexp -indexvar x -matchvar y abc {
 	(.)(.)(.) {list $x $y}
     }
-} {{{0 3} {0 1} {1 2} {2 3}} {abc a b c}}
+} {{{0 2} {0 0} {1 1} {2 2}} {abc a b c}}
 test switch-13.4 {-indexvar -matchvar combinations} {
     set x -
     set y -
@@ -600,8 +607,166 @@ test switch-13.6 {-indexvar -matchvar combinations} {
     list [catch {
 	switch -regexp -indexvar x -matchvar y(y) abc {. {list $x $y}}
     } msg] $x $y $msg
-} {1 {{0 1}} - {can't set "y(y)": variable isn't array}}
+} {1 {{0 0}} - {can't set "y(y)": variable isn't array}}
+
+test switch-14.1 {-regexp -- compilation [Bug 1854399]} {
+    switch -regexp -- 0 {
+	{[0-9]+} {return yes}
+	default  {return no}
+    }
+    foo
+} yes
+test switch-14.2 {-regexp -- compilation [Bug 1854399]} {
+    proc foo {} {
+	switch -regexp -- 0 {
+	    {[0-9]+} {return yes}
+	    default  {return no}
+	}
+    }
+    foo
+} yes
+test switch-14.3 {-regexp -- compilation [Bug 1854399]} {
+    proc foo {} {
+	switch -regexp -- 0 {
+	    {\d+} {return yes}
+	    default  {return no}
+	}
+    }
+    foo
+} yes
+test switch-14.4 {-regexp -- compilation [Bug 1854399]} {
+    proc foo {} {
+	switch -regexp -- 0 {
+	    {0} {return yes}
+	    default  {return no}
+	}
+    }
+    foo
+} yes
+test switch-14.5 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- 0 {
+	    {0|1|2} {return yes}
+	    default {return no}
+	}
+    }}
+} yes
+test switch-14.6 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- 0 {
+	    {0|11|222} {return yes}
+	    default {return no}
+	}
+    }}
+} yes
+test switch-14.7 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- 0 {
+	    {[012]} {return yes}
+	    default {return no}
+	}
+    }}
+} yes
+test switch-14.8 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- x {
+	    {0|1|2} {return yes}
+	    default {return no}
+	}
+    }}
+} no
+test switch-14.9 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- x {
+	    {0|11|222} {return yes}
+	    default {return no}
+	}
+    }}
+} no
+test switch-14.10 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- x {
+	    {[012]} {return yes}
+	    default {return no}
+	}
+    }}
+} no
+test switch-14.11 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- x {
+	    {0|1|2} {return yes}
+	    .+ {return yes2}
+	    default {return no}
+	}
+    }}
+} yes2
+test switch-14.12 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- x {
+	    {0|11|222} {return yes}
+	    .+ {return yes2}
+	    default {return no}
+	}
+    }}
+} yes2
+test switch-14.13 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- x {
+	    {[012]} {return yes}
+	    .+ {return yes2}
+	    default {return no}
+	}
+    }}
+} yes2
+test switch-14.14 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- {} {
+	    {0|1|2} {return yes}
+	    .+ {return yes2}
+	    default {return no}
+	}
+    }}
+} no
+test switch-14.15 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- {} {
+	    {0|11|222} {return yes}
+	    .+ {return yes2}
+	    default {return no}
+	}
+    }}
+} no
+test switch-14.16 {switch -regexp compilation} {
+    apply {{} {
+	switch -regexp -- {} {
+	    {[012]} {return yes}
+	    .+ {return yes2}
+	    default {return no}
+	}
+    }}
+} no
 
+test switch-15.1 {coroutine safety of non-bytecoded switch} {*}{
+    -body {
+	proc coro {} {
+	    switch -glob a {
+		a {yield ok1}
+	    }
+	    return ok2
+	}
+	list [coroutine c coro] [c]
+    }
+    -result {ok1 ok2}
+    -cleanup {
+	rename coro {}
+    }
+}
+
 # cleanup
+catch {rename foo {}}
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/tailcall.test b/tests/tailcall.test
new file mode 100644
index 0000000..2d04f82
--- /dev/null
+++ b/tests/tailcall.test
@@ -0,0 +1,666 @@
+# Commands covered:  tailcall
+#
+# This file contains a collection of tests for experimental commands that are
+# found in ::tcl::unsupported. The tests will migrate to normal test files
+# if/when the commands find their way into the core.
+#
+# Copyright (c) 2008 by Miguel Sofer.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    package require tcltest
+    namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testnrelevels [llength [info commands testnrelevels]]
+
+#
+# The tests that risked blowing the C stack on failure have been removed: we
+# can now actually measure using testnrelevels.
+#
+
+if {[testConstraint testnrelevels]} {
+    namespace eval testnre {
+	#
+	# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
+	# cmdFrame level, callFrame level, tosPtr and callback depth 
+	#
+	variable last [testnrelevels] 
+	proc depthDiff {} {
+	    variable last
+	    set depth [testnrelevels]
+	    set res {}
+	    foreach t $depth l $last {
+		lappend res [expr {$t-$l}]
+	    }
+	    set last $depth
+	    return $res
+	}
+	namespace export *
+    }
+    namespace import testnre::*
+}
+
+proc errorcode options {
+    dict get [dict merge {-errorcode NONE} $options] -errorcode
+}
+
+test tailcall-0.1 {tailcall is constant space} -constraints testnrelevels -setup {
+    proc a i {
+	#
+	# NOTE: there may be a diff in callback depth with the first call
+	# ($i==0) due to the fact that the first is from an eval. Successive
+	# calls should add nothing to any stack depths.
+	#
+	if {$i == 1} {
+	    depthDiff
+	}
+	if {[incr i] > 10} {
+	    return [depthDiff]
+	}
+	tailcall a $i
+    }
+} -body {
+    a 0
+} -cleanup {
+    rename a {}
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.2 {tailcall is constant space} -constraints testnrelevels -setup {
+    set a { i {
+	if {$i == 1} {
+	    depthDiff
+	}
+	if {[incr i] > 10} {
+	    return [depthDiff]
+	}
+	upvar 1 a a
+	tailcall apply $a $i
+    }}
+} -body {
+    apply $a 0
+} -cleanup {
+    unset a
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.3 {tailcall is constant space} -constraints testnrelevels -setup {
+    proc a i {
+	if {$i == 1} {
+	    depthDiff
+	}
+	if {[incr i] > 10} {
+	    return [depthDiff]
+	}
+	tailcall b $i
+    }
+    interp alias {} b {} a
+} -body {
+    b 0
+} -cleanup {
+    rename a {}
+    rename b {}
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.4 {tailcall is constant space} -constraints testnrelevels -setup {
+    namespace eval ::ns {
+	namespace export *
+    }
+    proc ::ns::a i {
+	if {$i == 1} {
+	    depthDiff
+	}
+	if {[incr i] > 10} {
+	    return [depthDiff]
+	}
+	set b [uplevel 1 [list namespace which b]]
+	tailcall $b $i
+    }
+    namespace import ::ns::a
+    rename a b
+} -body {
+    b 0
+} -cleanup {
+    rename b {}
+    namespace delete ::ns
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup {
+    proc b i {
+	if {$i == 1} {
+	    depthDiff
+	}
+	if {[incr i] > 10} {
+	    return [depthDiff]
+	}
+	tailcall a b $i
+    }
+    namespace ensemble create -command a -map {b b}
+} -body {
+    a b 0
+} -cleanup {
+    rename a {}
+    rename b {}
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.6 {tailcall is constant space} -constraints {testnrelevels knownBug} -setup {
+    #
+    # This test fails because ns-unknown is not NR-enabled
+    #
+    proc c i {
+	if {$i == 1} {
+	    depthDiff
+	}
+	if {[incr i] > 10} {
+	    return [depthDiff]
+	}
+	tailcall a b $i
+    }
+    proc d {ens sub args} {
+	return [list $ens c]
+    }
+    namespace ensemble create -command a -unknown d
+} -body {
+    a b 0
+} -cleanup {
+    rename a {}
+    rename c {}
+    rename d {}
+} -result {0 0 0 0 0 0}
+
+test tailcall-0.7 {tailcall is constant space} -constraints testnrelevels -setup {
+    catch {rename foo {}}
+    oo::class create foo {
+	method b i {
+	    if {$i == 1} {
+		depthDiff
+	    }
+	    if {[incr i] > 10} {
+		return [depthDiff]
+	    }
+	    tailcall [self] b $i
+	}
+    }
+} -body {
+    foo create a
+    a b 0
+} -cleanup {
+    rename a {}
+    rename foo {}
+} -result {0 0 0 0 0 0}
+
+test tailcall-1 {tailcall} -body {
+    namespace eval a {
+	variable x *::a
+	proc xset {} {
+	    set tmp {}
+	    set ns {[namespace current]}
+	    set level [info level]
+	    for {set i 0} {$i <= [info level]} {incr i} {
+		uplevel #$i "set x $i$ns"
+		lappend tmp "$i [info level $i]"
+	    }
+	    lrange $tmp 1 end
+	}
+	proc foo {} {tailcall xset; set x noreach}
+    }
+    namespace eval b {
+	variable x *::b
+	proc xset args {error b::xset}
+	proc moo {} {set x 0; variable y [::a::foo]; set x}
+    }
+    variable x *::
+    proc xset args {error ::xset}
+    list [::b::moo] | $x $a::x $b::x | $::b::y 
+} -cleanup {
+    unset x
+    rename xset {}
+    namespace delete a b
+} -result {1::b | 0:: *::a *::b | {{1 ::b::moo} {2 xset}}}
+
+
+test tailcall-2 {tailcall in non-proc} -body {
+    namespace eval a [list tailcall set x 1]
+} -match glob -result *tailcall* -returnCodes error
+
+test tailcall-3 {tailcall falls off tebc} -body {
+    unset -nocomplain x
+    proc foo {} {tailcall set x 1}
+    list [catch foo msg] $msg [set x]
+} -cleanup {
+    rename foo {}
+    unset x
+} -result {0 1 1}
+
+test tailcall-4 {tailcall falls off tebc} -body {
+    set x 2
+    proc foo {} {tailcall set x 1}
+    foo
+    set x
+} -cleanup {
+    rename foo {}
+    unset x
+} -result 1
+
+test tailcall-5 {tailcall falls off tebc} -body {
+    set x 2
+    namespace eval bar {
+	variable x 3
+	proc foo {} {tailcall set x 1}
+    }
+    bar::foo
+    list $x $bar::x
+} -cleanup {
+    unset x
+    namespace delete bar
+} -result {1 3}
+
+test tailcall-6 {tailcall does remove callframes} -body {
+    proc foo {} {info level}
+    proc moo {} {tailcall foo}
+    proc boo {} {expr {[moo] - [info level]}}
+    boo
+} -cleanup {
+    rename foo {}
+    rename moo {}
+    rename boo {}
+} -result 1
+
+test tailcall-7 {tailcall does return} -setup {
+    namespace eval ::foo {
+	variable res {}
+	proc a {} {
+	    variable res
+	    append res a
+	    tailcall set x 1
+	    append res a
+	}
+	proc b {} {
+	    variable res
+	    append res b
+	    a
+	    append res b
+	}
+	proc c {} {
+	    variable res
+	    append res c
+	    b
+	    append res c
+	}
+    }
+} -body {
+    namespace eval ::foo c
+} -cleanup {
+    namespace delete ::foo
+} -result cbabc
+
+test tailcall-8 {tailcall tailcall} -setup {
+    namespace eval ::foo {
+	variable res {}
+	proc a {} {
+	    variable res
+	    append res a
+	    tailcall tailcall set x 1
+	    append res a
+	}
+	proc b {} {
+	    variable res
+	    append res b
+	    a
+	    append res b
+	}
+	proc c {} {
+	    variable res
+	    append res c
+	    b
+	    append res c
+	}
+    }
+} -body {
+    namespace eval ::foo c
+} -cleanup {
+    namespace delete ::foo
+} -result cbac
+
+test tailcall-9 {tailcall factorial} -setup {
+    proc fact {n {b 1}} {
+	if {$n == 1} {
+	    return $b
+	}
+	tailcall fact [expr {$n-1}] [expr {$n*$b}]
+    }
+} -body {
+    list [fact 1] [fact 5] [fact 10] [fact 15]
+} -cleanup {
+    rename fact {}
+} -result {1 120 3628800 1307674368000}
+
+test tailcall-10a {tailcall and eval} -setup {
+    set ::x 0
+    proc a {} {
+	eval [list tailcall lappend ::x 2]
+	set ::x 1
+    }
+} -body {
+    list [a] $::x
+} -cleanup {
+    unset -nocomplain ::x
+} -result {{0 2} {0 2}}
+
+test tailcall-10b {tailcall and eval} -setup {
+    set ::x 0
+    proc a {} {
+	eval {tailcall lappend ::x 2}
+	set ::x 1
+    }
+} -body {
+    list [a] $::x
+} -cleanup {
+    unset -nocomplain ::x
+} -result {{0 2} {0 2}}
+
+test tailcall-11a {tailcall and uplevel} -setup {
+    proc a {} {
+	uplevel 1 [list tailcall set ::x 2]
+	set ::x 1
+    }
+} -body {
+    list [a] $::x
+} -cleanup {
+    unset -nocomplain ::x
+} -match glob -result *tailcall* -returnCodes error
+
+test tailcall-11b {tailcall and uplevel} -setup {
+    proc a {} {
+	uplevel 1 {tailcall set ::x 2}
+	set ::x 1
+    }
+} -body {
+    list [a] $::x
+} -cleanup {
+    unset -nocomplain ::x
+} -match glob -result *tailcall* -returnCodes error
+
+test tailcall-11c {tailcall and uplevel} -setup {
+    proc a {} {
+	uplevel 1 {tailcall lappend ::x 2}
+	set ::x 1
+    }
+    proc b {} {set ::x 0; a; lappend ::x 3}
+} -body {
+    list [b] $::x
+} -cleanup {
+    rename a {}
+    rename b {}
+    unset -nocomplain ::x
+} -result {{0 3 2} {0 3 2}}
+
+test tailcall-12.1 {[Bug 2649975]} -setup {
+    proc dump {{text {}}} {
+	set text [uplevel 1 [list subst $text]]
+	set l [expr {[info level] -1}]
+	if {$text eq {}} {
+	    set text [info level $l]
+	}
+	puts "$l: $text"
+    }
+    # proc dump args {}
+    proc bravo {} {
+	upvar 1 v w
+	dump {inside bravo, v -> $w}
+	set v "procedure bravo"
+	#uplevel 1 [list delta ::betty]
+	uplevel 1 {delta ::betty}
+	return $::resolution
+    }
+    proc delta name {
+	upvar 1 v w
+	dump {inside delta, v -> $w}
+	set v "procedure delta"
+	tailcall foxtrot
+    }
+    proc foxtrot {} {
+	upvar 1 v w
+	dump {inside foxtrot, v -> $w}
+	global resolution
+	set ::resolution $w
+    }
+    set v "global level"
+} -body {
+    set result [bravo]
+    if {$result ne $v} {
+	puts "v should have been found at $v but was found in $result"
+    }
+} -cleanup {
+    unset v
+    rename dump {}
+    rename bravo {}
+    rename delta {}
+    rename foxtrot {}
+} -output {1: inside bravo, v -> global level
+1: inside delta, v -> global level
+1: inside foxtrot, v -> global level
+}
+
+test tailcall-12.2 {[Bug 2649975]} -setup {
+    proc dump {{text {}}} {
+	set text [uplevel 1 [list subst $text]]
+	set l [expr {[info level] -1}]
+	if {$text eq {}} {
+	    set text [info level $l]
+	}
+	puts "$l: $text"
+    }
+    # proc dump args {}
+    set v "global level"
+    oo::class create foo { # like connection
+	method alpha {} {  # like connections 'tables' method
+	    dump
+	    upvar 1 v w
+	    dump {inside foo's alpha, v resolves to $w}
+	    set v "foo's method alpha"
+	    dump {foo's alpha is calling [self] bravo - v should resolve at global level}
+	    set result [uplevel 1 [list [self] bravo]]
+	    dump {exiting from foo's alpha}
+	    return $result
+	}
+	method bravo {} {  # like connections 'foreach' method
+	    dump
+	    upvar 1 v w
+	    dump {inside foo's bravo, v resolves to $w}
+	    set v "foo's method bravo"
+	    dump {foo's bravo is calling charlie to create barney}
+	    set barney [my charlie ::barney]
+	    dump {foo's bravo is calling bravo on $barney}
+	    dump {v should resolve at global scope there}
+	    set result [uplevel 1 [list $barney bravo]]
+	    dump {exiting from foo's bravo}
+	    return $result
+	}
+	method charlie {name} {  # like tdbc prepare
+	    dump
+	    set v "foo's method charlie"
+	    dump {tailcalling bar's constructor}
+	    tailcall ::bar create $name
+	}
+    }
+    oo::class create bar { # like statement
+	method  bravo {} {   # like statement foreach method
+	    dump
+	    upvar 1 v w
+	    dump {inside bar's bravo, v is resolving to $w}
+	    set v "bar's method bravo"
+	    dump {calling delta to construct betty - v should resolve global there}
+	    uplevel 1 [list [self] delta ::betty]
+	    dump {exiting from bar's bravo}
+	    return [::betty whathappened]
+	}
+	method delta {name} {    # like statement execute method
+	    dump
+	    upvar 1 v w
+	    dump {inside bar's delta, v is resolving to $w}
+	    set v "bar's method delta"
+	    dump {tailcalling to construct $name as instance of grill}
+	    dump {v should resolve at global level in grill's constructor}
+	    dump {grill's constructor should run at level [info level]}
+	    tailcall grill create $name
+	}
+    }
+    oo::class create grill {
+	variable resolution
+	constructor {} {
+	    dump
+	    upvar 1 v w
+	    dump "in grill's constructor, v resolves to $w"
+	    set resolution $w
+	}
+	method whathappened {} {
+	    return $resolution
+	}
+    }
+    foo create fred
+} -body {
+    set result [fred alpha]
+    if {$result ne "global level"} {
+	puts "v should have been found at global level but was found in $result"
+    }
+} -cleanup {
+    unset result
+    rename fred {}
+    rename dump {}
+    rename foo {}
+    rename bar {}
+    rename grill {}
+} -output {1: fred alpha
+1: inside foo's alpha, v resolves to global level
+1: foo's alpha is calling ::fred bravo - v should resolve at global level
+1: ::fred bravo
+1: inside foo's bravo, v resolves to global level
+1: foo's bravo is calling charlie to create barney
+2: my charlie ::barney
+2: tailcalling bar's constructor
+1: foo's bravo is calling bravo on ::barney
+1: v should resolve at global scope there
+1: ::barney bravo
+1: inside bar's bravo, v is resolving to global level
+1: calling delta to construct betty - v should resolve global there
+1: ::barney delta ::betty
+1: inside bar's delta, v is resolving to global level
+1: tailcalling to construct ::betty as instance of grill
+1: v should resolve at global level in grill's constructor
+1: grill's constructor should run at level 1
+1: grill create ::betty
+1: in grill's constructor, v resolves to global level
+1: exiting from bar's bravo
+1: exiting from foo's bravo
+1: exiting from foo's alpha
+}
+
+test tailcall-12.3a0 {[Bug 2695587]} -body {
+    apply {{} {
+	catch [list tailcall foo]
+    }}
+} -returnCodes 1 -result {invalid command name "foo"}
+
+test tailcall-12.3a1 {[Bug 2695587]} -body {
+    apply {{} {
+	catch [list tailcall foo]
+	tailcall
+    }}
+} -result {}
+
+test tailcall-12.3a2 {[Bug 2695587]} -body {
+    apply {{} {
+	catch [list tailcall foo]
+	tailcall moo
+    }}
+} -returnCodes 1 -result {invalid command name "moo"}
+
+test tailcall-12.3a3 {[Bug 2695587]} -body {
+    set x 0
+    apply {{} {
+	catch [list tailcall foo]
+	tailcall lappend x 1
+    }}
+    set x
+} -cleanup {
+    unset x
+} -result {0 1} 
+
+test tailcall-12.3b0 {[Bug 2695587]} -body {
+    apply {{} {
+	set catch catch
+	$catch [list tailcall foo]
+    }}
+} -returnCodes 1 -result {invalid command name "foo"}
+
+test tailcall-12.3b1 {[Bug 2695587]} -body {
+    apply {{} {
+	set catch catch
+	$catch [list tailcall foo]
+	tailcall
+    }}
+} -result {}
+
+test tailcall-12.3b2 {[Bug 2695587]} -body {
+    apply {{} {
+	set catch catch
+	$catch [list tailcall foo]
+	tailcall moo
+    }}
+} -returnCodes 1 -result {invalid command name "moo"}
+
+test tailcall-12.3b3 {[Bug 2695587]} -body {
+    set x 0
+    apply {{} {
+	set catch catch
+	$catch [list tailcall foo]
+	tailcall lappend x 1
+    }}
+    set x
+} -cleanup {
+    unset x
+} -result {0 1} 
+
+# MORE VARIANTS MISSING: bc'ed caught script vs (bc'ed, not-bc'ed)
+# catch. Actually superfluous now, as tailcall just returns TCL_RETURN so that
+# standard catch behaviour is required.
+
+test tailcall-13.1 {directly tailcalling the tailcall command is ok} {
+    list [catch {
+	apply {{} {
+	    apply {{} {
+		tailcall tailcall subst ok
+		subst b
+	    }}
+	    subst c
+	}}
+    } msg opt] $msg [errorcode $opt]
+} {0 ok NONE}
+test tailcall-13.2 {indirectly tailcalling the tailcall command is ok} {
+    list [catch {
+	apply {{} {
+	    apply {{} {
+		tailcall eval tailcall subst ok
+		subst b
+	    }}
+	    subst c
+	}}
+    } msg opt] $msg [errorcode $opt]
+} {0 ok NONE}
+
+if {[testConstraint testnrelevels]} {
+    namespace forget testnre::*
+    namespace delete testnre
+}
+
+# cleanup
+::tcltest::cleanupTests
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 1547a87..ce8d617 100755..100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -2,13 +2,11 @@
 # 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) 1998-1999 by Scriptics Corporation. 
+# Copyright (c) 1998-1999 by Scriptics Corporation.
 # Copyright (c) 2000 by Ajuba Solutions
 # All rights reserved.
-#
-# RCS: @(#) $Id: tcltest.test,v 1.52 2005/05/10 18:35:24 kennykb Exp $
 
-# Note that there are several places where the value of 
+# Note that there are several places where the value of
 # tcltest::currentFailure is stored/reset in the -setup/-cleanup
 # of a test that has a body that runs [test] that will fail.
 # This is a workaround of using the same tcltest code that we are
@@ -16,7 +14,7 @@
 #
 # It would be better to have the -body of the tests run the tcltest
 # commands in a slave interp so the [test] being tested would not
-# interfere with the [test] doing the testing.  
+# interfere with the [test] doing the testing.
 #
 
 if {[catch {package require tcltest 2.1}]} {
@@ -53,7 +51,7 @@ testConstraint exec [llength [info commands exec]]
 test tcltest-1.1 {tcltest -help} {exec} {
     set result [catch {exec [interpreter] test.tcl -help} msg]
     list $result [regexp Usage $msg]
-} {1 1} 
+} {1 1}
 test tcltest-1.2 {tcltest -help -something} {exec} {
     set result [catch {exec [interpreter] test.tcl -help -something} msg]
     list $result [regexp Usage $msg]
@@ -61,7 +59,7 @@ test tcltest-1.2 {tcltest -help -something} {exec} {
 test tcltest-1.3 {tcltest -h} {exec} {
     set result [catch {exec [interpreter] test.tcl -h} msg]
     list $result [regexp Usage $msg]
-} {1 0} 
+} {1 0}
 
 # -verbose, implicit & explicit testing of [verbose]
 proc slave {msgVar args} {
@@ -82,10 +80,7 @@ proc slave {msgVar args} {
 
     # Need to capture output in msg
 
-    set code [catch {i eval {source $argv0}} foo]
-if $code {
-#puts "$code: $foo\n$::errorInfo"
-}
+    set code [catch {i eval {source $argv0}}]
     i eval {close $tcltest::outputChannel}
     interp delete [namespace current]::i
     set f [open $of]
@@ -101,8 +96,6 @@ if $code {
 	append msg \n$err
     }
     return $code
-
-#    return [catch {uplevel 1 [linsert $args 0  exec [interpreter]]} msg]
 }
 test tcltest-2.0 {tcltest (verbose default - 'b')} {unixOrPc} {
     set result [slave msg test.tcl]
@@ -439,7 +432,7 @@ test tcltest-6.7 {tcltest::outputChannel - retrieval} {
     }
     -result {stdout}
     -cleanup {
-	set tcltest::outputChannel $of
+	set ::tcltest::outputChannel $of
     }
 }
 
@@ -528,57 +521,76 @@ set normaldirectory [makeDirectory normaldirectory]
 normalizePath normaldirectory
 
 # -tmpdir, [temporaryDirectory]
-test tcltest-8.1 {tcltest a.tcl -tmpdir a} {unixOrPc} {
+test tcltest-8.1 {tcltest a.tcl -tmpdir a} -constraints unixOrPc -setup {
     file delete -force thisdirectorydoesnotexist
+} -body {
     slave msg $a -tmpdir thisdirectorydoesnotexist
-    list [file exists [file join thisdirectorydoesnotexist a.tmp]] \
-	    [file delete -force thisdirectorydoesnotexist] 
-} {1 {}}
+    file exists [file join thisdirectorydoesnotexist a.tmp]
+} -cleanup {
+    file delete -force thisdirectorydoesnotexist
+} -result 1
 test tcltest-8.2 {tcltest a.tcl -tmpdir thisdirectoryisafile} {
     -constraints unixOrPc
     -body {
 	slave msg $a -tmpdir $tdiaf
-	set msg
+	return $msg
     }
     -result {*not a directory*}
     -match glob
 }
-
 # Test non-writeable directories, non-readable directories with directory flags
 set notReadableDir [file join [temporaryDirectory] notreadable]
 set notWriteableDir [file join [temporaryDirectory] notwriteable]
-
 makeDirectory notreadable
 makeDirectory notwriteable
-
-switch $tcl_platform(platform) {
-    "unix" {
+switch -- $::tcl_platform(platform) {
+    unix {
 	file attributes $notReadableDir -permissions 00333
 	file attributes $notWriteableDir -permissions 00555
     }
     default {
 	catch {file attributes $notWriteableDir -readonly 1}
+	catch {testchmod 000 $notWriteableDir}
     }
 }
-
-test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {unix notRoot} {
-    slave msg $a -tmpdir $notReadableDir 
-    string match {*not readable*} $msg
-} {1}
-
-test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {unixOrPc notRoot} {
-    slave msg $a -tmpdir $notWriteableDir
-    string match {*not writeable*} $msg
-} {1}
-
-test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {unixOrPc} {
-    slave msg $a -tmpdir $normaldirectory
-    # The join is necessary because the message can be split on multiple lines
-    list [file exists [file join $normaldirectory a.tmp]] \
-	    [file delete [file join $normaldirectory a.tmp]] 
-} {1 {}}   
+test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
+    -constraints {unix notRoot}
+    -body {
+	slave msg $a -tmpdir $notReadableDir
+	return $msg
+    }
+    -result {*not readable*}
+    -match glob
+}
+# This constraint doesn't go at the top of the file so that it doesn't
+# interfere with tcltest-5.5
+testConstraint notFAT [expr {
+    ![string match "FAT*" [lindex [file system $notWriteableDir] 1]]
+}]
+# FAT permissions are fairly hopeless; ignore this test if that FS is used
+test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
+    -constraints {unixOrPc notRoot notFAT}
+    -body {
+	slave msg $a -tmpdir $notWriteableDir
+	return $msg
+    }
+    -result {*not writeable*}
+    -match glob
+}
+test tcltest-8.5 {tcltest a.tcl -tmpdir normaldirectory} {
+    -constraints unixOrPc
+    -body {
+	slave msg $a -tmpdir $normaldirectory
+	# The join is necessary because the message can be split on multiple
+	# lines
+	file exists [file join $normaldirectory a.tmp]
+    }
+    -cleanup {
+	catch {file delete [file join $normaldirectory a.tmp]}
+    }
+    -result 1
+}
 cd [workingDirectory]
-
 test tcltest-8.6 {temporaryDirectory}  {
     -setup {
 	set old $::tcltest::temporaryDirectory
@@ -595,7 +607,6 @@ test tcltest-8.6 {temporaryDirectory}  {
 	set ::tcltest::temporaryDirectory $old
     }
 }
-
 test tcltest-8.6a {temporaryDirectory - test format 2} -setup {
     set old $::tcltest::temporaryDirectory
     set ::tcltest::temporaryDirectory $normaldirectory
@@ -607,35 +618,53 @@ test tcltest-8.6a {temporaryDirectory - test format 2} -setup {
 } -cleanup {
     set ::tcltest::temporaryDirectory $old
 } -result [list $normaldirectory [workingDirectory] [workingDirectory]]
-
 cd [temporaryDirectory]
 # -testdir, [testsDirectory]
-test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {unixOrPc} {
-    file delete -force thisdirectorydoesnotexist
-    slave msg $a -testdir thisdirectorydoesnotexist
-    string match "*does not exist*" $msg
-} {1}
-
-test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {unixOrPc} {
-    slave msg $a -testdir $tdiaf
-    string match "*not a directory*" $msg 
-} {1}
-
-test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {unix notRoot} {
-    slave msg $a -testdir $notReadableDir 
-    string match {*not readable*} $msg
-} {1}
-
-
-test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {unixOrPc} {
-    slave msg $a -testdir $normaldirectory
-    # The join is necessary because the message can be split on multiple lines
-    list [string first "testdir: $normaldirectory" [join $msg]] \
-	    [file exists [file join [temporaryDirectory] a.tmp]] \
-	    [file delete [file join [temporaryDirectory] a.tmp]] 
-} {0 1 {}} 
+test tcltest-8.10 {tcltest a.tcl -testdir thisdirectorydoesnotexist} {
+    -constraints unixOrPc
+    -setup {
+	file delete -force thisdirectorydoesnotexist
+    }
+    -body {
+	slave msg $a -testdir thisdirectorydoesnotexist
+	return $msg
+    }
+    -match glob
+    -result {*does not exist*}
+}
+test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
+    -constraints unixOrPc
+    -body {
+	slave msg $a -testdir $tdiaf
+	return $msg
+    }
+    -match glob
+    -result {*not a directory*}
+}
+test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
+    -constraints {unix notRoot}
+    -body {
+	slave msg $a -testdir $notReadableDir
+	return $msg
+    }
+    -match glob
+    -result {*not readable*}
+}
+test tcltest-8.13 {tcltest a.tcl -testdir normaldirectory} {
+    -constraints unixOrPc
+    -body {
+	slave msg $a -testdir $normaldirectory
+	# The join is necessary because the message can be split on multiple
+	# lines
+	list [string first "testdir: $normaldirectory" [join $msg]] \
+	    [file exists [file join [temporaryDirectory] a.tmp]]
+    }
+    -cleanup {
+	file delete [file join [temporaryDirectory] a.tmp]
+    }
+    -result {0 1}
+}
 cd [workingDirectory]
-
 set current [pwd]
 test tcltest-8.14 {testsDirectory} {
     -setup {
@@ -653,7 +682,6 @@ test tcltest-8.14 {testsDirectory} {
 	set ::tcltest::testsDirectory $old
     }
 }
-
 # [workingDirectory]
 test tcltest-8.60 {::workingDirectory}  {
     -setup {
@@ -666,7 +694,7 @@ test tcltest-8.60 {::workingDirectory}  {
 	set f1 [workingDirectory]
 	set f2 [pwd]
 	set f3 [workingDirectory $current]
-	set f4 [pwd] 
+	set f4 [pwd]
 	set f5 [workingDirectory]
 	list $f1 $f2 $f3 $f4 $f5
     }
@@ -683,17 +711,18 @@ test tcltest-8.60 {::workingDirectory}  {
 
 # clean up from directory testing
 
-switch $tcl_platform(platform) {
-    "unix" {
+switch -- $::tcl_platform(platform) {
+    unix {
 	file attributes $notReadableDir -permissions 777
 	file attributes $notWriteableDir -permissions 777
     }
     default {
+	catch {testchmod 777 $notWriteableDir}
 	catch {file attributes $notWriteableDir -readonly 0}
     }
 }
 
-file delete -force $notReadableDir $notWriteableDir
+file delete -force -- $notReadableDir $notWriteableDir
 removeFile a.tcl
 removeFile thisdirectoryisafile
 removeDirectory normaldirectory
@@ -704,7 +733,7 @@ test tcltest-9.1 {-file d*.tcl} -constraints {unixOrPc} -setup {
     testsDirectory [file dirname [info script]]
 } -body {
     slave msg [file join [testsDirectory] all.tcl] -file d*.test
-    set msg
+    return $msg
 } -cleanup {
     testsDirectory $old
 } -match regexp -result {dstring\.test}
@@ -813,17 +842,17 @@ test tcltest-10.4 {-preservecore 3} {unixOrPc} {
 removeFile makecore.tcl
 
 # -load, -loadfile, [loadScript], [loadFile]
-set contents { 
+set contents {
     package require tcltest
     namespace import tcltest::*
     puts [outputChannel] $::tcltest::loadScript
     exit
-} 
+}
 set loadfile [makeFile $contents load.tcl]
 
 test tcltest-12.1 {-load xxx} {unixOrPc} {
     slave msg $loadfile -load xxx
-    set msg
+    return $msg
 } {xxx}
 
 # Using child process because of -debug usage.
@@ -914,7 +943,7 @@ test tcltest-14.1 {-singleproc - single process} {
     -constraints {unixOrPc}
     -body {
 	slave msg $allfile -singleproc 0 -tmpdir [temporaryDirectory]
-	set msg
+	return $msg
     }
     -result {Test file error: can't unset .foo.: no such variable}
     -match regexp
@@ -924,7 +953,7 @@ test tcltest-14.2 {-singleproc - multiple process} {
     -constraints {unixOrPc}
     -body {
 	slave msg $allfile -singleproc 1 -tmpdir [temporaryDirectory]
-	set msg
+	return $msg
     }
     -result {single1.test.*single2.test.*all\-single.tcl:.*Total.*0.*Passed.*0.*Skipped.*0.*Failed.*0}
     -match regexp
@@ -1116,7 +1145,7 @@ test tcltest-19.1 {TCLTEST_OPTIONS default} -setup {
     } -cleanup {
 	interp delete slave2
 	interp delete slave1
-	if {$oldoptions == "none"} {
+	if {$oldoptions eq "none"} {
 	    unset ::env(TCLTEST_OPTIONS) 
 	} else {
 	    set ::env(TCLTEST_OPTIONS) $oldoptions
@@ -1758,7 +1787,7 @@ test tcltest-25.3 {
 test tcltest-26.1 {Bug/RFE 1017151} -setup {
     makeFile {
 	package require tcltest
-	set errorInfo "Should never see this"
+	set ::errorInfo "Should never see this"
 	tcltest::test tcltest-26.1.0 {
 	    no errorInfo when only return code mismatch
 	} -body {
@@ -1768,7 +1797,7 @@ test tcltest-26.1 {Bug/RFE 1017151} -setup {
     } test.tcl
 } -body {
     slave msg [file join [temporaryDirectory] test.tcl]
-    set msg
+    return $msg
 } -cleanup {
     removeFile test.tcl
 } -match glob -result {*
@@ -1778,7 +1807,7 @@ test tcltest-26.1 {Bug/RFE 1017151} -setup {
 test tcltest-26.2 {Bug/RFE 1017151} -setup {
     makeFile {
 	package require tcltest
-	set errorInfo "Should never see this"
+	set ::errorInfo "Should never see this"
 	tcltest::test tcltest-26.2.0 {do not mask body errorInfo} -body {
 	    error "body error"
 	} -cleanup {
@@ -1788,7 +1817,7 @@ test tcltest-26.2 {Bug/RFE 1017151} -setup {
     } test.tcl
 } -body {
     slave msg [file join [temporaryDirectory] test.tcl]
-    set msg
+    return $msg
 } -cleanup {
     removeFile test.tcl
 } -match glob -result {*
diff --git a/tests/thread.test b/tests/thread.test
index 50c3360..f32ef61 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -6,251 +6,1411 @@
 #
 # Copyright (c) 1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: thread.test,v 1.14 2004/10/25 20:24:14 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2.2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 # Some tests require the testthread command
 
 testConstraint testthread [expr {[info commands testthread] != {}}]
 
-if {[testConstraint testthread]} {
-    testthread errorproc ThreadError
+# Some tests require the Thread package
+
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+
+# Some tests may not work under valgrind
+
+testConstraint notValgrind [expr {![testConstraint valgrind]}]
+
+set threadSuperKillScript {
+    rename catch ""
+    rename while ""
+    rename unknown ""
+    rename update ""
+    thread::release
+}
 
-    proc ThreadError {id info} {
-	global threadError
-	set threadError $info
+proc getThreadErrorFromInfo { info } {
+    set list [split $info \n]
+    set idx [lsearch -glob $list "*eval*unwound*"]
+    if {$idx != -1} then {
+        return [lindex $list $idx]
     }
+    set idx [lsearch -glob $list "*eval*canceled*"]
+    if {$idx != -1} then {
+        return [lindex $list $idx]
+    }
+    return ""; # some other error we do not care about.
+}
 
-    proc ThreadNullError {id info} {
-	# ignore
+proc findThreadError { info } {
+    foreach error [lreverse $info] {
+        set error [getThreadErrorFromInfo $error]
+        if {[string length $error] > 0} then {
+            return $error
+        }
     }
+    return ""; # some other error we do not care about.
 }
 
+proc ThreadError {id info} {
+    global threadSawError
+    if {[string length [getThreadErrorFromInfo $info]] > 0} then {
+        global threadId threadError
+        set threadId $id
+        lappend threadError($id) $info
+    }
+    set threadSawError($id) true; # signal main thread to exit [vwait].
+}
 
-test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
-    list [catch {testthread} msg] $msg
-} {1 {wrong # args: should be "testthread option ?args?"}}
-test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
-    list [catch {testthread foo} msg] $msg
-} {1 {bad option "foo": must be create, exit, id, join, names, send, wait, or errorproc}}
-test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {testthread} {
-    list [threadReap] [llength [testthread names]]
-} {1 1}
-test thread-1.4 {Tcl_ThreadObjCmd: thread create } {testthread} {
-    threadReap
-    set serverthread [testthread create]
-    update
-    set numthreads [llength [testthread names]]
-    threadReap
+if {[testConstraint thread]} {
+    thread::errorproc ThreadError
+}
+
+if {[testConstraint testthread]} {
+    proc drainEventQueue {} {
+	while {[set x [testthread event]]} {
+	    #puts "WARNING: drained $x event(s) on main thread"
+	}
+    }
+
+    testthread errorproc ThreadError
+}
+
+# Some tests require manual draining of the event queue
+
+testConstraint drainEventQueue [expr {[info commands drainEventQueue] != {}}]
+
+test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {thread} {
+    llength [thread::names]
+} 1
+test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} {
+    set serverthread [thread::create -preserved]
+    set numthreads [llength [thread::names]]
+    thread::release $serverthread
     set numthreads
 } {2}
-test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {testthread} {
-    threadReap
-    testthread create {set x 5}
+test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} {
+    thread::create {set x 5}
     foreach try {0 1 2 4 5 6} {
 	# Try various ways to yield
 	update
 	after 10
-	set l [llength [testthread names]]
+	set l [llength [thread::names]]
 	if {$l == 1} {
 	    break
 	}
     }
-    threadReap
     set l
 } {1}
-test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {testthread} {
-    threadReap
-    testthread create {testthread exit}
+test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} {
+    thread::create {{*}{}}
     update
     after 10
-    set result [llength [testthread names]]
-    threadReap
-    set result
+    llength [thread::names]
 } {1}
-test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {testthread} {
-    set x [catch {testthread id x} msg]
-    list $x $msg
-} {1 {wrong # args: should be "testthread id"}}
-test thread-1.8 {Tcl_ThreadObjCmd: thread id} {testthread} {
-    string compare [testthread id] $::tcltest::mainThread
-} {0}
-test thread-1.9 {Tcl_ThreadObjCmd: thread names args} {testthread} {
-    set x [catch {testthread names x} msg]
-    list $x $msg
-} {1 {wrong # args: should be "testthread names"}}
-test thread-1.10 {Tcl_ThreadObjCmd: thread id} {testthread} {
-    string compare [testthread names] $::tcltest::mainThread
-} {0}
-test thread-1.11 {Tcl_ThreadObjCmd: send args} {testthread} {
-    set x [catch {testthread send} msg]
-    list $x $msg
-} {1 {wrong # args: should be "testthread send ?-async? id script"}}
-test thread-1.12 {Tcl_ThreadObjCmd: send nonint} {testthread} {
-    set x [catch {testthread send abc command} msg]
-    list $x $msg
-} {1 {expected integer but got "abc"}}
-test thread-1.13 {Tcl_ThreadObjCmd: send args} {testthread} {
-    threadReap
-    set serverthread [testthread create]
-    set five [testthread send $serverthread {set x 5}]
-    threadReap
+test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} {
+    set serverthread [thread::create -preserved]
+    set five [thread::send $serverthread {set x 5}]
+    thread::release $serverthread
     set five
 } 5
-test thread-1.14 {Tcl_ThreadObjCmd: send bad id} {testthread} {
-    set tid [expr $::tcltest::mainThread + 10]
-    set x [catch {testthread send $tid {set x 5}} msg]
-    list $x $msg
-} {1 {invalid thread id}}
-test thread-1.15 {Tcl_ThreadObjCmd: wait} {testthread} {
-    threadReap
-    set serverthread [testthread create {set z 5 ; testthread wait}]
-    set five [testthread send $serverthread {set z}]
-    threadReap
+test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} {
+    set serverthread [thread::create -preserved {set z 5 ; thread::wait}]
+    set five [thread::send $serverthread {set z}]
+    thread::release $serverthread
     set five
 } 5
-test thread-1.16 {Tcl_ThreadObjCmd: errorproc args} {testthread} {
-    set x [catch {testthread errorproc foo bar} msg]
-    list $x $msg
-} {1 {wrong # args: should be "testthread errorproc proc"}}
-test thread-1.17 {Tcl_ThreadObjCmd: errorproc change} {testthread} {
-    testthread errorproc foo
-    testthread errorproc ThreadError
-} {}
 
 # The tests above also cover:
 # TclCreateThread, except when pthread_create fails
 # NewThread, safe and regular
 # ThreadErrorProc, except for printing to standard error
 
-test thread-2.1 {ListUpdateInner and ListRemove} {testthread} {
-    threadReap
+test thread-2.1 {ListUpdateInner and ListRemove} {thread} {
     catch {unset tid}
     foreach t {0 1 2} {
 	upvar #0 t$t tid
-	set tid [testthread create]
+	set tid [thread::create -preserved]
+    }
+    foreach t {0 1 2} {
+	upvar #0 t$t tid
+	thread::release $tid
     }
-    threadReap
+    llength [thread::names]
 } 1
 
-test thread-3.1 {TclThreadList} {testthread} {
-    threadReap
+test thread-3.1 {TclThreadList} {thread} {
     catch {unset tid}
-    set len [llength [testthread names]]
+    set len [llength [thread::names]]
     set l1  {}
     foreach t {0 1 2} {
-	lappend l1 [testthread create]
+	lappend l1 [thread::create -preserved]
+    }
+    set l2 [thread::names]
+    set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]]
+    foreach t $l1 {
+	thread::release $t
     }
-    set l2 [testthread names]
-    list $l1 $l2
-    set c [string compare \
-	    [lsort -integer [concat $::tcltest::mainThread $l1]] \
-	    [lsort -integer $l2]]
-    threadReap
     list $len $c
 } {1 0}
 
-test thread-4.1 {TclThreadSend to self} {testthread} {
+test thread-4.1 {TclThreadSend to self} {thread} {
     catch {unset x}
-    testthread send [testthread id] {
+    thread::send [thread::id] {
 	set x 4
     }
     set x
 } {4}
-test thread-4.2 {TclThreadSend -async} {testthread} {
-    threadReap
-    set len [llength [testthread names]]
-    set serverthread [testthread create]
-    testthread send -async $serverthread {
-	after 1000
-	testthread exit
+test thread-4.2 {TclThreadSend -async} {thread} {
+    set len [llength [thread::names]]
+    set serverthread [thread::create -preserved]
+    thread::send -async $serverthread {
+	after 1 {thread::release}
     }
-    set two [llength [testthread names]]
-    after 1500 {set done 1}
+    set two [llength [thread::names]]
+    after 100 {set done 1}
     vwait done
-    threadReap
-    list $len [llength [testthread names]] $two
+    list $len [llength [thread::names]] $two
 } {1 1 2}
-test thread-4.3 {TclThreadSend preserve errorInfo} {testthread} {
-    threadReap
-    set len [llength [testthread names]]
-    set serverthread [testthread create]
-    set x [catch {testthread send $serverthread {set undef}} msg]
-    threadReap
-    list $len $x $msg $errorInfo
+test thread-4.3 {TclThreadSend preserve errorInfo} {thread} {
+    set len [llength [thread::names]]
+    set serverthread [thread::create -preserved]
+    set x [catch {thread::send $serverthread {set undef}} msg]
+    set savedErrorInfo $::errorInfo
+    thread::release $serverthread
+    list $len $x $msg $savedErrorInfo
 } {1 1 {can't read "undef": no such variable} {can't read "undef": no such variable
     while executing
 "set undef"
     invoked from within
-"testthread send $serverthread {set undef}"}}
-test thread-4.4 {TclThreadSend preserve code} {testthread} {
-    threadReap
-    set len [llength [testthread names]]
-    set serverthread [testthread create]
-    set x [catch {testthread send $serverthread {set errorInfo {}; break}} msg]
-    threadReap
-    list $len $x $msg $errorInfo
+"thread::send $serverthread {set undef}"}}
+test thread-4.4 {TclThreadSend preserve code} {thread} {
+    set len [llength [thread::names]]
+    set serverthread [thread::create -preserved]
+    set ::errorInfo {}
+    set x [catch {thread::send $serverthread {set ::errorInfo {}; break}} msg]
+    set savedErrorInfo $::errorInfo
+    thread::release $serverthread
+    list $len $x $msg $savedErrorInfo
 } {1 3 {} {}}
-test thread-4.5 {TclThreadSend preserve errorCode} {testthread} {
-    threadReap
-    set ::tcltest::mainThread [testthread names]
-    set serverthread [testthread create]
-    set x [catch {testthread send $serverthread {error ERR INFO CODE}} msg]
-    threadReap
-    list $x $msg $errorCode
+test thread-4.5 {TclThreadSend preserve errorCode} {thread} {
+    set serverthread [thread::create]
+    set x [catch {thread::send $serverthread {error ERR INFO CODE}} msg]
+    set savedErrorCode $::errorCode
+    thread::release $serverthread
+    list $x $msg $savedErrorCode
 } {1 ERR CODE}
 
 
-test thread-5.0 {Joining threads} {testthread} {
-    threadReap
-    set serverthread [testthread create -joinable]
-    testthread send -async $serverthread {after 1000 ; testthread exit}
-    set res [testthread join $serverthread]
-    threadReap
-    set res
+test thread-5.0 {Joining threads} {thread} {
+    set serverthread [thread::create -joinable -preserved]
+    thread::send -async $serverthread {after 1000 ; thread::release}
+    thread::join $serverthread
 } {0}
-test thread-5.1 {Joining threads after the fact} {testthread} {
-    threadReap
-    set serverthread [testthread create -joinable]
-    testthread send -async $serverthread {testthread exit}
+test thread-5.1 {Joining threads after the fact} {thread} {
+    set serverthread [thread::create -joinable -preserved]
+    thread::send -async $serverthread {thread::release}
     after 2000
-    set res [testthread join $serverthread]
-    threadReap
-    set res
+    thread::join $serverthread
 } {0}
-test thread-5.2 {Try to join a detached thread} {testthread} {
-    threadReap
-    set serverthread [testthread create]
-    testthread send -async $serverthread {after 1000 ; testthread exit}
-    catch {set res [testthread join $serverthread]} msg
-    threadReap
+test thread-5.2 {Try to join a detached thread} {thread} {
+    set serverthread [thread::create -preserved]
+    thread::send -async $serverthread {after 1000 ; thread::release}
+    catch {set res [thread::join $serverthread]} msg
+    while {[llength [thread::names]] > 1} {
+	after 20
+    }
     lrange $msg 0 2
 } {cannot join thread}
 
-test thread-6.1 {freeing very large object trees in a thread} testthread {
+test thread-6.1 {freeing very large object trees in a thread} thread {
     # conceptual duplicate of obj-32.1
-    threadReap
-    set serverthread [testthread create -joinable]
-    testthread send -async $serverthread {
+    set serverthread [thread::create -preserved]
+    thread::send -async $serverthread {
 	set x {}
 	for {set i 0} {$i<100000} {incr i} {
 	    set x [list $x {}]
 	}
 	unset x
-	testthread exit
     }
-    catch {set res [testthread join $serverthread]} msg
-    threadReap
-    set res
-} {0}
+    thread::release -wait $serverthread
+} 0
+
+# TIP #285: Script cancellation support
+test thread-7.4 {cancel: pure bytecode loop} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.5 {cancel: pure inside-command loop} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    set while while
+	    $while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.6 {cancel: pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.7 {cancel: pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    set while while
+	    $while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.8 {cancel: pure bytecode loop custom result} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread "the eval was canceled"]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was canceled}}
+test thread-7.9 {cancel: pure inside-command loop custom result} -constraints {
+    thread
+    drainEventQueue
+} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    set while while
+	    $while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread "the eval was canceled"]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was canceled}}
+test thread-7.10 {cancel: pure bytecode loop custom result -unwind} -constraints {
+    thread
+    drainEventQueue
+} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread "the eval was unwound"]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was unwound}}
+test thread-7.11 {cancel: pure inside-command loop custom result -unwind} -constraints {
+    thread
+    drainEventQueue
+} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    set while while
+	    $while {1} {
+		# No bytecode at all here...
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread "the eval was unwound"]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {the eval was unwound}}
+test thread-7.12 {cancel: after} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+	    set foo 1
+	}
+	after 30000
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.13 {cancel: after -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+	    set foo 1
+	}
+	after 30000
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.14 {cancel: vwait} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID [thread::id]] {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+	    set foo 1
+	}
+	vwait forever
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.15 {cancel: vwait -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	if {![info exists foo]} then {
+	    # signal the primary thread that we are ready
+	    # to be canceled now (we are running).
+	    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+	    set foo 1
+	}
+	vwait forever
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.16 {cancel: expr} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    expr {[while {1} {incr x}]}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.17 {cancel: expr -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    expr {[while {1} {incr x}]}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.18 {cancel: expr bignum} {thread drainEventQueue knownBug} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+        set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+        $i eval {
+            if {![info exists foo]} then {
+                # signal the primary thread that we are ready
+                # to be canceled now (we are running).
+                thread::send %ID% [list set ::threadIdStarted [thread::id]]
+                set foo 1
+            }
+            #
+            # BUGBUG: This will not cancel because libtommath
+            #         does not check Tcl_Canceled.
+            #
+            expr {2**99999}
+        }
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread); # WARNING: Never returns (see above).
+    thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above).
+    list $res [expr {[info exists ::threadIdStarted] ? \
+                  $::threadIdStarted == $serverthread : 0}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 0 {}}
+test thread-7.19 {cancel: expr bignum -unwind} {thread drainEventQueue knownBug} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+        set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+        $i eval {
+            if {![info exists foo]} then {
+                # signal the primary thread that we are ready
+                # to be canceled now (we are running).
+                thread::send %ID% [list set ::threadIdStarted [thread::id]]
+                set foo 1
+            }
+            #
+            # BUGBUG: This will not cancel because libtommath
+            #         does not check Tcl_Canceled.
+            #
+            expr {2**99999}
+        }
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread); # WARNING: Never returns (see above).
+    thread::join $serverthread; drainEventQueue; # WARNING: Never returns (see above).
+    list $res [expr {[info exists ::threadIdStarted] ? \
+                  $::threadIdStarted == $serverthread : 0}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 0 {}}
+test thread-7.20 {cancel: subst} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    subst {[while {1} {incr x}]}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.21 {cancel: subst -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    subst {[while {1} {incr x}]}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.22 {cancel: slave interp} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    while {1} {}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.23 {cancel: slave interp -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    if {![info exists foo]} then {
+		# signal the primary thread that we are ready
+		# to be canceled now (we are running).
+		thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		set foo 1
+	    }
+	    set while while; $while {1} {}
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [thread::cancel $serverthread]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 0 {}}
+test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [thread::cancel $serverthread]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 0 {}}
+test thread-7.26 {cancel: send async cancel bad interp path} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	[string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		update
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    catch {thread::send $serverthread {interp cancel -- bad}} msg
+    thread::send -async $serverthread {interp cancel -unwind}
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list [expr {$::threadIdStarted == $serverthread}] $msg
+} {1 {could not find interpreter "bad"}}
+test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	set i [interp create -- -unwind]
+	$i eval "package require -exact Thread [package present Thread]"
+	$i eval {
+	    proc foobar {} {
+		while {1} {
+		    if {![info exists foo]} then {
+			# signal the primary thread that we are ready
+			# to be canceled now (we are running).
+			thread::send %ID% [list set ::threadIdStarted [thread::id]]
+			set foo 1
+		    }
+		    update
+		}
+	    }
+	    foobar
+	}
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::send -async $serverthread {interp cancel -- -unwind}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval canceled}}
+test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [thread::send -async $serverthread {interp cancel}]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [thread::send -async $serverthread {interp cancel}]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.30 {cancel: send async thread cancel nested catch inside pure bytecode loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.31 {cancel: send async thread cancel nested catch pure inside-command loop} {thread drainEventQueue} {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted; after 1000
+    set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
+    thread::send $serverthread $::threadSuperKillScript
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {[info exists ::threadIdStarted] ? \
+		  $::threadIdStarted == $serverthread : 0}] \
+	      [expr {[info exists ::threadId] ? \
+		  $::threadId == $serverthread : 0}] \
+	      [expr {[info exists ::threadError($serverthread)] ? \
+		  [findThreadError $::threadError($serverthread)] : ""}]
+} {{} 1 1 {eval canceled}}
+test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# No bytecode at all here...
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# No bytecode at all here...
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::cancel -unwind $serverthread]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::send -async $serverthread {interp cancel -unwind}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.35 {cancel: send async cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::send -async $serverthread {interp cancel -unwind}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.36 {cancel: send async thread cancel nested catch inside pure bytecode loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID% [thread::id]] {
+	proc foobar {} {
+	    while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		catch {
+		    while {1} {
+			catch {
+			    while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
+test thread-7.37 {cancel: send async thread cancel nested catch inside pure inside-command loop -unwind} -constraints {thread drainEventQueue} -setup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -body {
+    set serverthread [thread::create -joinable \
+	    [string map [list %ID [thread::id]] {
+	proc foobar {} {
+	    set catch catch
+	    set while while
+	    $while {1} {
+		if {![info exists foo]} then {
+		    # signal the primary thread that we are ready
+		    # to be canceled now (we are running).
+		    thread::send %ID% [list set ::threadIdStarted [thread::id]]
+		    set foo 1
+		}
+		$catch {
+		    $while {1} {
+			$catch {
+			    $while {1} {
+				# we must call update here because otherwise
+				# the thread cannot even be forced to exit.
+				update
+			    }
+			}
+		    }
+		}
+	    }
+	}
+	foobar
+    }]]
+    # wait for other thread to signal "ready to cancel"
+    vwait ::threadIdStarted
+    set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}]
+    vwait ::threadSawError($serverthread)
+    thread::join $serverthread; drainEventQueue
+    list $res [expr {$::threadIdStarted == $serverthread}] \
+              [expr {[info exists ::threadId] ? \
+                  $::threadId == $serverthread : 0}] \
+              [expr {[info exists ::threadError($serverthread)] ? \
+                  [findThreadError $::threadError($serverthread)] : ""}]
+} -cleanup {
+    unset -nocomplain ::threadSawError ::threadError ::threadId ::threadIdStarted
+} -result {{} 1 1 {eval unwound}}
 
 # cleanup
 ::tcltest::cleanupTests
diff --git a/tests/timer.test b/tests/timer.test
index 800857b..ab6efc9 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -12,31 +12,35 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: timer.test,v 1.11 2004/11/18 19:22:14 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-test timer-1.1 {Tcl_CreateTimerHandler procedure} {
+test timer-1.1 {Tcl_CreateTimerHandler procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x ""
     foreach i {100 200 1000 50 150} {
 	after $i lappend x $i
     }
     after 200 set done 1
     vwait done
-    set x
-} {50 100 150 200}
+    return $x
+} -cleanup {
+    foreach i [after info] {
+	after cancel $i
+    }
+} -result {50 100 150 200}
 
-test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
+test timer-2.1 {Tcl_DeleteTimerHandler procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x ""
     foreach i {100 200 1000 50 150} {
 	after $i lappend x $i
@@ -45,8 +49,8 @@ test timer-2.1 {Tcl_DeleteTimerHandler procedure} {
     after cancel lappend x 50
     after 200 set done 1
     vwait done
-    set x
-} {100 200}
+    return $x
+} -result {100 200}
 
 # No tests for Tcl_ServiceTimer or ResetTimer, since it is already tested
 # above.
@@ -60,10 +64,11 @@ test timer-3.1 {TimerHandlerEventProc procedure: event masks} {
     update
     lappend result $x
 } {start fired}
-test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
+test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     foreach i {200 600 1000} {
 	after $i lappend x $i
     }
@@ -78,45 +83,49 @@ test timer-3.2 {TimerHandlerEventProc procedure: multiple timers} {
     after 400
     update
     lappend result $x
-} {200 {200 600} {200 600 1000}}
-test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} {
+} -result {200 {200 600} {200 600 1000}}
+test timer-3.3 {TimerHandlerEventProc procedure: reentrant timer deletion} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x {}
     after 100 lappend x 100
     set i [after 300 lappend x 300]
     after 200 after cancel $i
     after 400
     update
-    set x
-} 100
-test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} {
+    return $x
+} -result 100
+test timer-3.4 {TimerHandlerEventProc procedure: all expired timers fire} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x {}
     after 100 lappend x a
     after 200 lappend x b
     after 300 lappend x c
     after 300
     vwait x
-    set x
-} {a b c}
-test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
+    return $x
+} -result {a b c}
+test timer-3.5 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x {}
     after 100 {lappend x a; after 0 lappend x b}
     after 100
     vwait x
-    set x
-} a
-test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} {
+    return $x
+} -result a
+test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't fire} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x {}
     after 100 {lappend x a; after 100 lappend x b; after 100}
     after 100
@@ -124,15 +133,16 @@ test timer-3.6 {TimerHandlerEventProc procedure: reentrantly added timers don't
     set result $x
     vwait x
     lappend result $x
-} {a {a b}}
+} -result {a {a b}}
 
 # No tests for Tcl_DoWhenIdle:  it's already tested by other tests
 # below.
 
-test timer-4.1 {Tcl_CancelIdleCall procedure} {
+test timer-4.1 {Tcl_CancelIdleCall procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     set y before
     set z before
@@ -141,12 +151,13 @@ test timer-4.1 {Tcl_CancelIdleCall procedure} {
     after idle set z after3
     after cancel set y after2
     update idletasks
-    concat $x $y $z
-} {after1 before after3}
-test timer-4.2 {Tcl_CancelIdleCall procedure} {
+    list $x $y $z
+} -result {after1 before after3}
+test timer-4.2 {Tcl_CancelIdleCall procedure} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     set y before
     set z before
@@ -155,13 +166,14 @@ test timer-4.2 {Tcl_CancelIdleCall procedure} {
     after idle set z after3
     after cancel set x after1
     update idletasks
-    concat $x $y $z
-} {before after2 after3}
+    list $x $y $z
+} -result {before after2 after3}
 
-test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
+test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x 1
     set y 23
     after idle {incr x; after idle {incr x; after idle {incr x}}}
@@ -170,17 +182,17 @@ test timer-5.1 {Tcl_ServiceIdle, self-rescheduling handlers} {
     set result "$x $y"
     update idletasks
     lappend result $x
-} {2 24 4}
+} -result {2 24 4}
 
-test timer-6.1 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after} msg] $msg
-} {1 {wrong # args: should be "after option ?arg arg ...?"}}
-test timer-6.2 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after 2x} msg] $msg
-} {1 {expected integer but got "2x"}}
-test timer-6.3 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after gorp} msg] $msg
-} {1 {bad argument "gorp": must be cancel, idle, info, or a number}}
+test timer-6.1 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+    after
+} -result {wrong # args: should be "after option ?arg ...?"}
+test timer-6.2 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+    after 2x
+} -result {bad argument "2x": must be cancel, idle, info, or an integer}
+test timer-6.3 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+    after gorp
+} -result {bad argument "gorp": must be cancel, idle, info, or an integer}
 test timer-6.4 {Tcl_AfterCmd procedure, ms argument} {
     set x before
     after 400 {set x after}
@@ -201,41 +213,44 @@ test timer-6.5 {Tcl_AfterCmd procedure, ms argument} {
     update
     list $y $x
 } {before after}
-test timer-6.6 {Tcl_AfterCmd procedure, cancel option} {
-    list [catch {after cancel} msg] $msg
-} {1 {wrong # args: should be "after cancel id|command"}}
+test timer-6.6 {Tcl_AfterCmd procedure, cancel option} -body {
+    after cancel
+} -returnCodes error -result {wrong # args: should be "after cancel id|command"}
 test timer-6.7 {Tcl_AfterCmd procedure, cancel option} {
     after cancel after#1
 } {}
 test timer-6.8 {Tcl_AfterCmd procedure, cancel option} {
     after cancel {foo bar}
 } {}
-test timer-6.9 {Tcl_AfterCmd procedure, cancel option} {
+test timer-6.9 {Tcl_AfterCmd procedure, cancel option} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     set y [after 100 set x after]
     after cancel $y
     after 200
     update
-    set x
-} {before}
-test timer-6.10 {Tcl_AfterCmd procedure, cancel option} {
+    return $x
+} -result {before}
+test timer-6.10 {Tcl_AfterCmd procedure, cancel option} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     after 100 set x after
     after cancel {set x after}
     after 200
     update
-    set x
-} {before}
-test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
+    return $x
+} -result {before}
+test timer-6.11 {Tcl_AfterCmd procedure, cancel option} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x before
     after 100 set x after
     set id [after 300 set x after]
@@ -247,11 +262,12 @@ test timer-6.11 {Tcl_AfterCmd procedure, cancel option} {
     after 200
     update
     list $y $x
-} {after cleared}
-test timer-6.12 {Tcl_AfterCmd procedure, cancel option} {
+} -result {after cleared}
+test timer-6.12 {Tcl_AfterCmd procedure, cancel option} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x first
     after idle lappend x second
     after idle lappend x third
@@ -259,12 +275,13 @@ test timer-6.12 {Tcl_AfterCmd procedure, cancel option} {
     after cancel {lappend x second}
     after cancel $i
     update idletasks
-    set x
-} {first third}
-test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} {
+    return $x
+} -result {first third}
+test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for command} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x first
     after idle lappend x second
     after idle lappend x third
@@ -272,12 +289,13 @@ test timer-6.13 {Tcl_AfterCmd procedure, cancel option, multiple arguments for c
     after cancel lappend x second
     after cancel $i
     update idletasks
-    set x
-} {first third}
-test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} {
+    return $x
+} -result {first third}
+test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, used to dump core} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set id [
 	after 100 {
 	    set x done
@@ -285,11 +303,12 @@ test timer-6.14 {Tcl_AfterCmd procedure, cancel option, cancel during handler, u
 	}
     ]
     vwait x
-} {}
-test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {
+} -result {}
+test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     interp create x
     x eval {set a before; set b before; after idle {set a a-after};
 	    after idle {set b b-after}}
@@ -301,12 +320,12 @@ test timer-6.15 {Tcl_AfterCmd procedure, cancel option, multiple interps} {
     x eval {after cancel set a a-after}
     update idletasks
     lappend result $a $b [x eval {list $a $b}]
+} -cleanup {
     interp delete x
-    set result
-} {2 0 aaa bbb {before b-after}}
-test timer-6.16 {Tcl_AfterCmd procedure, idle option} {
-    list [catch {after idle} msg] $msg
-} {1 {wrong # args: should be "after idle script script ..."}}
+} -result {2 0 aaa bbb {before b-after}}
+test timer-6.16 {Tcl_AfterCmd procedure, idle option} -body {
+    after idle
+} -returnCodes error -result {wrong # args: should be "after idle script ?script ...?"}
 test timer-6.17 {Tcl_AfterCmd procedure, idle option} {
     set x before
     after idle {set x after}
@@ -321,6 +340,7 @@ test timer-6.18 {Tcl_AfterCmd procedure, idle option} {
     update idletasks
     list $y $x
 } {before after}
+
 set event1 [after idle event 1]
 set event2 [after 1000 event 2]
 interp create x
@@ -328,120 +348,125 @@ set childEvent [x eval {after idle event in child}]
 test timer-6.19 {Tcl_AfterCmd, info option} {
     lsort [after info]
 } [lsort "$event1 $event2"]
-test timer-6.20 {Tcl_AfterCmd, info option} {
-    list [catch {after info a b} msg] $msg
-} {1 {wrong # args: should be "after info ?id?"}}
-test timer-6.21 {Tcl_AfterCmd, info option} {
-    list [catch {after info $childEvent} msg] $msg
-} "1 {event \"$childEvent\" doesn't exist}"
+test timer-6.20 {Tcl_AfterCmd, info option} -returnCodes error -body {
+    after info a b
+} -result {wrong # args: should be "after info ?id?"}
+test timer-6.21 {Tcl_AfterCmd, info option} -returnCodes error -body {
+    after info $childEvent
+} -result "event \"$childEvent\" doesn't exist"
 test timer-6.22 {Tcl_AfterCmd, info option} {
     list [after info $event1] [after info $event2]
 } {{{event 1} idle} {{event 2} timer}}
-
 after cancel $event1
 after cancel $event2
 interp delete x
 
-test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NULL} {
+test timer-6.23 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after 1 "set x ab\0cd"
     after 10
     update
     string length $x
-} {5}
-test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NULL} {
+} -result {5}
+test timer-6.24 {Tcl_AfterCmd procedure, no option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after 1 set x ab\0cd
     after 10
     update
     string length $x
-} {5}
-test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
+} -result {5}
+test timer-6.25 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after 1 set x ab\0cd
     after cancel "set x ab\0ef"
-    set x [llength [after info]]
+    llength [after info]
+} -cleanup {
     foreach i [after info] {
 	after cancel $i
     }
-    set x
-} {1}
-test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NULL} {
+} -result {1}
+test timer-6.26 {Tcl_AfterCmd procedure, cancel option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after 1 set x ab\0cd
     after cancel set x ab\0ef
-    set y [llength [after info]]
+    llength [after info]
+} -cleanup {
     foreach i [after info] {
 	after cancel $i
     }
-    set y
-} {1}
-test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NULL} {
+} -result {1}
+test timer-6.27 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after idle "set x ab\0cd"
     update
     string length $x
-} {5}
-test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NULL} {
+} -result {5}
+test timer-6.28 {Tcl_AfterCmd procedure, idle option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     after idle set x ab\0cd
     update
     string length $x
-} {5}
-test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NULL} {
+} -result {5}
+test timer-6.29 {Tcl_AfterCmd procedure, info option, script with NUL} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     set x "hello world"
     set id junk
     set id [after 10 set x ab\0cd]
     update
-    set y [string length [lindex [lindex [after info $id] 0] 2]]
+    string length [lindex [lindex [after info $id] 0] 2]
+} -cleanup {
     foreach i [after info] {
 	after cancel $i
     }
-    set y
-} {5}
+} -result 5
 
 set event [after idle foo bar]
-scan $event after#%d id
-
-test timer-7.1 {GetAfterEvent procedure} {
-    list [catch {after info xfter#$id} msg] $msg
-} "1 {event \"xfter#$id\" doesn't exist}"
-test timer-7.2 {GetAfterEvent procedure} {
-    list [catch {after info afterx$id} msg] $msg
-} "1 {event \"afterx$id\" doesn't exist}"
-test timer-7.3 {GetAfterEvent procedure} {
-    list [catch {after info after#ab} msg] $msg
-} {1 {event "after#ab" doesn't exist}}
-test timer-7.4 {GetAfterEvent procedure} {
-    list [catch {after info after#} msg] $msg
-} {1 {event "after#" doesn't exist}}
-test timer-7.5 {GetAfterEvent procedure} {
-    list [catch {after info after#${id}x} msg] $msg
-} "1 {event \"after#${id}x\" doesn't exist}"
-test timer-7.6 {GetAfterEvent procedure} {
-    list [catch {after info afterx[expr $id+1]} msg] $msg
-} "1 {event \"afterx[expr $id+1]\" doesn't exist}"
+scan $event after#%d lastId
+test timer-7.1 {GetAfterEvent procedure} -returnCodes error -body {
+    after info xfter#$lastId
+} -result "event \"xfter#$lastId\" doesn't exist"
+test timer-7.2 {GetAfterEvent procedure} -returnCodes error -body {
+    after info afterx$lastId
+} -result "event \"afterx$lastId\" doesn't exist"
+test timer-7.3 {GetAfterEvent procedure} -returnCodes error -body {
+    after info after#ab
+} -result {event "after#ab" doesn't exist}
+test timer-7.4 {GetAfterEvent procedure} -returnCodes error -body {
+    after info after#
+} -result {event "after#" doesn't exist}
+test timer-7.5 {GetAfterEvent procedure} -returnCodes error -body {
+    after info after#${lastId}x
+} -result "event \"after#${lastId}x\" doesn't exist"
+test timer-7.6 {GetAfterEvent procedure} -returnCodes error -body {
+    after info afterx[expr {$lastId+1}]
+} -result "event \"afterx[expr {$lastId+1}]\" doesn't exist"
 after cancel $event
 
 test timer-8.1 {AfterProc procedure} {
@@ -474,10 +499,11 @@ test timer-8.2 {AfterProc procedure} -setup {
     while executing
 "error "After error""
     ("after" script)}}}
-test timer-8.3 {AfterProc procedure, deleting handler from itself} {
+test timer-8.3 {AfterProc procedure, deleting handler from itself} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     proc foo {} {
 	global x
 	set x {}
@@ -489,12 +515,13 @@ test timer-8.3 {AfterProc procedure, deleting handler from itself} {
     after idle foo
     after 1000 {error "I shouldn't ever have executed"}
     update idletasks
-    set x
-} {{{error "I shouldn't ever have executed"} timer}}
-test timer-8.4 {AfterProc procedure, deleting handler from itself} {
+    return $x
+} -result {{{error "I shouldn't ever have executed"} timer}}
+test timer-8.4 {AfterProc procedure, deleting handler from itself} -setup {
     foreach i [after info] {
 	after cancel $i
     }
+} -body {
     proc foo {} {
 	global x
 	set x {}
@@ -506,8 +533,8 @@ test timer-8.4 {AfterProc procedure, deleting handler from itself} {
     after 1000 {error "I shouldn't ever have executed"}
     after idle foo
     update idletasks
-    set x
-} {{{error "I shouldn't ever have executed"} timer}}
+    return $x
+} -result {{{error "I shouldn't ever have executed"} timer}}
 
 foreach i [after info] {
     after cancel $i
@@ -515,9 +542,9 @@ foreach i [after info] {
 
 # No test for FreeAfterPtr, since it is already tested above.
 
-
-test timer-9.1 {AfterCleanupProc procedure} {
+test timer-9.1 {AfterCleanupProc procedure} -setup {
     catch {interp delete x}
+} -body {
     interp create x
     x eval {after 200 {
 	lappend x after
@@ -537,8 +564,8 @@ test timer-9.1 {AfterCleanupProc procedure} {
     set x before
     after 300
     update
-    set x
-} {before after2 after4}
+    return $x
+} -result {before after2 after4}
 
 test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
     interp create slave
@@ -552,6 +579,27 @@ test timer-10.1 {Bug 1016167: [after] overwrites imports} -setup {
     interp delete slave
 } -result ::after
 
+test timer-11.1 {Bug 1350291: [after] overflowing 32-bit field} -body {
+    set b ok
+    set a [after 0x100000001 {set b "after fired early"}]
+    after 100 set done 1
+    vwait done
+    return $b
+} -cleanup {
+    catch {after cancel $a}
+} -result ok
+test timer-11.2 {Bug 1350293: [after] negative argument} -body {
+    set l {}
+    after 100 {lappend l 100; set done 1}
+    after -1 {lappend l -1}
+    vwait done
+    return $l
+} -result {-1 100}
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/tm.test b/tests/tm.test
index 9f5a83a..1b22f8c 100644
--- a/tests/tm.test
+++ b/tests/tm.test
@@ -5,8 +5,6 @@
 #
 # Copyright (c) 2004 by Donal K. Fellows.
 # All rights reserved.
-#
-# RCS: @(#) $Id: tm.test,v 1.5 2004/11/05 09:21:46 dkf Exp $
 
 package require Tcl 8.5
 if {"::tcltest" ni [namespace children]} {
@@ -21,12 +19,12 @@ test tm-1.1 {tm: path command exists} {
 test tm-1.2 {tm: path command syntax} -returnCodes error -body {
     ::tcl::tm::path foo
 } -result {unknown or ambiguous subcommand "foo": must be add, list, or remove}
-test tm-1.3 {tm: path command syntax} -returnCodes error -body {
+test tm-1.3 {tm: path command syntax} {
     ::tcl::tm::path add
-} -result "wrong # args: should be \"::tcl::tm::path add path ...\""
-test tm-1.4 {tm: path command syntax} -returnCodes error -body {
+} {}
+test tm-1.4 {tm: path command syntax} {
     ::tcl::tm::path remove
-} -result "wrong # args: should be \"::tcl::tm::path remove path ...\""
+} {}
 test tm-1.5 {tm: path command syntax} -returnCodes error -body {
     ::tcl::tm::path list foobar
 } -result "wrong # args: should be \"::tcl::tm::path list\""
@@ -202,10 +200,10 @@ test tm-3.11 {tm: module path management, remove ignores unknown path} -setup {
 proc genpaths {base} {
     # Normalizing picks up drive letters on windows [Bug 1053568]
     set base [file normalize $base]
-    foreach {major minor} [split [info tclversion] .] break
+    lassign [split [package present Tcl] .] major minor 
     set results {}
-    lappend results [file join $base site-tcl]
     set base [file join $base tcl$major]
+    lappend results [file join $base site-tcl]
     for {set i 0} {$i <= $minor} {incr i} {
 	lappend results [file join $base ${major}.$i]
     }
diff --git a/tests/trace.test b/tests/trace.test
index 6b78fed..d830f3c 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -10,27 +10,35 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: trace.test,v 1.40 2005/07/26 16:24:35 dgp Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
+package require tcltest
+namespace import ::tcltest::*
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testcmdtrace [llength [info commands testcmdtrace]]
+testConstraint testevalobjv [llength [info commands testevalobjv]]
+
+# Used for constraining memory leak tests
+testConstraint memory [llength [info commands memory]]
+
+proc getbytes {} {
+    set lines [split [memory info] "\n"]
+    lindex [lindex $lines 3] 3
+}
 
 proc traceScalar {name1 name2 op} {
     global info
-    set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
+    set info [list $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg]
 }
 proc traceScalarAppend {name1 name2 op} {
     global info
-    lappend info $name1 $name2 $op [catch {uplevel set $name1} msg] $msg
+    lappend info $name1 $name2 $op [catch {uplevel 1 set $name1} msg] $msg
 }
 proc traceArray {name1 name2 op} {
     global info
-    set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg]
+    set info [list $name1 $name2 $op [catch {uplevel 1 set [set name1]($name2)} msg] $msg]
 }
 proc traceArray2 {name1 name2 op} {
     global info
@@ -52,7 +60,7 @@ proc traceCheck {cmd args} {
     set info [list [catch $cmd msg] $msg]
 }
 proc traceCrtElement {value name1 name2 op} {
-    uplevel set ${name1}($name2) $value
+    uplevel 1 set ${name1}($name2) $value
 }
 proc traceCommand {oldName newName op} {
     global info
@@ -62,10 +70,10 @@ proc traceCommand {oldName newName op} {
 test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
     # You may need Purify or Electric Fence to reliably
     # see this one fail.
-    catch {unset z}
+    unset -nocomplain z
     trace add variable z array {set z(foo) 1 ;#}
     set res "names: [array names z]"
-    catch {unset ::z}
+    unset -nocomplain ::z
     trace variable ::z w {unset ::z; error "memory corruption";#}
     list [catch {set ::z 1} msg] $msg
 } {1 {can't set "::z": memory corruption}}
@@ -73,40 +81,40 @@ test trace-0.0 {memory corruption in trace (Tcl Bug 484339)} {
 # Read-tracing on variables
 
 test trace-1.1 {trace variable reads} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read traceScalar
     list [catch {set x} msg] $msg $info
 } {1 {can't read "x": no such variable} {x {} read 1 {can't read "x": no such variable}}}
 test trace-1.2 {trace variable reads} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     set info {}
     trace add variable x read traceScalar
     list [catch {set x} msg] $msg $info
 } {0 123 {x {} read 0 123}}
 test trace-1.3 {trace variable reads} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read traceScalar
     set x 123
     set info
 } {}
 test trace-1.4 {trace array element reads} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(2) read traceArray
     list [catch {set x(2)} msg] $msg $info
 } {1 {can't read "x(2)": no such element in array} {x 2 read 1 {can't read "x(2)": no such element in array}}}
 test trace-1.5 {trace array element reads} {
-    catch {unset x}
+    unset -nocomplain x
     set x(2) zzz
     set info {}
     trace add variable x(2) read traceArray
     list [catch {set x(2)} msg] $msg $info
 } {0 zzz {x 2 read 0 zzz}}
 test trace-1.6 {trace array element reads} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read traceArray2
     proc p {} {
@@ -117,7 +125,7 @@ test trace-1.6 {trace array element reads} {
     list [catch {p} msg] $msg $info
 } {0 willi {x 2 read}}
 test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read q
     proc q {name1 name2 op} {
@@ -134,20 +142,20 @@ test trace-1.7 {trace array element reads, create element undefined if nonexista
     list [catch {p} msg] $msg $info
 } {0 wolf {x Y read}}
 test trace-1.8 {trace reads on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read traceArray
     list [catch {set x(2)} msg] $msg $info
 } {1 {can't read "x(2)": no such variable} {}}
 test trace-1.9 {trace reads on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set x(2) zzz
     set info {}
     trace add variable x read traceArray
     list [catch {set x(2)} msg] $msg $info
 } {0 zzz {x 2 read 0 zzz}}
 test trace-1.10 {trace variable reads} {
-    catch {unset x}
+    unset -nocomplain x
     set x 444
     set info {}
     trace add variable x read traceScalar
@@ -155,28 +163,28 @@ test trace-1.10 {trace variable reads} {
     set info
 } {}
 test trace-1.11 {read traces that modify the array structure} {
-    catch {unset x}
+    unset -nocomplain x
     set x(bar) 0 
     trace variable x r {set x(foo) 1 ;#} 
     trace variable x r {unset -nocomplain x(bar) ;#} 
     array get x
 } {}
 test trace-1.12 {read traces that modify the array structure} {
-    catch {unset x}
+    unset -nocomplain x
     set x(bar) 0 
     trace variable x r {unset -nocomplain x(bar) ;#} 
     trace variable x r {set x(foo) 1 ;#} 
     array get x
 } {}
 test trace-1.13 {read traces that modify the array structure} {
-    catch {unset x}
+    unset -nocomplain x
     set x(bar) 0 
     trace variable x r {set x(foo) 1 ;#} 
     trace variable x r {unset -nocomplain x;#} 
     list [catch {array get x} res] $res
 } {1 {can't read "x(bar)": no such variable}}
 test trace-1.14 {read traces that modify the array structure} {
-    catch {unset x}
+    unset -nocomplain x
     set x(bar) 0 
     trace variable x r {unset -nocomplain x;#} 
     trace variable x r {set x(foo) 1 ;#} 
@@ -186,28 +194,28 @@ test trace-1.14 {read traces that modify the array structure} {
 # Basic write-tracing on variables
 
 test trace-2.1 {trace variable writes} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceScalar
     set x 123
     set info
 } {x {} write 0 123}
 test trace-2.2 {trace writes to array elements} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(33) write traceArray
     set x(33) 444
     set info
 } {x 33 write 0 444}
 test trace-2.3 {trace writes on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceArray
     set x(abc) qq
     set info
 } {x abc write 0 qq}
 test trace-2.4 {trace variable writes} {
-    catch {unset x}
+    unset -nocomplain x
     set x 1234
     set info {}
     trace add variable x write traceScalar
@@ -215,13 +223,41 @@ test trace-2.4 {trace variable writes} {
     set info
 } {}
 test trace-2.5 {trace variable writes} {
-    catch {unset x}
+    unset -nocomplain x
     set x 1234
     set info {}
     trace add variable x write traceScalar
     unset x
     set info
 } {}
+test trace-2.6 {trace variable writes on compiled local} {
+    #
+    # Check correct function of whole array traces on compiled local
+    # arrays [Bug 1770591]. The corresponding function for read traces is
+    # already indirectly tested in trace-1.7
+    #
+    unset -nocomplain x
+    set info {}
+    proc p {} {
+	trace add variable x write traceArray
+	set x(X) willy
+    }
+    p
+    set info
+} {x X write 0 willy}
+test trace-2.7 {trace variable writes on errorInfo} -body {
+   #
+   # Check correct behaviour of write traces on errorInfo.
+   # [Bug 1773040]
+   trace add variable ::errorInfo write traceScalar
+   catch {set dne}
+   lrange [set info] 0 2
+} -cleanup {
+   # always remove trace on errorInfo otherwise further tests will fail
+   unset ::errorInfo
+} -result {::errorInfo {} write}
+
+
 
 # append no longer triggers read traces when fetching the old values of
 # variables before doing the append operation. However, lappend _does_
@@ -229,7 +265,7 @@ test trace-2.5 {trace variable writes} {
 # trace: after appending all arguments to the list.
 
 test trace-3.1 {trace variable read-modify-writes} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read traceScalarAppend
     append x 123
@@ -238,7 +274,7 @@ test trace-3.1 {trace variable read-modify-writes} {
     set info
 } {x {} read 0 123456}
 test trace-3.2 {trace variable read-modify-writes} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x {read write} traceScalarAppend
     append x 123
@@ -249,14 +285,14 @@ test trace-3.2 {trace variable read-modify-writes} {
 # Basic unset-tracing on variables
 
 test trace-4.1 {trace variable unsets} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x unset traceScalar
-    catch {unset x}
+    unset -nocomplain x
     set info
 } {x {} unset 1 {can't read "x": no such variable}}
 test trace-4.2 {variable mustn't exist during unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x 1234
     set info {}
     trace add variable x unset traceScalar
@@ -264,7 +300,7 @@ test trace-4.2 {variable mustn't exist during unset trace} {
     set info
 } {x {} unset 1 {can't read "x": no such variable}}
 test trace-4.3 {unset traces mustn't be called during reads and writes} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x unset traceScalar
     set x 44
@@ -272,15 +308,15 @@ test trace-4.3 {unset traces mustn't be called during reads and writes} {
     set info
 } {}
 test trace-4.4 {trace unsets on array elements} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 18
     set info {}
     trace add variable x(1) unset traceArray
-    catch {unset x(1)}
+    unset -nocomplain x(1)
     set info
 } {x 1 unset 1 {can't read "x(1)": no such element in array}}
 test trace-4.5 {trace unsets on array elements} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set info {}
     trace add variable x(1) unset traceArray
@@ -288,7 +324,7 @@ test trace-4.5 {trace unsets on array elements} {
     set info
 } {x 1 unset 1 {can't read "x(1)": no such element in array}}
 test trace-4.6 {trace unsets on array elements} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set info {}
     trace add variable x(1) unset traceArray
@@ -296,15 +332,15 @@ test trace-4.6 {trace unsets on array elements} {
     set info
 } {x 1 unset 1 {can't read "x(1)": no such variable}}
 test trace-4.7 {trace unsets on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set info {}
     trace add variable x unset traceProc
-    catch {unset x(0)}
+    unset -nocomplain x(0)
     set info
 } {}
 test trace-4.8 {trace unsets on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set x(2) 144
     set x(3) 14
@@ -314,7 +350,7 @@ test trace-4.8 {trace unsets on whole arrays} {
     set info
 } {x 1 unset}
 test trace-4.9 {trace unsets on whole arrays} {
-    catch {unset x}
+    unset -nocomplain x
     set x(1) 18
     set x(2) 144
     set x(3) 14
@@ -326,7 +362,7 @@ test trace-4.9 {trace unsets on whole arrays} {
 
 # Array tracing on variables
 test trace-5.1 {array traces fire on accesses via [array]} {
-    catch {unset x}
+    unset -nocomplain x
     set x(b) 2
     trace add variable x array traceArray2
     set ::info {}
@@ -334,7 +370,7 @@ test trace-5.1 {array traces fire on accesses via [array]} {
     set ::info
 } {x {} array}
 test trace-5.2 {array traces do not fire on normal accesses} {
-    catch {unset x}
+    unset -nocomplain x
     set x(b) 2
     trace add variable x array traceArray2
     set ::info {}
@@ -343,7 +379,7 @@ test trace-5.2 {array traces do not fire on normal accesses} {
     set ::info
 } {}
 test trace-5.3 {array traces do not outlive variable} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x array traceArray2
     set ::info {}
     set x(a) 1
@@ -352,19 +388,19 @@ test trace-5.3 {array traces do not outlive variable} {
     set ::info
 } {}
 test trace-5.4 {array traces properly listed in trace information} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x array traceArray2
     set result [trace info variable x]
     set result
 } [list [list array traceArray2]]
 test trace-5.5 {array traces properly listed in trace information} {
-    catch {unset x}
+    unset -nocomplain x
     trace variable x a traceArray2
     set result [trace vinfo x]
     set result
 } [list [list a traceArray2]]
 test trace-5.6 {array traces don't fire on scalar variables} {
-    catch {unset x}
+    unset -nocomplain x
     set x foo
     trace add variable x array traceArray2
     set ::info {}
@@ -372,14 +408,14 @@ test trace-5.6 {array traces don't fire on scalar variables} {
     set ::info
 } {}
 test trace-5.7 {array traces fire for undefined variables} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x array traceArray2
     set ::info {}
     array set x {a 1}
     set ::info
 } {x {} array}
 test trace-5.8 {array traces fire for undefined variables} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x array {set x(foo) 1 ;#}
     set res "names: [array names x]"
 } {names: foo}
@@ -387,7 +423,7 @@ test trace-5.8 {array traces fire for undefined variables} {
 # Trace multiple trace types at once.
 
 test trace-6.1 {multiple ops traced at once} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x {read write unset} traceProc
     catch {set x}
@@ -398,7 +434,7 @@ test trace-6.1 {multiple ops traced at once} {
     set info
 } {x {} read x {} write x {} read x {} write x {} unset}
 test trace-6.2 {multiple ops traced on array element} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(0) {read write unset} traceProc
     catch {set x(0)}
@@ -410,7 +446,7 @@ test trace-6.2 {multiple ops traced on array element} {
     set info
 } {x 0 read x 0 write x 0 read x 0 write x 0 unset}
 test trace-6.3 {multiple ops traced on whole array} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x {read write unset} traceProc
     catch {set x(0)}
@@ -425,7 +461,7 @@ test trace-6.3 {multiple ops traced on whole array} {
 # Check order of invocation of traces
 
 test trace-7.1 {order of invocation of traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x read "traceTag 1"
     trace add variable x read "traceTag 2"
@@ -436,7 +472,7 @@ test trace-7.1 {order of invocation of traces} {
     set info
 } {3 2 1 3 2 1}
 test trace-7.2 {order of invocation of traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 44
     set info {}
     trace add variable x(0) read "traceTag 1"
@@ -446,7 +482,7 @@ test trace-7.2 {order of invocation of traces} {
     set info
 } {3 2 1}
 test trace-7.3 {order of invocation of traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 44
     set info {}
     trace add variable x(0) read "traceTag 1"
@@ -462,7 +498,7 @@ test trace-7.3 {order of invocation of traces} {
 # Check effects of errors in trace procedures
 
 test trace-8.1 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     set info {}
     trace add variable x read "traceTag 1"
@@ -470,7 +506,7 @@ test trace-8.1 {error returns from traces} {
     list [catch {set x} msg] $msg $info
 } {1 {can't read "x": trace returned error} {}}
 test trace-8.2 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     set info {}
     trace add variable x write "traceTag 1"
@@ -478,14 +514,14 @@ test trace-8.2 {error returns from traces} {
     list [catch {set x 44} msg] $msg $info
 } {1 {can't set "x": trace returned error} {}}
 test trace-8.3 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     set info {}
     trace add variable x write traceError
     list [catch {append x 44} msg] $msg $info
 } {1 {can't set "x": trace returned error} {}}
 test trace-8.4 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     set info {}
     trace add variable x unset "traceTag 1"
@@ -493,7 +529,7 @@ test trace-8.4 {error returns from traces} {
     list [catch {unset x} msg] $msg $info
 } {0 {} 1}
 test trace-8.5 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 123
     set info {}
     trace add variable x(0) read "traceTag 1"
@@ -503,7 +539,7 @@ test trace-8.5 {error returns from traces} {
     list [catch {set x(0)} msg] $msg $info
 } {1 {can't read "x(0)": trace returned error} 3}
 test trace-8.6 {error returns from traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     trace add variable x unset traceError
     list [catch {unset x} msg] $msg
@@ -512,7 +548,7 @@ test trace-8.7 {error returns from traces} {
     # This test just makes sure that the memory for the error message
     # gets deallocated correctly when the trace is invoked again or
     # when the trace is deleted.
-    catch {unset x}
+    unset -nocomplain x
     set x 123
     trace add variable x read traceError
     catch {set x}
@@ -533,7 +569,7 @@ test trace-8.8 {error returns from traces} {
 	trace add    variable ::x write [list foo $::x]
 	error "foo"
     }
-    catch {unset ::x ::y}
+    unset -nocomplain ::x ::y
     set x junk
     trace add variable ::x write [list foo $x]
     for {set y 0} {$y<100} {incr y} {
@@ -547,31 +583,31 @@ test trace-8.8 {error returns from traces} {
 # a new copy of the variables.
 
 test trace-9.1 {be sure variable is unset before trace is called} {
-    catch {unset x}
+    unset -nocomplain x
     set x 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel set x}}
+    trace add variable x unset {traceCheck {uplevel 1 set x}}
     unset x
     set info
 } {1 {can't read "x": no such variable}}
 test trace-9.2 {be sure variable is unset before trace is called} {
-    catch {unset x}
+    unset -nocomplain x
     set x 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel set x 22}}
+    trace add variable x unset {traceCheck {uplevel 1 set x 22}}
     unset x
     concat $info [list [catch {set x} msg] $msg]
 } {0 22 0 22}
 test trace-9.3 {be sure traces are cleared before unset trace called} {
-    catch {unset x}
+    unset -nocomplain x
     set x 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel trace info variable x}}
+    trace add variable x unset {traceCheck {uplevel 1 trace info variable x}}
     unset x
     set info
 } {0 {}}
 test trace-9.4 {set new trace during unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x 33
     set info {}
     trace add variable x unset {traceCheck {global x; trace add variable x unset traceProc}}
@@ -580,23 +616,23 @@ test trace-9.4 {set new trace during unset trace} {
 } {0 {} {unset traceProc}}
 
 test trace-10.1 {make sure array elements are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
-    trace add variable x(0) unset {traceCheck {uplevel set x(0)}}
+    trace add variable x(0) unset {traceCheck {uplevel 1 set x(0)}}
     unset x(0)
     set info
 } {1 {can't read "x(0)": no such element in array}}
 test trace-10.2 {make sure array elements are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
-    trace add variable x(0) unset {traceCheck {uplevel set x(0) zzz}}
+    trace add variable x(0) unset {traceCheck {uplevel 1 set x(0) zzz}}
     unset x(0)
     concat $info [list [catch {set x(0)} msg] $msg]
 } {0 zzz 0 zzz}
 test trace-10.3 {array elements are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
     trace add variable x(0) unset {traceCheck {global x; trace info variable x(0)}}
@@ -604,49 +640,49 @@ test trace-10.3 {array elements are unset before traces are called} {
     set info
 } {0 {}}
 test trace-10.4 {set new array element trace during unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
-    trace add variable x(0) unset {traceCheck {uplevel {trace add variable x(0) read {}}}}
-    catch {unset x(0)}
+    trace add variable x(0) unset {traceCheck {uplevel 1 {trace add variable x(0) read {}}}}
+    unset -nocomplain x(0)
     concat $info [trace info variable x(0)]
 } {0 {} {read {}}}
 
 test trace-11.1 {make sure arrays are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(0) 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel set x(0)}}
+    trace add variable x unset {traceCheck {uplevel 1 set x(0)}}
     unset x
     set info
 } {1 {can't read "x(0)": no such variable}}
 test trace-11.2 {make sure arrays are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel set x(y) 22}}
+    trace add variable x unset {traceCheck {uplevel 1 set x(y) 22}}
     unset x
     concat $info [list [catch {set x(y)} msg] $msg]
 } {0 22 0 22}
 test trace-11.3 {make sure arrays are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
-    trace add variable x unset {traceCheck {uplevel array exists x}}
+    trace add variable x unset {traceCheck {uplevel 1 array exists x}}
     unset x
     set info
 } {0 0}
 test trace-11.4 {make sure arrays are unset before traces are called} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
-    set cmd {traceCheck {uplevel {trace info variable x}}}
+    set cmd {traceCheck {uplevel 1 {trace info variable x}}}
     trace add variable x unset $cmd
     unset x
     set info
 } {0 {}}
 test trace-11.5 {set new array trace during unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
     trace add variable x unset {traceCheck {global x; trace add variable x read {}}}
@@ -654,7 +690,7 @@ test trace-11.5 {set new array trace during unset trace} {
     concat $info [trace info variable x]
 } {0 {} {read {}}}
 test trace-11.6 {create scalar during array unset trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x(y) 33
     set info {}
     trace add variable x unset {traceCheck {global x; set x 44}}
@@ -665,57 +701,57 @@ test trace-11.6 {create scalar during array unset trace} {
 # Check special conditions (e.g. errors) in Tcl_TraceVar2.
 
 test trace-12.1 {creating array when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(0) write traceProc
     list [catch {set x 22} msg] $msg
 } {1 {can't set "x": variable is array}}
 test trace-12.2 {creating array when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(0) write traceProc
     list [catch {set x(0)} msg] $msg
 } {1 {can't read "x(0)": no such element in array}}
 test trace-12.3 {creating array when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x(0) write traceProc
     set x(0) 22
     set info
 } {x 0 write}
 test trace-12.4 {creating variable when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceProc
     list [catch {set x} msg] $msg
 } {1 {can't read "x": no such variable}}
 test trace-12.5 {creating variable when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceProc
     set x 22
     set info
 } {x {} write}
 test trace-12.6 {creating variable when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceProc
     set x(0) 22
     set info
 } {x 0 write}
 test trace-12.7 {create array element during read trace} {
-    catch {unset x}
+    unset -nocomplain x
     set x(2) zzz
     trace add variable x read {traceCrtElement xyzzy}
     list [catch {set x(3)} msg] $msg
 } {0 xyzzy}
 test trace-12.8 {errors when setting variable traces} {
-    catch {unset x}
+    unset -nocomplain x
     set x 44
     list [catch {trace add variable x(0) write traceProc} msg] $msg
 } {1 {can't trace "x(0)": variable isn't array}}
 
-# Check deleting one trace from another.
+# Check trace deletion
 
 test trace-13.1 {delete one trace from another} {
     proc delTraces {args} {
@@ -724,7 +760,7 @@ test trace-13.1 {delete one trace from another} {
 	trace remove variable x read {traceTag 3}
 	trace remove variable x read {traceTag 4}
     }
-    catch {unset x}
+    unset -nocomplain x
     set x 44
     set info {}
     trace add variable x read {traceTag 1}
@@ -737,6 +773,53 @@ test trace-13.1 {delete one trace from another} {
     set info
 } {5 1}
 
+test trace-13.2 {leak when unsetting traced variable} \
+    -constraints memory -body {
+	set end [getbytes]
+	proc f args {}
+	for {set i 0} {$i < 5} {incr i} {
+	    trace add variable bepa write f
+	    set bepa a
+	    unset bepa
+	    set tmp $end
+	    set end [getbytes]
+	}
+	expr {$end - $tmp}
+    } -cleanup {
+	unset -nocomplain end i tmp
+    } -result 0
+test trace-13.3 {leak when removing traces} \
+    -constraints memory -body {
+	set end [getbytes]
+	proc f args {}
+	for {set i 0} {$i < 5} {incr i} {
+	    trace add variable bepa write f
+	    set bepa a
+	    trace remove variable bepa write f
+	    set tmp $end
+	    set end [getbytes]
+	}
+	expr {$end - $tmp}
+    } -cleanup {
+	unset -nocomplain end i tmp
+    } -result 0
+test trace-13.4 {leaks in error returns from traces} \
+    -constraints memory -body {
+	set end [getbytes]
+	for {set i 0} {$i < 5} {incr i} {
+	    set apa {a 1 b 2}
+	    set bepa [lrange $apa 0 end]
+	    trace add variable bepa write {error hej}
+	    catch {set bepa a}
+	    unset bepa
+	    set tmp $end
+	    set end [getbytes]
+	}
+	expr {$end - $tmp}
+    } -cleanup {
+	unset -nocomplain end i tmp
+    } -result 0
+
 # Check operation and syntax of "trace" command.
 
 # Syntax for adding/removing variable and command traces is basically the
@@ -773,13 +856,13 @@ foreach type {variable command} {
 
 test trace-14.1 "trace command, wrong # args errors" {
     list [catch {trace} msg] $msg
-} [list 1 "wrong # args: should be \"trace option ?arg arg ...?\""]
+} [list 1 "wrong # args: should be \"trace option ?arg ...?\""]
 test trace-14.2 "trace command, wrong # args errors" {
     list [catch {trace add} msg] $msg
-} [list 1 "wrong # args: should be \"trace add type ?arg arg ...?\""]
+} [list 1 "wrong # args: should be \"trace add type ?arg ...?\""]
 test trace-14.3 "trace command, wrong # args errors" {
     list [catch {trace remove} msg] $msg
-} [list 1 "wrong # args: should be \"trace remove type ?arg arg ...?\""]
+} [list 1 "wrong # args: should be \"trace remove type ?arg ...?\""]
 test trace-14.4 "trace command, wrong # args errors" {
     list [catch {trace info} msg] $msg
 } [list 1 "wrong # args: should be \"trace info type name\""]
@@ -831,13 +914,13 @@ test trace-14.11 {trace command, "trace variable" errors} {
 
 
 test trace-14.12 {trace command ("remove variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceProc
     trace remove variable x write traceProc
 } {}
 test trace-14.13 {trace command ("remove variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write traceProc
     trace remove variable x write traceProc
@@ -845,7 +928,7 @@ test trace-14.13 {trace command ("remove variable" option)} {
     set info
 } {}
 test trace-14.14 {trace command ("remove variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write {traceTag 1}
     trace add variable x write traceProc
@@ -860,7 +943,7 @@ test trace-14.14 {trace command ("remove variable" option)} {
     set info
 } {2 x {} write 1 2 1 2}
 test trace-14.15 {trace command ("remove variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write {traceTag 1}
     trace remove variable x write non_existent
@@ -868,27 +951,27 @@ test trace-14.15 {trace command ("remove variable" option)} {
     set info
 } {1}
 test trace-14.16 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x write {traceTag 1}
     trace add variable x write traceProc
     trace add variable x write {traceTag 2}
     trace info variable x
 } {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}}
 test trace-14.17 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     trace info variable x
 } {}
 test trace-14.18 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     trace info variable x(0)
 } {}
 test trace-14.19 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set x 44
     trace info variable x(0)
 } {}
 test trace-14.20 {trace command ("info variable" option)} {
-    catch {unset x}
+    unset -nocomplain x
     set x 44
     trace add variable x write {traceTag 1}
     proc check {} {global x; trace info variable x}
@@ -898,7 +981,7 @@ test trace-14.20 {trace command ("info variable" option)} {
 # Check fancy trace commands (long ones, weird arguments, etc.)
 
 test trace-15.1 {long trace command} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x write {traceTag {This is a very very long argument.  It's \
 	designed to test out the facilities of TraceVarProc for dealing \
@@ -916,14 +999,14 @@ test trace-15.2 {long trace command result to ignore} {
     proc longResult {args} {return "quite a bit of text, designed to
 	generate a core leak if this command file is invoked over and over again
 	and memory isn't being recycled correctly"}
-    catch {unset x}
+    unset -nocomplain x
     trace add variable x write longResult
     set x 44
     set x 5
     set x abcde
 } abcde
 test trace-15.3 {special list-handling in trace commands} {
-    catch {unset "x y z"}
+    unset -nocomplain "x y z"
     set "x y z(a\n\{)" 44
     set info {}
     trace add variable "x y z(a\n\{)" write traceProc
@@ -935,18 +1018,18 @@ test trace-15.3 {special list-handling in trace commands} {
 
 proc traceUnset {unsetName args} {
     global info
-    upvar $unsetName x
+    upvar 1 $unsetName x
     lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg
 }
 proc traceReset {unsetName resetName args} {
     global info
-    upvar $unsetName x $resetName y
+    upvar 1 $unsetName x $resetName y
     lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg
 }
 proc traceReset2 {unsetName resetName args} {
     global info
-    lappend info [catch {uplevel unset $unsetName} msg] $msg \
-	    [catch {uplevel set $resetName xyzzy} msg] $msg
+    lappend info [catch {uplevel 1 unset $unsetName} msg] $msg \
+	    [catch {uplevel 1 set $resetName xyzzy} msg] $msg
 }
 proc traceAppend {string name1 name2 op} {
     global info
@@ -954,7 +1037,7 @@ proc traceAppend {string name1 name2 op} {
 }
 
 test trace-16.1 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y read {traceUnset y}
@@ -962,49 +1045,49 @@ test trace-16.1 {unsets during read traces} {
     lappend info [catch {set y} msg] $msg
 } {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
 test trace-16.2 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) read {traceUnset y(0)}
     lappend info [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}}
 test trace-16.3 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) read {traceUnset y}
     lappend info [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
 test trace-16.4 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y read {traceReset y y}
     lappend info [catch {set y} msg] $msg
 } {0 {} 0 xyzzy 0 xyzzy}
 test trace-16.5 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) read {traceReset y(0) y(0)}
     lappend info [catch {set y(0)} msg] $msg
 } {0 {} 0 xyzzy 0 xyzzy}
 test trace-16.6 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) read {traceReset y y(0)}
     lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}}
 test trace-16.7 {unsets during read traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) read {traceReset2 y y(0)}
     lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy}
 test trace-16.8 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y write {traceUnset y}
@@ -1012,91 +1095,91 @@ test trace-16.8 {unsets during write traces} {
     lappend info [catch {set y xxx} msg] $msg
 } {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
 test trace-16.9 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) write {traceUnset y(0)}
     lappend info [catch {set y(0) xxx} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 0 {}}
 test trace-16.10 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) write {traceUnset y}
     lappend info [catch {set y(0) xxx} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 0 {}}
 test trace-16.11 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y write {traceReset y y}
     lappend info [catch {set y xxx} msg] $msg
 } {0 {} 0 xyzzy 0 xyzzy}
 test trace-16.12 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) write {traceReset y(0) y(0)}
     lappend info [catch {set y(0) xxx} msg] $msg
 } {0 {} 0 xyzzy 0 xyzzy}
 test trace-16.13 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) write {traceReset y y(0)}
     lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}}
 test trace-16.14 {unsets during write traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) write {traceReset2 y y(0)}
     lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 0 xyzzy 0 {} 0 xyzzy}
 test trace-16.15 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y unset {traceUnset y}
     lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
 } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}}
 test trace-16.16 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) unset {traceUnset y(0)}
     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}}
 test trace-16.17 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) unset {traceUnset y}
     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}}
 test trace-16.18 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y unset {traceReset2 y y}
     lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
 } {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
 test trace-16.19 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) unset {traceReset2 y(0) y(0)}
     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
 test trace-16.20 {unsets during unset traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) unset {traceReset2 y y(0)}
     lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
 } {0 {} 0 xyzzy 0 {} 0 xyzzy}
 test trace-16.21 {unsets cancelling traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y 1234
     set info {}
     trace add variable y read {traceAppend first}
@@ -1106,7 +1189,7 @@ test trace-16.21 {unsets cancelling traces} {
     lappend info [catch {set y} msg] $msg
 } {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
 test trace-16.22 {unsets cancelling traces} {
-    catch {unset y}
+    unset -nocomplain y
     set y(0) 1234
     set info {}
     trace add variable y(0) read {traceAppend first}
@@ -1119,19 +1202,19 @@ test trace-16.22 {unsets cancelling traces} {
 # Check various non-interference between traces and other things.
 
 test trace-17.1 {trace doesn't prevent unset errors} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     trace add variable x unset {traceProc}
     list [catch {unset x} msg] $msg $info
 } {1 {can't unset "x": no such variable} {x {} unset}}
 test trace-17.2 {traced variables must survive procedure exits} {
-    catch {unset x}
+    unset -nocomplain x
     proc p1 {} {global x; trace add variable x write traceProc}
     p1
     trace info variable x
 } {{write traceProc}}
 test trace-17.3 {traced variables must survive procedure exits} {
-    catch {unset x}
+    unset -nocomplain x
     set info {}
     proc p1 {} {global x; trace add variable x write traceProc}
     p1
@@ -1144,7 +1227,7 @@ test trace-17.3 {traced variables must survive procedure exits} {
 
 test trace-18.1 {unset traces on procedure returns} {
     proc p1 {x y} {set a 44; p2 14}
-    proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel {info vars}]}}}
+    proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}}
     set info {}
     p1 foo bar
     set info
@@ -1160,19 +1243,38 @@ test trace-18.2 {namespace delete / trace vdelete combo} {
     namespace delete ::foo
     info exists ::foo::x
 } 0
+test trace-18.3 {namespace delete / trace vdelete combo, Bug \#1337229} {
+    namespace eval ::ns {}
+    trace add variable ::ns::var unset {unset ::ns::var ;#}
+    namespace delete ::ns
+} {}
+test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} {
+    namespace eval ::ref {}
+    set ::ref::var1 AAA
+    trace add variable ::ref::var1 unset doTrace
+    set ::ref::var2 BBB
+    trace add variable ::ref::var2 {unset} doTrace
+    proc doTrace {vtraced vidx op} {
+	global info
+	append info [catch {set ::$vtraced}][llength [info vars ::ref::*]]
+    }
+    set info {}
+    namespace delete ::ref
+    rename doTrace {}
+    set info
+} 1110
 
 # Delete arrays when done, so they can be re-used as scalars
 # elsewhere.
 
-catch {unset x}
-catch {unset y}
+unset -nocomplain x y
 
-test trace-18.3 {trace add command (command existence)} {
+test trace-19.0.1 {trace add command (command existence)} {
     # Just in case!
     catch {rename nosuchname ""}
     list [catch {trace add command nosuchname rename traceCommand} msg] $msg
 } {1 {unknown command "nosuchname"}}
-test trace-18.4 {trace add command (command existence in ns)} {
+test trace-19.0.2 {trace add command (command existence in ns)} {
     list [catch {trace add command nosuchns::nosuchname rename traceCommand} msg] $msg
 } {1 {unknown command "nosuchns::nosuchname"}}
 
@@ -1207,6 +1309,7 @@ test trace-19.3 {command rename traces don't fire on command deletion} {
 test trace-19.4 {trace add command rename doesn't trace recreated commands} {
     proc foo {} {}
     catch {rename bar {}}
+    set info {}
     trace add command foo rename traceCommand
     proc foo {} {}
     rename foo bar
@@ -1219,25 +1322,49 @@ test trace-19.5 {trace add command deleted removes traces} {
     trace info command foo
 } {}
 
-namespace eval tc {}
-proc tc::tcfoo {} {}
-test trace-19.6 {trace add command rename in namespace} {
+test trace-19.6 {trace add command rename in namespace} -setup {
+    namespace eval tc {}
+    proc tc::tcfoo {} {}
+} -body {
     trace add command tc::tcfoo rename traceCommand
     rename tc::tcfoo tc::tcbar
     set info
-} {::tc::tcfoo ::tc::tcbar rename}
-test trace-19.7 {trace add command rename in namespace back again} {
+} -cleanup {
+    namespace delete tc
+} -result {::tc::tcfoo ::tc::tcbar rename}
+test trace-19.7 {trace add command rename in namespace back again} -setup {
+    namespace eval tc {}
+    proc tc::tcfoo {} {}
+} -body {
+    trace add command tc::tcfoo rename traceCommand
+    rename tc::tcfoo tc::tcbar
     rename tc::tcbar tc::tcfoo
     set info
-} {::tc::tcbar ::tc::tcfoo rename}
-test trace-19.8 {trace add command rename in namespace to out of namespace} {
+} -cleanup {
+    namespace delete tc
+} -result {::tc::tcbar ::tc::tcfoo rename}
+test trace-19.8 {trace add command rename in namespace to out of namespace} -setup {
+    namespace eval tc {}
+    proc tc::tcfoo {} {}
+} -body {
+    trace add command tc::tcfoo rename traceCommand
     rename tc::tcfoo tcbar
     set info
-} {::tc::tcfoo ::tcbar rename}
-test trace-19.9 {trace add command rename back into namespace} {
+} -cleanup {
+    catch {rename tcbar {}}
+    namespace delete tc
+} -result {::tc::tcfoo ::tcbar rename}
+test trace-19.9 {trace add command rename back into namespace} -setup {
+    namespace eval tc {}
+    proc tc::tcfoo {} {}
+} -body {
+    trace add command tc::tcfoo rename traceCommand
+    rename tc::tcfoo tcbar
     rename tcbar tc::tcfoo
     set info
-} {::tcbar ::tc::tcfoo rename}
+} -cleanup {
+    namespace delete tc
+} -result {::tcbar ::tc::tcfoo rename}
 test trace-19.10 {trace add command failed rename doesn't trigger trace} {
     set info {}
     proc foo {} {}
@@ -1248,11 +1375,18 @@ test trace-19.10 {trace add command failed rename doesn't trigger trace} {
 } {}
 catch {rename foo {}}
 catch {rename bar {}}
-test trace-19.11 {trace add command qualifies when renamed in namespace} {
+
+test trace-19.11 {trace add command qualifies when renamed in namespace} -setup {
+    namespace eval tc {}
+    proc tc::tcfoo {} {}
+} -body {
     set info {}
+    trace add command tc::tcfoo {rename delete} traceCommand
     namespace eval tc {rename tcfoo tcbar}
     set info
-} {::tc::tcfoo ::tc::tcbar rename}
+} -cleanup {
+    namespace delete tc
+} -result {::tc::tcfoo ::tc::tcbar rename}
 
 # Make sure it exists again
 proc foo {} {}
@@ -1346,7 +1480,7 @@ test trace-20.7 {trace add command delete in subinterp while being deleted} {
 } {}
 
 proc traceDelete {cmd old new op} {
-    trace remove command $cmd {expand}[lindex [trace info command $cmd] 0]
+    trace remove command $cmd {*}[lindex [trace info command $cmd] 0]
     global info
     set info [list $old $new $op]
 }
@@ -1409,14 +1543,35 @@ test trace-20.12 {delete trace renames command} {
     list [info commands foo] [info commands bar] [info commands someothername]
 } {{} {} {}}
 
+test trace-20.13 {rename trace discards result [Bug 1355342]} {
+    proc foo {} {}
+    trace add command foo rename {set w Aha!;#}
+    list [rename foo bar] [rename bar {}]
+} {{} {}}
+test trace-20.14 {rename trace discards error result [Bug 1355342]} {
+    proc foo {} {}
+    trace add command foo rename {error}
+    list [rename foo bar] [rename bar {}]
+} {{} {}}
+test trace-20.15 {delete trace discards result [Bug 1355342]} {
+    proc foo {} {}
+    trace add command foo delete {set w Aha!;#}
+    rename foo {}
+} {}
+test trace-20.16 {delete trace discards error result [Bug 1355342]} {
+    proc foo {} {}
+    trace add command foo delete {error}
+    rename foo {}
+} {}
+
+
 proc foo {b} { set a $b }
 
 
 # Delete arrays when done, so they can be re-used as scalars
 # elsewhere.
 
-catch {unset x}
-catch {unset y}
+unset -nocomplain x y
 
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
@@ -1497,6 +1652,66 @@ test trace-21.8 {trace execution: leavestep} {
     set info
 } {{foo {set b 3} 0 3 leavestep}}
 
+test trace-21.9 {trace execution: TCL_EVAL_GLOBAL} testevalobjv {
+    trace add execution foo enter soom
+    proc ::soom args {lappend ::info SUCCESS [info level]}
+    set ::info {}
+    namespace eval test_ns_1 {
+        proc soom args {lappend ::info FAIL [info level]}
+        # [testevalobjv 1 ...] ought to produce the same
+       # results as [uplevel #0 ...].
+        testevalobjv 1 foo x
+       uplevel #0 foo x
+    }
+    namespace delete test_ns_1
+    trace remove execution foo enter soom
+    set ::info
+} {SUCCESS 1 SUCCESS 1}
+
+test trace-21.10 {trace execution: TCL_EVAL_GLOBAL} testevalobjv {
+    trace add execution foo leave soom
+    proc ::soom args {lappend ::info SUCCESS [info level]}
+    set ::info {}
+    namespace eval test_ns_1 {
+        proc soom args {lappend ::info FAIL [info level]}
+        # [testevalobjv 1 ...] ought to produce the same
+       # results as [uplevel #0 ...].
+        testevalobjv 1 foo x
+       uplevel #0 foo x
+    }
+    namespace delete test_ns_1
+    trace remove execution foo leave soom
+    set ::info
+} {SUCCESS 1 SUCCESS 1}
+
+test trace-21.11 {trace execution and alias} -setup {
+    set res {}
+    proc ::x {} {return ::}
+    namespace eval a {}
+    proc ::a::x {} {return ::a}
+    interp alias {} y {} x
+} -body {
+    lappend res [namespace eval ::a y]
+    trace add execution ::x enter {
+      rename ::x {}
+	proc ::x {} {return ::}
+    #}
+    lappend res [namespace eval ::a y]
+} -cleanup {
+    namespace delete a
+    rename ::x {}
+} -result {:: ::}
+
+proc set2 args {
+    set {*}$args
+}
+
+test trace-21.12 {bug 2438181} -setup {
+    trace add execution set2 leave {puts one two three #;}
+} -body {
+    set2 a hello
+} -returnCodes 1 -result {wrong # args: should be "puts ?-nonewline? ?channelId? string"}
+
 proc factorial {n} {
     if {$n != 1} { return [expr {$n * [factorial [expr {$n -1 }]]}] }
     return 1
@@ -1602,7 +1817,7 @@ test trace-23.3 {recursive(3) trace execution: enter, leave, enterstep, leaveste
 {factorial 3} 0 6 leave}
 
 proc traceDelete {cmd args} {
-    trace remove execution $cmd {expand}[lindex [trace info execution $cmd] 0]
+    trace remove execution $cmd {*}[lindex [trace info execution $cmd] 0]
     global info
     set info $args
 }
@@ -1873,7 +2088,7 @@ test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)}
     trace remove execution foo {enter enterstep leavestep leave} \
         [list traceExecute foo]
     rename foo {}
-    catch {unset a}
+    unset -nocomplain a
     join $info "\n"
 } {foo foo enter
 foo {set a 1} enterstep
@@ -2101,7 +2316,7 @@ test trace-29.1 {Tcl_CreateTrace, correct command and argc/argv arguments of tra
 } {{expr 14 + 16} {expr 14 + 16} {set stuff [expr 14 + 16]} {set stuff 30}}
 test trace-29.2 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
     testcmdtrace tracetest {set stuff [info tclversion]}
-} [list {info tclversion} {info tclversion} {set stuff [info tclversion]} "set stuff [info tclversion]"]
+} [concat {{info tclversion} {info tclversion} ::tcl::info::tclversion {::tcl::info::tclversion} {set stuff [info tclversion]}} [list "set stuff [info tclversion]"]]
 test trace-29.3 {Tcl_CreateTrace, correct command and argc/argv arguments of trace proc} {testcmdtrace} {
     testcmdtrace deletetest {set stuff [info tclversion]}
 } [info tclversion]
@@ -2158,6 +2373,10 @@ test trace-29.10 {Tcl_CreateTrace, correct level interpretation} {testcmdtrace}
     testcmdtrace leveltest {foo}
 } {foo {foo} {uplevel 1 bar} {uplevel 1 bar} bar {bar} {uplevel 1 grok} {uplevel 1 grok}}
 
+test trace-29.11 {Tcl_CreateTrace, multiple traces} {testcmdtrace} {
+    testcmdtrace doubletest {format xx}
+} {{format xx} {format xx}}
+
 test trace-30.1 {Tcl_DeleteTrace} {emptyTest} {
     # the above tests have tested Tcl_DeleteTrace
 } {}
@@ -2237,6 +2456,8 @@ test trace-34.3 {Bug 1224585} {
     foo
 } {}
 
+# We test here for the half-documented and currently valid interplay between
+# delete traces and namespace deletion.
 test trace-34.4 {Bug 1047286} {
     variable x notrace
     proc callback {old - -} {
@@ -2248,6 +2469,54 @@ test trace-34.4 {Bug 1047286} {
     set x
 } {::foo::bar exists: ::foo::bar}
 
+test trace-34.5 {Bug 1047286} {
+    variable x notrace
+    proc callback {old - -} {
+        variable x "$old exists: [namespace which -command $old]"
+    }
+    namespace eval ::foo {proc bar {} {}}
+    trace add command ::foo::bar delete [namespace code callback]
+    namespace eval ::foo namespace delete ::foo
+    set x
+} {::foo::bar exists: }
+
+test trace-34.6 {Bug 1458266} -setup {
+    proc dummy {} {}
+    proc stepTraceHandler {cmdString args} {
+        variable log
+        append log "[expr {[info level] - 1}]: [lindex [split $cmdString] 0]\n"
+        dummy
+        isTracedInside_2
+    }
+    proc cmdTraceHandler {cmdString args} {
+        # silent
+    }
+    proc isTracedInside_1 {} {
+        isTracedInside_2
+    }
+    proc isTracedInside_2 {} {
+        set x 2
+    }
+} -body {
+    variable log {}
+    trace add execution isTracedInside_1 enterstep stepTraceHandler
+    trace add execution isTracedInside_2 enterstep stepTraceHandler
+    isTracedInside_1
+    variable first $log
+    set log {}
+    trace add execution dummy enter cmdTraceHandler
+    isTracedInside_1
+    variable second $log
+    expr {($first eq $second) ? "ok" : "\n$first\nand\n\n$second\ndiffer"}
+} -cleanup {
+    unset -nocomplain log first second
+    rename dummy {}
+    rename stepTraceHandler {}
+    rename cmdTraceHandler {}
+    rename isTracedInside_1 {}
+    rename isTracedInside_2 {}
+} -result ok
+
 test trace-35.1 {527164: Keep -errorinfo of traces} -setup {
     unset -nocomplain x y
 } -body {
@@ -2267,15 +2536,151 @@ test trace-35.1 {527164: Keep -errorinfo of traces} -setup {
 "set y 1"}}
 
 
+#
+# Test for the correct(?) dynamics of execution traces. This test insures that
+# the dynamics of the original implementation remain valid; note that
+# these aspects are neither documented nor do they appear in TIP 62
+
+proc traceproc {tracevar args} {
+    append ::$tracevar *
+}
+proc untraced {type} {
+    trace add execution untraced $type {traceproc tracevar}
+    append ::tracevar -
+}
+proc runbase {results base} {
+    set tt {enter leave enterstep leavestep}
+    foreach n {1 2 3 4} t $tt r $results {
+	eval [subst $base]
+    }
+}
+set base {
+    test trace-36.$n {dynamic trace creation: $t} -setup {
+	set ::tracevar {}
+    } -cleanup {
+	unset ::tracevar
+	trace remove execution untraced $t {traceproc tracevar}
+    } -body {
+	untraced $t
+	set ::tracevar
+    } -result {$r}
+}
+runbase {- - - -} $base
+
+set base {
+    test trace-37.$n {dynamic trace addition: $t} -setup {
+	set ::tracevar {}
+	set ::tracevar2 {}
+	trace add execution untraced enter {traceproc tracevar2}
+    } -cleanup {
+	trace remove execution untraced $t {traceproc tracevar}
+	trace remove execution untraced enter {traceproc tracevar2}
+	unset ::tracevar ::tracevar2
+    } -body {
+	untraced $t
+	list \$::tracevar \$::tracevar2
+    } -result {$r}
+}
+runbase {{- *} {-* *} {- *} {- *}} $base
+
+set base {
+    test trace-38.$n {dynamic trace addition: $t} -setup {
+	set ::tracevar {}
+	set ::tracevar2 {}
+	trace add execution untraced leave {traceproc tracevar2}
+    } -cleanup {
+	trace remove execution untraced $t {traceproc tracevar}
+	trace remove execution untraced leave {traceproc tracevar2}
+	unset ::tracevar ::tracevar2
+    } -body {
+	untraced $t
+	list \$::tracevar \$::tracevar2
+    } -result {$r}
+}
+runbase {{- *} {-* *} {- *} {- *}} $base
+
+test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
+    set ::traceLog 0
+    set ::traceCalls 0
+    set ::bar [list 0 1 2 3]
+    set res {}
+    proc dotrace args {
+	incr ::traceLog
+    }
+    proc foo {} {
+	incr ::traceCalls
+	# choose a BC'ed command that is 'unlikely' to interfere with tcltest's
+	# internals 
+	lset ::bar 1 2
+    }
+} -body {
+    foo
+    lappend res $::traceLog
+
+    trace add execution lset enter dotrace
+    foo
+    lappend res $::traceLog
+
+    trace remove execution lset enter dotrace
+    foo
+    lappend res $::traceLog
+
+    list $::traceCalls | {*}$res
+} -cleanup {
+    unset ::traceLog ::traceCalls ::bar res
+    rename dotrace {}
+    rename foo {}
+} -result {3 | 0 1 1}
+    
+test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
+    set ::traceLog 0
+    set ::traceCalls 0
+    set res {}
+    proc dotrace args {
+	incr ::traceLog
+    }
+    proc foo {} {
+	incr ::traceCalls
+	string equal zip zap
+    }
+} -body {
+    foo
+    lappend res $::traceLog
+
+    trace add execution ::tcl::string::equal enter dotrace
+    foo
+    lappend res $::traceLog
+
+    trace remove execution tcl::string::equal enter dotrace
+    foo
+    lappend res $::traceLog
+
+    list $::traceCalls | {*}$res
+} -cleanup {
+    unset ::traceLog ::traceCalls res
+    rename dotrace {}
+    rename foo {}
+} -result {3 | 0 1 1}
+
+test trace-40.1 {execution trace errors become command errors} {
+    proc foo args {}
+    trace add execution foo enter {rename foo {}; error bar;#}
+    catch foo m
+    return -level 0 $m[unset m]
+} bar
+    
 # Delete procedures when done, so we don't clash with other tests
 # (e.g. foobar will clash with 'unknown' tests).
 catch {rename foobar {}}
 catch {rename foo {}}
 catch {rename bar {}}
+catch {rename untraced {}}
+catch {rename traceproc {}}
+catch {rename runbase {}}
 
-# Unset the varaible when done
-catch {unset info}
+# Unset the variable when done
+unset -nocomplain info base
 
 # cleanup
-::tcltest::cleanupTests
+cleanupTests
 return
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index bdead08..e4613ed 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -8,14 +8,17 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixFCmd.test,v 1.21 2004/06/23 15:36:58 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testchmod [llength [info commands testchmod]]
+
 # These tests really need to be run from a writable directory, which
 # it is assumed [temporaryDirectory] is.
 set oldcwd [pwd]
@@ -23,7 +26,7 @@ cd [temporaryDirectory]
 
 # Several tests require need to match results against the unix username
 set user {}
-if {$tcl_platform(platform) == "unix"} {
+if {[testConstraint unix]} {
     catch {set user [exec whoami]}
     if {$user == ""} {
 	catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
@@ -33,6 +36,28 @@ if {$tcl_platform(platform) == "unix"} {
     }
 }
 
+# Find a group that exists on this system, or else skip tests that require
+# groups
+testConstraint foundGroup 0
+if {[testConstraint unix]} {
+    catch {
+	set groupList [exec groups]
+	set group [lindex $groupList 0]
+	testConstraint foundGroup 1
+    }
+}
+
+# check whether -readonly attribute is supported
+testConstraint readonlyAttr 0
+if {[testConstraint unix]} {
+    set f [makeFile "whatever" probe]
+    catch {
+	file attributes $f -readonly
+	testConstraint readonlyAttr 1
+    }
+    removeFile probe
+}
+
 proc openup {path} {
     testchmod 777 $path
     if {[file isdirectory $path]} {
@@ -51,7 +76,10 @@ proc cleanup {args} {
 	    set x [glob -directory $p tf* td*]
 	}
 	foreach file $x {
-	    if {[catch {file delete -force -- $file}]} {
+	    if {
+		[catch {file delete -force -- $file}]
+		&& [testConstraint testchmod]
+	    } then {
 		openup $file
 		file delete -force -- $file
 	    }
@@ -59,53 +87,69 @@ proc cleanup {args} {
     }
 }
 
-test unixFCmd-1.1 {TclpRenameFile: EACCES} {unix notRoot} {
+if {[testConstraint unix] && [testConstraint notRoot]} {
+    testConstraint execMknod [expr {![catch {exec mknod tf1 p}]}]
     cleanup
+}
+
+test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup {
+    cleanup
+} -constraints {unix notRoot} -body {
     file mkdir td1/td2/td3
     file attributes td1/td2 -permissions 0000
-    set msg [list [catch {file rename td1/td2/td3 td2} msg] $msg]
+    file rename td1/td2/td3 td2
+} -returnCodes error -cleanup {
     file attributes td1/td2 -permissions 0755
-    set msg
-} {1 {error renaming "td1/td2/td3": permission denied}}
-test unixFCmd-1.2 {TclpRenameFile: EEXIST} {unix notRoot} {
     cleanup
+} -result {error renaming "td1/td2/td3": permission denied}
+test unixFCmd-1.2 {TclpRenameFile: EEXIST} -setup {
+    cleanup
+} -constraints {unix notRoot} -body {
     file mkdir td1/td2
     file mkdir td2
-    list [catch {file rename td2 td1} msg] $msg
-} {1 {error renaming "td2" to "td1/td2": file already exists}}
-test unixFCmd-1.3 {TclpRenameFile: EINVAL} {unix notRoot} {
+    file rename td2 td1
+} -returnCodes error -cleanup {
+    cleanup
+} -result {error renaming "td2" to "td1/td2": file already exists}
+test unixFCmd-1.3 {TclpRenameFile: EINVAL} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
     file mkdir td1
-    list [catch {file rename td1 td1} msg] $msg
-} {1 {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}}
+    file rename td1 td1
+} -returnCodes error -cleanup {
+    cleanup
+} -result {error renaming "td1" to "td1/td1": trying to rename a volume or move a directory into itself}
 test unixFCmd-1.4 {TclpRenameFile: EISDIR} {emptyTest unix notRoot} {
     # can't make it happen
 } {}
-test unixFCmd-1.5 {TclpRenameFile: ENOENT} {unix notRoot} {
+test unixFCmd-1.5 {TclpRenameFile: ENOENT} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
     file mkdir td1
-    list [catch {file rename td2 td1} msg] $msg
-} {1 {error renaming "td2": no such file or directory}}
+    file rename td2 td1
+} -returnCodes error -cleanup {
+    cleanup
+} -result {error renaming "td2": no such file or directory}
 test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} {
     # can't make it happen
 } {}
-test unixFCmd-1.7 {TclpRenameFile: EXDEV} {unix notRoot} {
+test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
     file mkdir foo/bar
     file attr foo -perm 040555
-    set catchResult [catch {file rename foo/bar /tmp} msg]
-    set msg [lindex [split $msg :] end]
+    file rename foo/bar /tmp
+} -returnCodes error -cleanup {
     catch {file delete /tmp/bar}
     catch {file attr foo -perm 040777}
     catch {file delete -force foo}
-    list $catchResult $msg
-} {1 { permission denied}}
+} -match glob -result {*: permission denied}
 test unixFCmd-1.8 {Checking EINTR Bug} {unix notRoot nonPortable} {
-    testalarm 
+    testalarm
     after 2000
     list [testgotsig] [testgotsig]
 } {1 0}
-test unixFCmd-1.9 {Checking EINTR Bug} {unix notRoot nonPortable} {
+test unixFCmd-1.9 {Checking EINTR Bug} -constraints {unix notRoot nonPortable} -setup {
     cleanup
     set f [open tfalarm w]
     puts $f {
@@ -114,59 +158,75 @@ test unixFCmd-1.9 {Checking EINTR Bug} {unix notRoot nonPortable} {
 	exit 0
     }
     close $f
-    testalarm 
+} -body {
+    testalarm
     set pipe [open "|[info nameofexecutable] tfalarm" r+]
     set line [read $pipe 1]
     catch {close $pipe}
     list $line [testgotsig]
-} {h 1}
-test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} \
-	{unix notRoot} {
+} -cleanup {
     cleanup
+} -result {h 1}
+
+test unixFCmd-2.1 {TclpCopyFile: target exists: lstat(dst) == 0} -setup {
+    cleanup
+} -constraints {unix notRoot} -body {
     close [open tf1 a]
     close [open tf2 a]
     file copy -force tf1 tf2
-} {}
-test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} {unix notRoot dontCopyLinks} {
-    # copying links should end up with real files
+} -cleanup {
     cleanup
+} -result {}
+test unixFCmd-2.2.1 {TclpCopyFile: src is symlink} -setup {
+    cleanup
+} -constraints {unix notRoot dontCopyLinks} -body {
+    # copying links should end up with real files
     close [open tf1 a]
     file link -symbolic tf2 tf1
     file copy tf2 tf3
     file type tf3
-} {file}
-test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} {unix notRoot} {
-    # copying links should end up with the links copied
+} -cleanup {
+    cleanup
+} -result file
+test unixFCmd-2.2.2 {TclpCopyFile: src is symlink} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
+    # copying links should end up with the links copied
     close [open tf1 a]
     file link -symbolic tf2 tf1
     file copy tf2 tf3
     file type tf3
-} {link}
-test unixFCmd-2.3 {TclpCopyFile: src is block} {unix notRoot} {
+} -cleanup {
+    cleanup
+} -result link
+test unixFCmd-2.3 {TclpCopyFile: src is block} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
     set null "/dev/null"
     while {[file type $null] != "characterSpecial"} {
 	set null [file join [file dirname $null] [file readlink $null]]
     }
     # file copy $null tf1
-} {}
-test unixFCmd-2.4 {TclpCopyFile: src is fifo} {unix notRoot} {
+} -result {}
+test unixFCmd-2.4 {TclpCopyFile: src is fifo} -setup {
     cleanup
-    if [catch {exec mknod tf1 p}] {
-	list 1
-    } else {
-	file copy tf1 tf2
-	expr {"[file type tf1]" == "[file type tf2]"}
-    }
-} {1}
-test unixFCmd-2.5 {TclpCopyFile: copy attributes} {unix notRoot} {
+} -constraints {unix notRoot execMknod} -body {
+    exec mknod tf1 p
+    file copy tf1 tf2
+    list [file type tf1] [file type tf2]
+} -cleanup {
+    cleanup
+} -result {fifo fifo}
+test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup {
     cleanup
+} -constraints {unix notRoot} -body {
     close [open tf1 a]
     file attributes tf1 -permissions 0472
     file copy tf1 tf2
     file attributes tf2 -permissions
-} 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
+} -cleanup {
+    cleanup
+} -result 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
 
 test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} {
 } {}
@@ -195,178 +255,187 @@ test unixFCmd-10.1 {TraversalDelete not done} {emptyTest unix notRoot} {
 test unixFCmd-11.1 {CopyFileAttrs not done} {emptyTest unix notRoot} {
 } {}
 
-test unixFCmd-12.1 {GetGroupAttribute - file not found} {unix notRoot} {
+test unixFCmd-12.1 {GetGroupAttribute - file not found} -setup {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-12.2 {GetGroupAttribute - file found} {unix notRoot} {
+} -constraints {unix notRoot} -returnCodes error -body {
+    file attributes foo.test -group
+} -result {could not read "foo.test": no such file or directory}
+test unixFCmd-12.2 {GetGroupAttribute - file found} -setup {
     catch {file delete -force -- foo.test}
+} -constraints {unix notRoot} -body {
     close [open foo.test w]
-    list [catch {file attributes foo.test -group}] [file delete -force -- foo.test]
-} {0 {}}
+    file attributes foo.test -group
+} -cleanup {
+    file delete -force -- foo.test
+} -match glob -result *
 
-test unixFCmd-13.1 {GetOwnerAttribute - file not found} {unix notRoot} {
+test unixFCmd-13.1 {GetOwnerAttribute - file not found} -setup {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -group} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-13.2 {GetOwnerAttribute} {unix notRoot} {
+} -constraints {unix notRoot} -returnCodes error -body {
+    file attributes foo.test -group
+} -result {could not read "foo.test": no such file or directory}
+test unixFCmd-13.2 {GetOwnerAttribute} -setup {
     catch {file delete -force -- foo.test}
+} -constraints {unix notRoot} -body {
     close [open foo.test w]
-    list [catch {file attributes foo.test -owner} msg] \
-	    [string compare $msg $user] [file delete -force -- foo.test]
-} {0 0 {}}
+    file attributes foo.test -owner
+} -cleanup {
+    file delete -force -- foo.test
+} -result $user
 
-test unixFCmd-14.1 {GetPermissionsAttribute - file not found} {unix notRoot} {
+test unixFCmd-14.1 {GetPermissionsAttribute - file not found} -setup {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -permissions} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-14.2 {GetPermissionsAttribute} {unix notRoot} {
+} -constraints {unix notRoot} -returnCodes error -body {
+    file attributes foo.test -permissions
+} -result {could not read "foo.test": no such file or directory}
+test unixFCmd-14.2 {GetPermissionsAttribute} -setup {
     catch {file delete -force -- foo.test}
+} -constraints {unix notRoot} -body {
     close [open foo.test w]
-    list [catch {file attribute foo.test -permissions}] \
-	    [file delete -force -- foo.test]
-} {0 {}}
-
-# Find a group that exists on this system, or else skip tests that require
-# groups
-set foundgroup 0
-if {$tcl_platform(platform) == "unix"} {
-    catch {
-	set groupList [exec groups]
-	set group [lindex $groupList 0]
-	set foundgroup 1
-    }
-}
-testConstraint foundGroup $foundgroup
+    file attribute foo.test -permissions
+} -cleanup {
+    file delete -force -- foo.test
+} -match glob -result *
 
 #groups hard to test
-test unixFCmd-15.1 {SetGroupAttribute - invalid group} {unix notRoot} {
+test unixFCmd-15.1 {SetGroupAttribute - invalid group} -setup {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -group foozzz} msg] \
-	    $msg [file delete -force -- foo.test]
-} {1 {could not set group for file "foo.test": group "foozzz" does not exist} {}}
-test unixFCmd-15.2 {SetGroupAttribute - invalid file} \
-	{unix notRoot foundGroup} {
+} -constraints {unix notRoot} -body {
+    file attributes foo.test -group foozzz
+} -returnCodes error -cleanup {
+    file delete -force -- foo.test
+} -result {could not set group for file "foo.test": group "foozzz" does not exist}
+test unixFCmd-15.2 {SetGroupAttribute - invalid file} -setup {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -group $group} msg] $msg
-} {1 {could not set group for file "foo.test": no such file or directory}}
+} -constraints {unix notRoot foundGroup} -returnCodes error -body {
+    file attributes foo.test -group $group
+} -result {could not set group for file "foo.test": no such file or directory}
 
 #changing owners hard to do
-test unixFCmd-16.1 {SetOwnerAttribute - current owner} {unix notRoot} {
+test unixFCmd-16.1 {SetOwnerAttribute - current owner} -setup {
     catch {file delete -force -- foo.test}
+} -constraints {unix notRoot} -body {
     close [open foo.test w]
-    list [catch {file attributes foo.test -owner $user} msg] \
-	    $msg [string compare [file attributes foo.test -owner] $user] \
-	    [file delete -force -- foo.test]
-} {0 {} 0 {}}
-test unixFCmd-16.2 {SetOwnerAttribute - invalid file} {unix notRoot} {
+    list [file attributes foo.test -owner $user] \
+	[file attributes foo.test -owner]
+} -cleanup {
+    file delete -force -- foo.test
+} -result [list {} $user]
+test unixFCmd-16.2 {SetOwnerAttribute - invalid file} -setup {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -owner $user} msg] $msg
-} {1 {could not set owner for file "foo.test": no such file or directory}}
-test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} {unix notRoot} {
+} -constraints {unix notRoot} -returnCodes error -body {
+    file attributes foo.test -owner $user
+} -result {could not set owner for file "foo.test": no such file or directory}
+test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} -setup {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -owner foozzz} msg] $msg
-} {1 {could not set owner for file "foo.test": user "foozzz" does not exist}}
-
+} -constraints {unix notRoot} -returnCodes error -body {
+    file attributes foo.test -owner foozzz
+} -result {could not set owner for file "foo.test": user "foozzz" does not exist}
 
-test unixFCmd-17.1 {SetPermissionsAttribute} {unix notRoot} {
+test unixFCmd-17.1 {SetPermissionsAttribute} -setup {
     catch {file delete -force -- foo.test}
+} -constraints {unix notRoot} -body {
     close [open foo.test w]
-    list [catch {file attributes foo.test -permissions 0000} msg] \
-	    $msg [file attributes foo.test -permissions] \
-	    [file delete -force -- foo.test]
-} {0 {} 00000 {}}
-test unixFCmd-17.2 {SetPermissionsAttribute} {unix notRoot} {
+    list [file attributes foo.test -permissions 0000] \
+	[file attributes foo.test -permissions]
+} -cleanup {
+    file delete -force -- foo.test
+} -result {{} 00000}
+test unixFCmd-17.2 {SetPermissionsAttribute} -setup {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -permissions 0000} msg] $msg
-} {1 {could not set permissions for file "foo.test": no such file or directory}}
-test unixFCmd-17.3 {SetPermissionsAttribute} {unix notRoot} {
+} -constraints {unix notRoot} -returnCodes error -body {
+    file attributes foo.test -permissions 0000
+} -result {could not set permissions for file "foo.test": no such file or directory}
+test unixFCmd-17.3 {SetPermissionsAttribute} -setup {
     catch {file delete -force -- foo.test}
+} -constraints {unix notRoot} -body {
     close [open foo.test w]
-    list [catch {file attributes foo.test -permissions foo} msg] $msg \
-	    [file delete -force -- foo.test]
-} {1 {unknown permission string format "foo"} {}}
-test unixFCmd-17.4 {SetPermissionsAttribute} {unix notRoot} {
+    file attributes foo.test -permissions foo
+} -cleanup {
+    file delete -force -- foo.test
+} -returnCodes error -result {unknown permission string format "foo"}
+test unixFCmd-17.4 {SetPermissionsAttribute} -setup {
     catch {file delete -force -- foo.test}
+} -constraints {unix notRoot} -body {
     close [open foo.test w]
-    list [catch {file attributes foo.test -permissions ---rwx} msg] $msg \
-	    [file delete -force -- foo.test]
-} {1 {unknown permission string format "---rwx"} {}}
+    file attributes foo.test -permissions ---rwx
+} -cleanup {
+    file delete -force -- foo.test
+} -returnCodes error -result {unknown permission string format "---rwx"}
 
 close [open foo.test w]
 set ::i 4
-proc permcheck {testnum permstr expected} {
+proc permcheck {testnum permList expected} {
     test $testnum {SetPermissionsAttribute} {unix notRoot} {
+      set result {}
+      foreach permstr $permList {
 	file attributes foo.test -permissions $permstr
-	file attributes foo.test -permissions
+	lappend result [file attributes foo.test -permissions]
+      }
+      set result
     } $expected
 }
 permcheck unixFCmd-17.5   rwxrwxrwx	00777
 permcheck unixFCmd-17.6   r--r---w-	00442
-permcheck unixFCmd-17.7   0		00000
-permcheck unixFCmd-17.8   u+rwx,g+r	00740
-permcheck unixFCmd-17.9   u-w		00540
-permcheck unixFCmd-17.10   o+rwx	00547
+permcheck unixFCmd-17.7   {0 u+rwx,g+r u-w o+rwx} {00000 00740 00540 00547}
 permcheck unixFCmd-17.11  --x--x--x	00111
-permcheck unixFCmd-17.12  a+rwx		00777
+permcheck unixFCmd-17.12  {0 a+rwx} {00000 00777}
 file delete -force -- foo.test
 
-test unixFCmd-18.1 {Unix pwd} {nonPortable unix notRoot} {
+test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup {
+    set cd [pwd]
+} -body {
     # This test is nonportable because SunOS generates a weird error
     # message when the current directory isn't readable.
-    set cd [pwd]
     set nd $cd/tstdir
     file mkdir $nd
     cd $nd
     file attributes $nd -permissions 0000
-    set r [list [catch {pwd} res] [string range $res 0 36]];
-    cd $cd;
+    pwd
+} -returnCodes error -cleanup {
+    cd $cd
     file attributes $nd -permissions 0755
     file delete $nd
-    set r
-} {1 {error getting working directory name:}}
+} -match glob -result {error getting working directory name:*}
 
-# check whether -readonly attribute is supported
-set roattr 0
-if {$tcl_platform(platform) == "unix"} {
+test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} -setup {
     catch {file delete -force -- foo.test}
-    close [open foo.test w]
-    catch {
-	file attributes foo.test -readonly
-	set roattr 1
-    }
-    file delete -force -- foo.test
-}
-testConstraint readonlyAttr $roattr
-
-test unixFCmd-19.1 {GetReadOnlyAttribute - file not found} {unix notRoot readonlyAttr} {
-    catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -readonly} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
-test unixFCmd-19.2 {GetReadOnlyAttribute} {unix notRoot readonlyAttr} {
+} -constraints {unix notRoot readonlyAttr} -returnCodes error -body {
+    file attributes foo.test -readonly
+} -result {could not read "foo.test": no such file or directory}
+test unixFCmd-19.2 {GetReadOnlyAttribute} -setup {
     catch {file delete -force -- foo.test}
+} -constraints {unix notRoot readonlyAttr} -body {
     close [open foo.test w]
-    list [catch {file attribute foo.test -readonly} msg] $msg \
-	    [file delete -force -- foo.test]
-} {0 0 {}}
+    file attribute foo.test -readonly
+} -cleanup {
+    file delete -force -- foo.test
+} -result 0
 
-test unixFCmd-20.1 {SetReadOnlyAttribute} {unix notRoot readonlyAttr} {
+test unixFCmd-20.1 {SetReadOnlyAttribute} -setup {
     catch {file delete -force -- foo.test}
+} -constraints {unix notRoot readonlyAttr} -body {
     close [open foo.test w]
     list [catch {file attributes foo.test -readonly 1} msg] $msg \
 	    [catch {file attribute foo.test -readonly} msg] $msg \
 	    [catch {file delete -force -- foo.test}] \
 	    [catch {file attributes foo.test -readonly 0} msg] $msg \
-	    [catch {file attribute foo.test -readonly} msg] $msg \
-	    [file delete -force -- foo.test]
-} {0 {} 0 1 1 0 {} 0 0 {}}
-test unixFCmd-20.2 {SetReadOnlyAttribute} {unix notRoot readonlyAttr} {
+	    [catch {file attribute foo.test -readonly} msg] $msg
+} -cleanup {
+    file delete -force -- foo.test
+} -result {0 {} 0 1 1 0 {} 0 0}
+test unixFCmd-20.2 {SetReadOnlyAttribute} -setup {
     catch {file delete -force -- foo.test}
-    list [catch {file attributes foo.test -readonly 1} msg] $msg
-} {1 {could not read "foo.test": no such file or directory}}
+} -constraints {unix notRoot readonlyAttr} -returnCodes error -body {
+    file attributes foo.test -readonly 1
+} -result {could not read "foo.test": no such file or directory}
 
 # cleanup
 cleanup
 cd $oldcwd
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/unixFile.test b/tests/unixFile.test
index 8e37b5d..8147f48 100644
--- a/tests/unixFile.test
+++ b/tests/unixFile.test
@@ -8,14 +8,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixFile.test,v 1.9 2004/06/23 15:36:58 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testfindexecutable [llength [info commands testfindexecutable]]
 
 set oldpwd [pwd]
diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test
new file mode 100644
index 0000000..120f362
--- /dev/null
+++ b/tests/unixForkEvent.test
@@ -0,0 +1,45 @@
+# This file contains a collection of tests for the procedures in the file
+# tclUnixNotify.c.  Sourcing this file into Tcl runs the tests and
+# generates output for errors.  No output means no errors were found.
+#
+# Copyright (c) 1995-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.
+
+package require tcltest 2
+namespace import -force ::tcltest::*
+
+testConstraint testfork [llength [info commands testfork]]
+
+# Test if the notifier thread is well initialized in a forked interpreter
+# by Tcl_InitNotifier
+test unixforkevent-1.1 {fork and test writeable event} \
+    -constraints {testfork nonPortable} \
+    -body {
+	set myFolder [makeDirectory unixtestfork]
+	set pid [testfork]
+	if {$pid == 0} {
+	    # we are the forked process
+	    set result initialized
+	    set h [open [file join $myFolder test.txt] w]
+	    fileevent $h writable\
+		    "set result writable;\
+		    after cancel [after 1000 {set result timeout}]"
+	    vwait result
+	    close $h
+	    makeFile $result result.txt $myFolder
+	    exit
+	}
+	# we are the original process
+	while {![file readable [file join $myFolder result.txt]]} {}
+	viewFile result.txt $myFolder
+    } \
+    -result {writable} \
+    -cleanup { 
+	catch { removeFolder $myFolder }
+    }
+
+::tcltest::cleanupTests
+return
diff --git a/tests/unixInit.test b/tests/unixInit.test
index d2ebbfb..05338ed 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.test
@@ -1,90 +1,79 @@
 # The file tests the functions in the tclUnixInit.c file.
 #
-# 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) 1997 by 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.
-#
-# RCS: @(#) $Id: unixInit.test,v 1.48 2005/05/10 18:35:24 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 package require tcltest 2.2
-namespace import -force ::tcltest::*
+namespace import ::tcltest::*
 unset -nocomplain path
 catch {set oldlang $env(LANG)}
 set env(LANG) C
-
+
 test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} {
     set x {}
-
     # Watch out for a race condition here.  If tcltest is too slow to start
     # then we'll kill it before it has a chance to set up its signal handler.
-    
     set f [open "|[list [interpreter]]" w+]
     puts $f "puts hi"
     flush $f
     gets $f
     exec kill -PIPE [pid $f]
     lappend x [catch {close $f}]
-
     set f [open "|[list [interpreter]]" w+]
     puts $f "puts hi"
     flush $f
     gets $f
     exec kill [pid $f]
     lappend x [catch {close $f}]
-
     set x
 } {0 1}
-
-# This test is really a test of code in tclUnixChan.c, but the
-# channels are set up as part of initialisation of the interpreter so
-# the test seems to me to fit here as well as anywhere else.
+# This test is really a test of code in tclUnixChan.c, but the channels are
+# set up as part of initialisation of the interpreter so the test seems to me
+# to fit here as well as anywhere else.
 test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} {
-    # pipe1 is a connection to a server that reports what port it
-    # starts on, and delivers a constant string to the first client to
-    # connect to that port before exiting.
+    # pipe1 is a connection to a server that reports what port it starts on,
+    # and delivers a constant string to the first client to connect to that
+    # port before exiting.
     set pipe1 [open "|[list [interpreter]]" r+]
     puts $pipe1 {
 	proc accept {channel host port} {
-	    puts $channel {puts [fconfigure stdin -peername]; exit}
+	    puts $channel {puts [chan configure stdin -peername]; exit}
 	    close $channel
 	    exit
 	}
-	puts [fconfigure [socket -server accept 0] -sockname]
+	puts [chan configure [socket -server accept -myaddr 127.0.0.1 0] -sockname]
 	vwait forever \
 	    }
-    # Note the backslash above; this is important to make sure that the
-    # whole string is read before an [exit] can happen...
+    # Note the backslash above; this is important to make sure that the whole
+    # string is read before an [exit] can happen...
     flush $pipe1
     set port [lindex [gets $pipe1] 2]
     set sock [socket localhost $port]
-    # pipe2 is a connection to a Tcl interpreter that takes its orders
-    # from the socket we hand it (i.e. the server we create above.)
-    # These orders will tell it to print out the details about the
-    # socket it is taking instructions from, hopefully identifying it
-    # as a socket.  Which is what this test is all about.
+    # pipe2 is a connection to a Tcl interpreter that takes its orders from
+    # the socket we hand it (i.e. the server we create above.)  These orders
+    # will tell it to print out the details about the socket it is taking
+    # instructions from, hopefully identifying it as a socket.  Which is what
+    # this test is all about.
     set pipe2 [open "|[list [interpreter] <@$sock]" r]
     set result [gets $pipe2]
-
     # Clear any pending data; stops certain kinds of (non-important) errors
-    fconfigure $pipe1 -blocking 0; gets $pipe1
-    fconfigure $pipe2 -blocking 0; gets $pipe2
-
+    chan configure $pipe1 -blocking 0; gets $pipe1
+    chan configure $pipe2 -blocking 0; gets $pipe2
     # Close the pipes and the socket.
     close $pipe2
     close $pipe1
     catch {close $sock}
-
     # Can't use normal comparison, as hostname varies due to some
     # installations having a messed up /etc/hosts file.
     if {
-	[string equal 127.0.0.1 [lindex $result 0]] &&
-	[string equal $port     [lindex $result 2]]
+	"127.0.0.1" eq [lindex $result 0] && $port == [lindex $result 2]
     } then {
 	subst "OK"
     } else {
@@ -93,8 +82,8 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio}
 } {OK}
 
 # The unixInit-2.* tests were written to test the internal routine,
-# TclpInitLibraryPath.  That routine no longer does the things it used
-# to do so those tests are obsolete.  Skip them.
+# TclpInitLibraryPath.  That routine no longer does the things it used to do
+# so those tests are obsolete.  Skip them.
 
 skip [concat [skip] unixInit-2.*]
 
@@ -105,7 +94,6 @@ test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} {
     testsetdefenc $origDir
     set path
 } {slappy}
-
 test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup {
     unset -nocomplain oldlibrary
     if {[info exists env(TCL_LIBRARY)]} {
@@ -114,42 +102,33 @@ test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup
     }
 } -body {
     set path [getlibpath]
-
     set installLib lib/tcl[info tclversion]
     set developLib tcl[info patchlevel]/library
     set prefix [file dirname [file dirname [interpreter]]]
-
-    set x {}
-    lappend x [string compare [lindex $path 0] $prefix/$installLib]
-    lappend x [string compare [lindex $path 4] [file dirname $prefix]/$developLib]
-    set x
+    list [string equal [lindex $path 0] $prefix/$installLib] \
+	[string equal [lindex $path 4] [file dirname $prefix]/$developLib]
 } -cleanup {
     if {[info exists oldlibrary]} {
 	set env(TCL_LIBRARY) $oldlibrary
 	unset oldlibrary
     }
-} -result {0 0}
-
+} -result {1 1}
 test unixInit-2.2 {TclpInitLibraryPath: TCL_LIBRARY} -setup {
     unset -nocomplain oldlibrary
     if {[info exists env(TCL_LIBRARY)]} {
 	set oldlibrary $env(TCL_LIBRARY)
     }
 } -body {
-    # ((str != NULL) && (str[0] != '\0')) 
-
+    # ((str != NULL) && (str[0] != '\0'))
     set env(TCL_LIBRARY) sparkly
-    set path [getlibpath]
-    unset env(TCL_LIBRARY)
-
-    lindex $path 0
+    lindex [getlibpath] 0
 } -cleanup {
+    unset -nocomplain env(TCL_LIBRARY)
     if {[info exists oldlibrary]} {
 	set env(TCL_LIBRARY) $oldlibrary
 	unset oldlibrary
     }
 } -result "sparkly"
-
 test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup {
     unset -nocomplain oldlibrary
     if {[info exists env(TCL_LIBRARY)]} {
@@ -157,33 +136,25 @@ test unixInit-2.3 {TclpInitLibraryPath: TCL_LIBRARY wrong version} -setup {
     }
 } -body {
     # ((pathc > 0) && (strcasecmp(installLib + 4, pathv[pathc - 1]) != 0))
-
     set env(TCL_LIBRARY) /a/b/tcl1.7
-    set path [getlibpath]
-    unset env(TCL_LIBRARY)
-
-    lrange $path 0 1
+    lrange [getlibpath] 0 1
 } -cleanup {
+    unset -nocomplain env(TCL_LIBRARY)
     if {[info exists oldlibrary]} {
 	set env(TCL_LIBRARY) $oldlibrary
 	unset oldlibrary
     }
 } -result [list /a/b/tcl1.7 /a/b/tcl[info tclversion]]
-
 test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
     if {[info exists env(TCL_LIBRARY)]} {
 	set oldlibrary $env(TCL_LIBRARY)
     }
 } -body {
     # Child process translates env variable from native encoding.
-
     set env(TCL_LIBRARY) "\xa7"
-    set x [lindex [getlibpath] 0]
-    unset env(TCL_LIBRARY)
-    unset env(LANG)
-
-    set x
+    lindex [getlibpath] 0
 } -cleanup {
+    unset -nocomplain env(TCL_LIBRARY) env(LANG)
     if {[info exists oldlibrary]} {
 	set env(TCL_LIBRARY) $oldlibrary
 	unset oldlibrary
@@ -192,7 +163,6 @@ test unixInit-2.4 {TclpInitLibraryPath: TCL_LIBRARY: INTL} -setup {
 test unixInit-2.5 {TclpInitLibraryPath: compiled-in library path} {
     # cannot test
 } {}
-
 test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup {
     unset -nocomplain oldlibrary
     if {[info exists env(TCL_LIBRARY)]} {
@@ -223,17 +193,14 @@ test unixInit-2.6 {TclpInitLibraryPath: executable relative} -setup {
 	unset oldlibrary
     }
 } -result [list [temporaryDirectory]/tmp/sparkly/lib/tcl[info tclversion] [temporaryDirectory]/tmp/lib/tcl[info tclversion]]
-
 test unixInit-2.7 {TclpInitLibraryPath: compiled-in library path} {
     # would need test command to get defaultLibDir and compare it to
     # [lindex $auto_path end]
 } {}
-
 #
-# The following two tests write to the directory /tmp/sparkly instead
-# of to [temporaryDirectory].  This is because the failures tested by
-# these tests need paths near the "root" of the file system to present
-# themselves.
+# The following two tests write to the directory /tmp/sparkly instead of to
+# [temporaryDirectory].  This is because the failures tested by these tests
+# need paths near the "root" of the file system to present themselves.
 #
 test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
     unset -nocomplain oldlibrary
@@ -242,25 +209,24 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
     }
     set env(TCL_LIBRARY) [info library]
     # Checking for Bug 219416
-    # When a program that embeds the Tcl library, like tcltest, is
-    # installed near the "root" of the file system, there was a problem
-    # constructing directories relative to the executable.  When a 
-    # relative ".." went past the root, relative path names were created
-    # rather than absolute pathnames.  In some cases, accessing past the
-    # root caused memory access violations too.
+    # When a program that embeds the Tcl library, like tcltest, is installed
+    # near the "root" of the file system, there was a problem constructing
+    # directories relative to the executable.  When a relative ".." went past
+    # the root, relative path names were created rather than absolute
+    # pathnames.  In some cases, accessing past the root caused memory access
+    # violations too.
     #
-    # The bug is now fixed, but here we check for it by making sure that
-    # the directories constructed relative to the executable are all
-    # absolute pathnames, even when the executable is installed near
-    # the root of the filesystem.
+    # The bug is now fixed, but here we check for it by making sure that the
+    # directories constructed relative to the executable are all absolute
+    # pathnames, even when the executable is installed near the root of the
+    # filesystem.
     #
-    # The only directory near the root we are likely to have write access
-    # to is /tmp.
+    # The only directory near the root we are likely to have write access to
+    # is /tmp.
     file delete -force /tmp/sparkly
     file delete -force /tmp/lib/tcl[info tclversion]
     file mkdir /tmp/sparkly
     file copy [interpreter] /tmp/sparkly/tcltest
-
     # Keep any existing /tmp/lib directory
     set deletelib 1
     if {[file exists /tmp/lib]} {
@@ -270,13 +236,11 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
 	    file delete -force /tmp/lib
 	}
     }
-
     # For a successful Tcl_Init, we need a [source]-able init.tcl in
     # ../lib/tcl$version relative to the executable.
     file mkdir /tmp/lib/tcl[info tclversion]
     close [open /tmp/lib/tcl[info tclversion]/init.tcl w]
 } -body {
-
     # Check that all directories in the library path are absolute pathnames
     set allAbsolute 1
     foreach dir [getlibpath /tmp/sparkly/tcltest] {
@@ -285,7 +249,6 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
     }
     set allAbsolute
 } -cleanup {
-
     # Clean up temporary installation
     file delete -force /tmp/sparkly
     file delete -force /tmp/lib/tcl[info tclversion]
@@ -296,7 +259,6 @@ test unixInit-2.8 {TclpInitLibraryPath: all absolute pathtype} -setup {
 	unset oldlibrary
     }
 } -result 1
-
 test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup {
     # Checking for Bug 438014
     unset -nocomplain oldlibrary
@@ -308,7 +270,6 @@ test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup {
     file delete -force /tmp/library
     file mkdir /tmp/sparkly
     file copy [interpreter] /tmp/sparkly/tcltest
-
     file mkdir /tmp/library/
     close [open /tmp/library/init.tcl w]
 } -body {
@@ -323,7 +284,6 @@ test unixInit-2.9 {TclpInitLibraryPath: paths relative to executable} -setup {
     }
 } -result [list /tmp/lib/tcl[info tclversion] /lib/tcl[info tclversion] \
         /tmp/library /library /tcl[info patchlevel]/library]
-
 test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup {
     unset -nocomplain oldlibrary
     if {[info exists env(TCL_LIBRARY)]} {
@@ -348,21 +308,15 @@ test unixInit-2.10 {TclpInitLibraryPath: executable relative} -setup {
     set y
 } -cleanup {
     cd $saveDir
-    unset saveDir
     removeFile init.tcl $scriptDir
-    unset scriptDir
     removeDirectory tcl[info tclversion] $libDir
-    unset libDir
     file delete $execPath
-    unset execPath
     removeDirectory bin $sparklyDir
     removeDirectory lib $sparklyDir
-    unset sparklyDir
     removeDirectory sparkly $tmpDir
-    unset tmpDir
     removeDirectory tmp
-    unset x p y
-    unset env(TCL_LIBRARY)
+    unset -nocomplain saveDir scriptDir libDir execPath sparklyDir tmpDir
+    unset -nocomplain x p y env(TCL_LIBRARY)
     if {[info exists oldlibrary]} {
 	set env(TCL_LIBRARY) $oldlibrary
 	unset oldlibrary
@@ -374,45 +328,40 @@ test unixInit-3.1 {TclpSetInitialEncodings} -constraints {
 	unix stdio
 } -body {
     set env(LANG) C
-
     set f [open "|[list [interpreter]]" w+]
-    fconfigure $f -buffering none
+    chan configure $f -buffering none
     puts $f {puts [encoding system]; exit}
     set enc [gets $f]
     close $f
-    unset env(LANG)
-
-    set enc
+    return $enc
+} -cleanup {
+    unset -nocomplain env(LANG)
 } -match regexp -result [expr {
 	($tcl_platform(os) eq "Darwin") ? "^utf-8$" : "^iso8859-15?$"}]
-
-test unixInit-3.2 {TclpSetInitialEncodings} {unix stdio} {
-    set env(LANG) japanese
+test unixInit-3.2 {TclpSetInitialEncodings} -setup {
     catch {set oldlc_all $env(LC_ALL)}
+} -constraints {unix stdio} -body {
+    set env(LANG) japanese
     set env(LC_ALL) japanese
-
     set f [open "|[list [interpreter]]" w+]
-    fconfigure $f -buffering none
+    chan configure $f -buffering none
     puts $f {puts [encoding system]; exit}
     set enc [gets $f]
     close $f
-    unset env(LANG)
-    unset env(LC_ALL)
-    catch {set env(LC_ALL) $oldlc_all}
-
     set validEncodings [list euc-jp]
     if {[string match HP-UX $tcl_platform(os)]} {
-	# Some older HP-UX systems need us to accept this as valid
-	# Bug 453883 reports that newer HP-UX systems report euc-jp
-	# like everybody else.
+	# Some older HP-UX systems need us to accept this as valid Bug 453883
+	# reports that newer HP-UX systems report euc-jp like everybody else.
 	lappend validEncodings shiftjis
     }
-    expr {[lsearch -exact $validEncodings $enc] < 0}
-} 0
-    
+    expr {$enc ni $validEncodings}
+} -cleanup {
+    unset -nocomplain env(LANG) env(LC_ALL)
+    catch {set env(LC_ALL) $oldlc_all}
+} -result 0
+
 test unixInit-4.1 {TclpSetVariables} {unix} {
     # just make sure they exist
-
     set a [list $tcl_library $tcl_pkgPath $tcl_platform(os)]
     set a [list $tcl_platform(osVersion) $tcl_platform(machine)]
     set tcl_platform(platform)
@@ -426,7 +375,7 @@ test unixInit-6.1 {Tcl_SourceRCFile} {emptyTest unix} {
 } {}
 
 test unixInit-7.1 {closed standard channel: Bug 772288} -constraints {
-	unix stdio
+    unix stdio
 } -body {
     set tclsh [interpreter]
     set crash [makeFile {puts [open /dev/null]} crash.tcl]
@@ -439,11 +388,15 @@ test unixInit-7.1 {closed standard channel: Bug 772288} -constraints {
     removeFile crash.tcl
     removeFile crashtest.tcl
 } -returnCodes 0
-
+
 # cleanup
-catch {unset env(LANG)}
+unset -nocomplain env(LANG)
 catch {set env(LANG) $oldlang}
 unset -nocomplain path
 ::tcltest::cleanupTests
 return
 
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test
index 42090d9..2f03529 100644
--- a/tests/unixNotfy.test
+++ b/tests/unixNotfy.test
@@ -9,12 +9,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unixNotfy.test,v 1.18 2005/05/14 20:46:46 das Exp $
-
-# The tests should not be run if you have a notifier which is unable to
-# detect infinite vwaits, as the tests below will hang. The presence of
-# the "testthread" command indicates that this is the case.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -22,11 +16,11 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 # When run in a Tk shell, these tests hang.
-testConstraint noTk       [expr {![info exists tk_version]}]
-testConstraint testthread [expr {[info commands testthread] != {}}]
+testConstraint noTk [expr {0 != [catch {package present Tk}]}]
+testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
 # Darwin always uses a threaded notifier
 testConstraint unthreaded [expr {
-    (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded))
+    ![::tcl::pkgconfig get threaded]
     && $tcl_platform(os) ne "Darwin"
 }]
 
@@ -40,7 +34,7 @@ test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -
     vwait x
     close $f
     list [catch {vwait x} msg] $msg
-} -result {1 {can't wait for variable "x":  would wait forever}} -cleanup { 
+} -result {1 {can't wait for variable "x": would wait forever}} -cleanup { 
     catch { close $f }
     catch { removeFile foo }
 }
@@ -55,7 +49,7 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -
     vwait y
     close $f2
     list [catch {vwait x} msg] $msg
-} -result {1 {can't wait for variable "x":  would wait forever}} -cleanup {
+} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
     catch { close $f1 }
     catch { close $f2 }
     catch { removeFile foo }
@@ -63,16 +57,15 @@ test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -
 }
 
 test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
-    -constraints {noTk unix testthread} \
+    -constraints {noTk unix thread} \
     -body {
 	update
 	set f [open [makeFile "" foo] w]
 	fileevent $f writable {set x 1}
 	vwait x
 	close $f
-   	testthread create "testthread send [testthread id] {set x ok}"
+   	thread::create "thread::send [thread::id] {set x ok}"
 	vwait x
-	threadReap
 	set x
     } \
     -result {ok} \
@@ -81,7 +74,7 @@ test unixNotfy-2.1 {Tcl_DeleteFileHandler} \
 	catch { removeFile foo }
     }
 test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
-    -constraints {noTk unix testthread} \
+    -constraints {noTk unix thread} \
     -body {
 	update
 	set f1 [open [makeFile "" foo] w]
@@ -92,9 +85,8 @@ test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
 	close $f1
 	vwait y
 	close $f2
-   	testthread create "testthread send [testthread id] {set x ok}"
+   	thread::create "thread::send [thread::id] {set x ok}"
 	vwait x
-	threadReap
 	set x
     } \
     -result {ok} \
diff --git a/tests/unknown.test b/tests/unknown.test
index e4e66bf..e80d3a6 100644
--- a/tests/unknown.test
+++ b/tests/unknown.test
@@ -10,17 +10,13 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unknown.test,v 1.7 2004/05/19 13:05:37 dkf Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
-    namespace import -force ::tcltest::*
-}
+package require tcltest 2
+namespace import ::tcltest::*
 
-catch {unset x}
+unset -nocomplain x
 catch {rename unknown unknown.old}
-
+
 test unknown-1.1 {non-existent "unknown" command} {
     list [catch {_non-existent_ foo bar} msg] $msg
 } {1 {invalid command name "_non-existent_"}}
@@ -29,7 +25,6 @@ proc unknown {args} {
     global x
     set x $args
 }
-
 test unknown-2.1 {calling "unknown" command} {
     foobar x y z
     set x
@@ -55,13 +50,16 @@ test unknown-3.1 {argument quoting in calls to "unknown"} {
 proc unknown args {
     error "unknown failed"
 }
-
 test unknown-4.1 {errors in "unknown" procedure} {
     list [catch {non-existent a b} msg] $msg $errorCode
 } {1 {unknown failed} NONE}
-
+
 # cleanup
 catch {rename unknown {}}
 catch {rename unknown.old unknown}
-::tcltest::cleanupTests
+cleanupTests
 return 
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/unload.test b/tests/unload.test
index 6cc0007..5a374c4 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -10,58 +10,63 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: unload.test,v 1.4 2004/05/25 19:38:16 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 # Figure out what extension is used for shared libraries on this
 # platform.
+if {![info exists ext]} {
+    set ext [info sharedlibextension]
+}
 
 # Tests require the existence of one of the DLLs in the dltest directory.
-set ext [info sharedlibextension]
 set testDir [file join [file dirname [info nameofexecutable]] dltest]
 set x [file join $testDir pkgua$ext]
 set dll "[file tail $x]Required"
-::tcltest::testConstraint $dll [file readable $x]
+testConstraint $dll [file readable $x]
 
 # Tests also require that this DLL has not already been loaded.
 set loaded "[file tail $x]Loaded"
 set alreadyLoaded [info loaded]
-::tcltest::testConstraint $loaded \
-	[expr {![string match *pkgua* $alreadyLoaded]}]
+testConstraint $loaded [expr {![string match *pkgua* $alreadyLoaded]}]
 
 set alreadyTotalLoaded [info loaded]
 
 # Certain tests require the 'teststaticpkg' command from tcltest
-::tcltest::testConstraint teststaticpkg \
-	[string compare {} [info commands teststaticpkg]]
+testConstraint teststaticpkg [llength [info commands teststaticpkg]]
+
+# Certain tests need the 'testsimplefilsystem' in tcltest
+testConstraint testsimplefilesystem \
+	[llength [info commands testsimplefilesystem]]
 
 # Basic tests: parameter testing...
-test unload-1.1 {basic errors} {} {
-    list [catch {unload} msg] $msg
-} "1 {wrong \# args: should be \"unload ?switches? fileName ?packageName? ?interp?\"}"
-test unload-1.2 {basic errors} {} {
-    list [catch {unload a b c d} msg] $msg
-} "1 {wrong \# args: should be \"unload ?switches? fileName ?packageName? ?interp?\"}"
-test unload-1.3 {basic errors} {} {
-    list [catch {unload a b foobar} msg] $msg
-} {1 {could not find interpreter "foobar"}}
-test unload-1.4 {basic errors} {} {
-    list [catch {unload {}} msg] $msg
-} {1 {must specify either file name or package name}}
-test unload-1.5 {basic errors} {} {
-    list [catch {unload {} {}} msg] $msg
-} {1 {must specify either file name or package name}}
-test unload-1.6 {basic errors} {} {
-    list [catch {unload {} Unknown} msg] $msg
-} {1 {package "Unknown" is loaded statically and cannot be unloaded}}
-test unload-1.7 {-nocomplain switch} {} {
-    list [unload -nocomplain {} Unknown]
-} {{}}
+test unload-1.1 {basic errors} -returnCodes error -body {
+    unload
+} -result {wrong # args: should be "unload ?-switch ...? fileName ?packageName? ?interp?"}
+test unload-1.2 {basic errors} -returnCodes error -body {
+    unload a b c d
+} -result {wrong # args: should be "unload ?-switch ...? fileName ?packageName? ?interp?"}
+test unload-1.3 {basic errors} -returnCodes error -body {
+    unload a b foobar
+} -result {could not find interpreter "foobar"}
+test unload-1.4 {basic errors} -returnCodes error -body {
+    unload {}
+} -result {must specify either file name or package name}
+test unload-1.5 {basic errors} -returnCodes error -body {
+    unload {} {}
+} -result {must specify either file name or package name}
+test unload-1.6 {basic errors} -returnCodes error -body {
+    unload {} Unknown
+} -result {package "Unknown" is loaded statically and cannot be unloaded}
+test unload-1.7 {-nocomplain switch} {
+    unload -nocomplain {} Unknown
+} {}
 
 set pkgua_loaded {}
 set pkgua_detached {}
@@ -213,8 +218,28 @@ test unload-4.6 {basic unloading of unloadable package from a safe interpreter,
 	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
 } {{. {} {}} {} {} {. . .}}
 
+test unload-5.1 {unload a module loaded from vfs} \
+     -constraints [list $dll $loaded testsimplefilesystem] \
+     -setup {
+	 set dir [pwd]
+	 cd $testDir
+	 testsimplefilesystem 1
+	 load simplefs:/pkgua$ext pkgua
+     } \
+    -body {
+	list [catch {unload simplefs:/pkgua$ext} msg] $msg
+    } \
+    -result {0 {}}
+
+
+
 # cleanup
 interp delete child
 interp delete child-trusted
+unset ext
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/uplevel.test b/tests/uplevel.test
index b8bbbb7..0410469 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -1,17 +1,15 @@
 # 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.
-#
-# RCS: @(#) $Id: uplevel.test,v 1.8 2004/05/19 10:47:28 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -26,7 +24,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 +83,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
@@ -126,7 +128,79 @@ test uplevel-6.1 {uplevel and shadowed cmds} {
     lappend res [namespace eval ns1 a2]
 } {::ns1 :: ::ns1 ::}
 
+#
+# These tests verify that upleveled scripts run in the correct level and access
+# the proper variables.
+#
 
+test uplevel-7.1 {var access, no LVT in either level} -setup {
+    set x 1
+    unset -nocomplain y z
+} -body {
+    namespace eval foo {
+	set x 2 
+	set y 2
+	uplevel 1 {
+	    set x 3
+	    set y 3
+	    set z 3
+	}
+    }
+    list $x $y $z
+} -cleanup {
+    namespace delete foo
+    unset -nocomplain x y z
+} -result {3 3 3}
+
+test uplevel-7.2 {var access, no LVT in upper level} -setup {
+    set x 1
+    unset -nocomplain y z
+} -body {
+    proc foo {} {
+	set x 2 
+	set y 2
+	uplevel 1 {
+	    set x 3
+	    set y 3
+	    set z 3
+	}
+    }
+    foo
+    list $x $y $z
+} -cleanup {
+    rename foo {}
+    unset -nocomplain x y z
+} -result {3 3 3}
+
+test uplevel-7.3 {var access, LVT in upper level} -setup {
+    proc moo {} {
+	set x 1; #var in LVT
+	unset -nocomplain y z
+	foo
+	list $x $y $z
+    }
+} -body {
+    proc foo {} {
+	set x 2 
+	set y 2
+	uplevel 1 {
+	    set x 3
+	    set y 3
+	    set z 3
+	}
+    }
+    foo
+    moo
+} -cleanup {
+    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 2d100a1..e93f58a 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -1,25 +1,26 @@
-# Commands covered:  upvar
+# Commands covered:  'upvar', 'namespace upvar'
 #
-# 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.
-#
-# RCS: @(#) $Id: upvar.test,v 1.10 2004/05/19 10:46:27 dkf Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
-testConstraint testupvar [llength [info commands testupvar]]
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
 
+testConstraint testupvar [llength [info commands testupvar]]
+
 test upvar-1.1 {reading variables with upvar} {
     proc p1 {a b} {set c 22; set d 33; p2}
     proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
@@ -148,7 +149,7 @@ test upvar-3.5 {unsetting array elements with upvar} {
 	array names a
     }
     proc p2 {} {upvar a(0) x; unset x}
-    p1
+    lsort [p1]
 } {1 2}
 test upvar-3.6 {unsetting then resetting array elements with upvar} {
     proc p1 {} {
@@ -156,7 +157,7 @@ test upvar-3.6 {unsetting then resetting array elements with upvar} {
 	set a(1) first
 	set a(2) second
 	p2
-	list [array names a] [catch {set a(0)} msg] $msg
+	list [lsort [array names a]] [catch {set a(0)} msg] $msg
     }
     proc p2 {} {upvar a(0) x; unset x; set x 12345}
     p1
@@ -290,56 +291,64 @@ test upvar-7.5 {potential memory leak when deleting variable table} {
     leak
 } {}
 
-test upvar-8.1 {errors in upvar command} {
-    list [catch upvar msg] $msg
-} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
-test upvar-8.2 {errors in upvar command} {
-    list [catch {upvar 1} msg] $msg
-} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
-test upvar-8.3 {errors in upvar command} {
+test upvar-8.1 {errors in upvar command} -returnCodes error -body {
+    upvar
+} -result {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}
+test upvar-8.2 {errors in upvar command} -returnCodes error -body {
+    upvar 1
+} -result {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}
+test upvar-8.2.1 {upvar with numeric first argument} {
+    apply {{} {set 0 ok; apply {{} {upvar 0 x; return $x}}}}
+} ok
+test upvar-8.3 {errors in upvar command} -returnCodes error -body {
     proc p1 {} {upvar a b c}
-    list [catch p1 msg] $msg
-} {1 {wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"}}
-test upvar-8.4 {errors in upvar command} {
+    p1
+} -result {bad level "a"}
+test upvar-8.4 {errors in upvar command} -returnCodes error -body {
     proc p1 {} {upvar 0 b b}
-    list [catch p1 msg] $msg
-} {1 {can't upvar from variable to itself}}
-test upvar-8.5 {errors in upvar command} {
+    p1
+} -result {can't upvar from variable to itself}
+test upvar-8.5 {errors in upvar command} -returnCodes error -body {
     proc p1 {} {upvar 0 a b; upvar 0 b a}
-    list [catch p1 msg] $msg
-} {1 {can't upvar from variable to itself}}
-test upvar-8.6 {errors in upvar command} {
+    p1
+} -result {can't upvar from variable to itself}
+test upvar-8.6 {errors in upvar command} -returnCodes error -body {
     proc p1 {} {set a 33; upvar b a}
-    list [catch p1 msg] $msg
-} {1 {variable "a" already exists}}
-test upvar-8.7 {errors in upvar command} {
+    p1
+} -result {variable "a" already exists}
+test upvar-8.7 {errors in upvar command} -returnCodes error -body {
     proc p1 {} {trace variable a w foo; upvar b a}
-    list [catch p1 msg] $msg
-} {1 {variable "a" has traces: can't use for upvar}}
-test upvar-8.8 {create nested array with upvar} {
+    p1
+} -result {variable "a" has traces: can't use for upvar}
+test upvar-8.8 {create nested array with upvar} -body {
     proc p1 {} {upvar x(a) b; set b(2) 44}
     catch {unset x}
-    list [catch p1 msg] $msg
-} {1 {can't set "b(2)": variable isn't array}}
-test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} {
-    catch {namespace delete {expand}[namespace children :: test_ns_*]}
+    p1
+} -returnCodes error -cleanup {
+    unset x
+} -result {can't set "b(2)": variable isn't array}
+test upvar-8.9 {upvar won't create namespace variable that refers to procedure variable} -setup {
+    catch {namespace delete {*}[namespace children :: test_ns_*]}
     catch {rename MakeLink ""}
     namespace eval ::test_ns_1 {}
+} -returnCodes error -body {
     proc MakeLink {a} {
-        namespace eval ::test_ns_1 {
+	namespace eval ::test_ns_1 {
 	    upvar a a
-        }
-        unset ::test_ns_1::a
+	}
+	unset ::test_ns_1::a
     }
-    list [catch {MakeLink 1} msg] $msg
-} {1 {bad variable name "a": upvar won't create namespace variable that refers to procedure variable}}
-test upvar-8.10 {upvar will create element alias for new array element} {
+    MakeLink 1
+} -result {bad variable name "a": upvar won't create namespace variable that refers to procedure variable}
+test upvar-8.10 {upvar will create element alias for new array element} -setup {
     catch {unset upvarArray}
+} -body {
     array set upvarArray {}
     catch {upvar 0 upvarArray(elem) upvarArrayElemAlias}
-} {0}
-test upvar-8.11 {upvar will not create a variable that looks like an array} -body {
+} -result {0}
+test upvar-8.11 {upvar will not create a variable that looks like an array} -setup {
     catch {unset upvarArray}
+} -body {
     array set upvarArray {}
     upvar 0 upvarArray(elem) upvarArrayElemAlias(elem)
 } -returnCodes 1 -match glob -result *
@@ -405,6 +414,176 @@ test upvar-9.7 {Tcl_UpVar procedure} testupvar {
 } {1234}
 catch {unset a}
 
+test upvar-10.1 {CompileWord OBOE} -setup {
+    proc linenumber {} {dict get [info frame -1] line}
+} -body {
+    apply {n {
+        upvar 1 {*}{
+        } [return [incr n -[linenumber]]] x
+    }} [linenumber]
+} -cleanup {
+    rename linenumber {}
+} -result 1
+
+#
+# Tests for 'namespace upvar'. As the implementation is essentially the same as
+# for 'upvar', we only test that the variables are linked correctly, i.e., we
+# assume that the behaviour of variables once the link is established has
+# already been tested above.
+#
+
+# Clear out any namespaces called test_ns_*
+catch {namespace delete {*}[namespace children :: test_ns_*]}
+namespace eval test_ns_0 {
+    variable x test_ns_0
+}
+set ::x test_global
+
+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
+	}
+	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
+	}
+	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
+	}
+	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
+	}
+	proc a {} {
+	    namespace upvar test_ns_0 x w
+	    set w
+	}
+	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
+	}
+	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
+} -result {wrong # args: should be "namespace upvar ns ?otherVar myVar ...?"}
+test upvar-NS-2.2 {TIP 323} -setup {
+    namespace eval test_ns_1 {}
+} -body {
+    namespace upvar test_ns_1
+} -cleanup {
+    namespace delete test_ns_1
+} -result {}
+
+test upvar-NS-3.1 {CompileWord OBOE} -setup {
+    proc linenumber {} {dict get [info frame -1] line}
+} -body {
+    apply {n {
+        namespace upvar {*}{
+        } [return [incr n -[linenumber]]] x y
+    }} [linenumber]
+} -cleanup {
+    rename linenumber {}
+} -result 1
+test upvar-NS-3.2 {CompileWord OBOE} -setup {
+    proc linenumber {} {dict get [info frame -1] line}
+} -body {
+    apply {n {
+        namespace upvar :: {*}{
+        } [return [incr n -[linenumber]]] x
+    }} [linenumber]
+} -cleanup {
+    rename linenumber {}
+} -result 1
+test upvar-NS-3.3 {CompileWord OBOE} -setup {
+    proc linenumber {} {dict get [info frame -1] line}
+} -body {
+    apply {n {
+        variable x {*}{
+        } [return [incr n -[linenumber]]]
+    }} [linenumber]
+} -cleanup {
+    rename linenumber {}
+} -result 1
+
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/utf.test b/tests/utf.test
index 56a3acb..ebab967 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -7,14 +7,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: utf.test,v 1.12 2003/10/08 15:24:21 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 catch {unset x}
 
 test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} {
@@ -29,6 +30,12 @@ test utf-1.3 {Tcl_UniCharToUtf: 2 byte sequences} {
 test utf-1.4 {Tcl_UniCharToUtf: 3 byte sequences} {
     set x "\u4e4e"
 } [bytestring "\xe4\xb9\x8e"]
+test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} {
+    format %c 0x110000
+} [bytestring "\xef\xbf\xbd"]
+test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} {
+    format %c -1
+} [bytestring "\xef\xbf\xbd"]
 
 test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
     string length "abc"
@@ -167,7 +174,7 @@ bsCheck \x	120
 bsCheck \xa	10
 bsCheck \xA	10
 bsCheck \x41	65
-bsCheck \x541	65
+bsCheck \x541	84
 bsCheck \u	117
 bsCheck \uk	117
 bsCheck \u41	65
@@ -176,6 +183,18 @@ bsCheck \uA	10
 bsCheck \340	224
 bsCheck \ua1	161
 bsCheck \u4e21	20001
+bsCheck \741	60
+bsCheck \U	85
+bsCheck \Uk	85
+bsCheck \U41	65
+bsCheck \Ua	10
+bsCheck \UA	10
+bsCheck \Ua1	161
+bsCheck \U4e21	20001
+bsCheck \U004e21	20001
+bsCheck \U00004e21	20001
+bsCheck \U00110000	65533
+bsCheck \Uffffffff	65533
 
 test utf-11.1 {Tcl_UtfToUpper} {
     string toupper {}
@@ -243,8 +262,9 @@ test utf-16.1 {Tcl_UniCharToLower, negative delta} {
     string tolower aA
 } aa
 test utf-16.2 {Tcl_UniCharToLower, positive delta} {
-    string tolower \u0178\u00ff
-} \u00ff\u00ff
+    string tolower \u0178\u00ff\uA78D\u01c5
+} \u00ff\u00ff\u0265\u01c6
+
 test utf-17.1 {Tcl_UniCharToLower, no delta} {
     string tolower !
 } !
@@ -273,13 +293,53 @@ test utf-20.1 {TclUniCharNcmp} {
 } {}
 
 test utf-21.1 {TclUniCharIsAlnum} {
-    # this returns 1 with Unicode 3 compliance
-    string is alnum \u1040\u021f
+    # this returns 1 with Unicode 6 compliance
+    string is alnum \u1040\u021f\u0220
 } {1}
 test utf-21.2 {unicode alnum char in regc_locale.c} {
-    # this returns 1 with Unicode 3 compliance
-    list [regexp {^[[:alnum:]]+$} \u1040\u021f] [regexp {^\w+$} \u1040\u021f]
+    # this returns 1 with Unicode 6 compliance
+    list [regexp {^[[:alnum:]]+$} \u1040\u021f\u0220] [regexp {^\w+$} \u1040\u021f\u0220]
 } {1 1}
+test utf-21.3 {unicode print char in regc_locale.c} {
+    # this returns 1 with Unicode 6 compliance
+    regexp {^[[:print:]]+$} \ufbc1
+} 1
+test utf-21.4 {TclUniCharIsGraph} {
+    # [Bug 3464428]
+    string is graph \u0120
+} {1}
+test utf-21.5 {unicode graph char in regc_locale.c} {
+    # [Bug 3464428]
+    regexp {^[[:graph:]]+$} \u0120
+} {1}
+test utf-21.6 {TclUniCharIsGraph} {
+    # [Bug 3464428]
+    string is graph \u00a0
+} {0}
+test utf-21.7 {unicode graph char in regc_locale.c} {
+    # [Bug 3464428]
+    regexp {[[:graph:]]} \u0020\u00a0\u2028\u2029
+} {0}
+test utf-21.8 {TclUniCharIsPrint} {
+    # [Bug 3464428]
+    string is print \u0009
+} {0}
+test utf-21.9 {unicode print char in regc_locale.c} {
+    # [Bug 3464428]
+    regexp {[[:print:]]} \u0009
+} {0}
+test utf-21.10 {unicode print char in regc_locale.c} {
+    # [Bug 3464428]
+    regexp {[[:print:]]} \u0009
+} {0}
+test utf-21.11 {TclUniCharIsControl} {
+    # [Bug 3464428]
+    string is control \u00ad
+} {1}
+test utf-21.12 {unicode control char in regc_locale.c} {
+    # [Bug 3464428], [Bug a876646efe]
+    regexp {^[[:cntrl:]]*$} \u0000\u001f\u00ad
+} {1}
 
 test utf-22.1 {TclUniCharIsWordChar} {
     string wordend "xyz123_bar fg" 0
@@ -289,66 +349,100 @@ test utf-22.2 {TclUniCharIsWordChar} {
 } 10
 
 test utf-23.1 {TclUniCharIsAlpha} {
-    # this returns 1 with Unicode 3 compliance
-    string is alpha \u021f
+    # this returns 1 with Unicode 6 compliance
+    string is alpha \u021f\u0220
 } {1}
 test utf-23.2 {unicode alpha char in regc_locale.c} {
-    # this returns 1 with Unicode 3 compliance
-    regexp {^[[:alpha:]]+$} \u021f
+    # this returns 1 with Unicode 6 compliance
+    regexp {^[[:alpha:]]+$} \u021f\u0220
 } {1}
 
 test utf-24.1 {TclUniCharIsDigit} {
-    # this returns 1 with Unicode 3 compliance
-    string is digit \u1040
+    # this returns 1 with Unicode 6 compliance
+    string is digit \u1040\uabf0
 } {1}
 test utf-24.2 {unicode digit char in regc_locale.c} {
-    # this returns 1 with Unicode 3 compliance
-    list [regexp {^[[:digit:]]+$} \u1040] [regexp {^\d+$} \u1040]
+    # this returns 1 with Unicode 6 compliance
+    list [regexp {^[[:digit:]]+$} \u1040\uabf0] [regexp {^\d+$} \u1040\uabf0]
 } {1 1}
 
 test utf-24.3 {TclUniCharIsSpace} {
-    # this returns 1 with Unicode 3 compliance
-    string is space \u1680
+    # this returns 1 with Unicode 6 compliance
+    string is space \u1680\u180e
 } {1}
 test utf-24.4 {unicode space char in regc_locale.c} {
-    # this returns 1 with Unicode 3 compliance
-    list [regexp {^[[:space:]]+$} \u1680] [regexp {^\s+$} \u1680]
+    # this returns 1 with Unicode 6 compliance
+    list [regexp {^[[:space:]]+$} \u1680\u180e] [regexp {^\s+$} \u1680\u180e]
 } {1 1}
 
 testConstraint teststringobj [llength [info commands teststringobj]]
-test utf-25.1 {Tcl_UniCharNcasecmp} teststringobj {
-    testobj freeallvars
-    teststringobj set 1 a
-    teststringobj set 2 b
-    teststringobj getunicode 1
-    teststringobj getunicode 2
-    string compare -nocase [teststringobj get 1] [teststringobj get 2]
-} -1
-test utf-25.2 {Tcl_UniCharNcasecmp} teststringobj {
-    testobj freeallvars
-    teststringobj set 1 b
-    teststringobj set 2 a
-    teststringobj getunicode 1
-    teststringobj getunicode 2
-    string compare -nocase [teststringobj get 1] [teststringobj get 2]
-} 1
-test utf-25.3 {Tcl_UniCharNcasecmp} teststringobj {
-    testobj freeallvars
-    teststringobj set 1 B
-    teststringobj set 2 a
-    teststringobj getunicode 1
-    teststringobj getunicode 2
-    string compare -nocase [teststringobj get 1] [teststringobj get 2]
-} 1
-test utf-25.4 {Tcl_UniCharNcasecmp} teststringobj {
-    testobj freeallvars
-    teststringobj set 1 aBcB
-    teststringobj set 2 abca
-    teststringobj getunicode 1
-    teststringobj getunicode 2
-    string compare -nocase [teststringobj get 1] [teststringobj get 2]
-} 1
+
+test utf-25.1 {Tcl_UniCharNcasecmp} -constraints teststringobj \
+    -setup {
+	testobj freeallvars
+    } \
+    -body {
+	teststringobj set 1 a
+	teststringobj set 2 b
+	teststringobj getunicode 1
+	teststringobj getunicode 2
+	string compare -nocase [teststringobj get 1] [teststringobj get 2]
+    } \
+    -cleanup {
+	testobj freeallvars
+    } \
+    -result -1
+test utf-25.2 {Tcl_UniCharNcasecmp} -constraints teststringobj \
+    -setup {
+	testobj freeallvars
+    } \
+    -body {
+	teststringobj set 1 b
+	teststringobj set 2 a
+	teststringobj getunicode 1
+	teststringobj getunicode 2
+	string compare -nocase [teststringobj get 1] [teststringobj get 2]
+    } \
+    -cleanup {
+	testobj freeallvars
+    } \
+    -result 1
+test utf-25.3 {Tcl_UniCharNcasecmp} -constraints teststringobj \
+    -setup {
+	testobj freeallvars
+    } \
+    -body {
+	teststringobj set 1 B
+	teststringobj set 2 a
+	teststringobj getunicode 1
+	teststringobj getunicode 2
+	string compare -nocase [teststringobj get 1] [teststringobj get 2]
+    } \
+    -cleanup {
+	testobj freeallvars
+    } \
+    -result 1
+
+test utf-25.4 {Tcl_UniCharNcasecmp} -constraints teststringobj \
+    -setup {
+	testobj freeallvars
+    } \
+    -body {
+	teststringobj set 1 aBcB
+	teststringobj set 2 abca
+	teststringobj getunicode 1
+	teststringobj getunicode 2
+	string compare -nocase [teststringobj get 1] [teststringobj get 2]
+    } \
+    -cleanup {
+	testobj freeallvars
+    } \
+    -result 1
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/util.test b/tests/util.test
index da243cd..0e50483 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -6,14 +6,20 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: util.test,v 1.17 2005/05/12 22:48:18 dgp Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint controversialNaN 1
+testConstraint testdstring [llength [info commands testdstring]]
+testConstraint testconcatobj [llength [info commands testconcatobj]]
+testConstraint testdoubledigits [llength [info commands testdoubledigits]]
+
 # Big test for correct ordering of data in [expr]
 
 proc testIEEE {} {
@@ -40,6 +46,10 @@ proc testIEEE {} {
 		ieeeValues(+Infinity)
 	    binary scan \x00\x00\x00\x00\x00\x00\xf8\x7f d \
 		ieeeValues(NaN)
+	    binary scan \x00\x00\x00\x00\x00\x00\xf8\xff d \
+		ieeeValues(-NaN)
+	    binary scan \xef\xcd\xab\x89\x67\x45\xfb\xff d \
+		ieeeValues(-NaN(3456789abcdef))
 	    set ieeeValues(littleEndian) 1
 	    return 1
 	}
@@ -62,6 +72,10 @@ proc testIEEE {} {
 		ieeeValues(+Infinity)
 	    binary scan \x7f\xf8\x00\x00\x00\x00\x00\x00 d \
 		ieeeValues(NaN)
+	    binary scan \xff\xf8\x00\x00\x00\x00\x00\x00 d \
+		ieeeValues(-NaN)
+	    binary scan \xff\xfb\x45\x67\x89\xab\xcd\xef d \
+		ieeeValues(-NaN(3456789abcdef))
 	    set ieeeValues(littleEndian) 0
 	    return 1
 	}
@@ -70,7 +84,7 @@ proc testIEEE {} {
 	}
     }
 }
-::tcltest::testConstraint ieeeFloatingPoint [testIEEE]
+testConstraint ieeeFloatingPoint [testIEEE]
 
 proc convertDouble { x } {
     variable ieeeValues
@@ -82,6 +96,31 @@ proc convertDouble { x } {
     return $result
 }
 
+proc verdonk_test {sig binexp shouldbe exp} {
+    regexp {([-+]?)([0-9a-f]+)} $sig -> signum sig
+    scan $sig %llx sig
+    if {$signum eq {-}} {
+	set signum [expr 1<<63]
+    } else {
+	set signum 0
+    }
+    regexp {E([-+]?[0-9]+)} $binexp -> binexp
+    set word [expr {$signum | (($binexp + 0x3ff)<<52)|($sig & ~(1<<52))}]
+    binary scan [binary format w $word] q double
+    regexp {([-+])(\d+)_(\d+)\&} $shouldbe -> signum digits1 digits2
+    regexp {E([-+]\d+)} $exp -> decexp
+    incr decexp [expr {[string length $digits1] - 1}]
+    lassign [testdoubledigits $double [string length $digits1] e] \
+	outdigits decpt outsign
+    if {[string index $digits2 0] >= 5} {
+	incr digits1
+    }
+    if {$outsign != $signum || $outdigits != $digits1 || $decpt != $decexp} {
+	return -code error "result is ${outsign}0.${outdigits}E$decpt\
+                            should be ${signum}0.${digits1}E$decexp"
+    }
+}
+
 test util-1.1 {TclFindElement procedure - binary element in middle of list} {
     lindex {0 foo\x00help 1} 1
 } "foo\x00help"
@@ -102,7 +141,6 @@ test util-3.1 {Tcl_ScanCountedElement procedure - don't leave unmatched braces}
     # have the property that it can be enclosing in curly braces to make
     # an embedded sub-list.  If this property doesn't hold, then
     # Tcl_DStringStartSublist doesn't work.
-
     set x {}
     lappend x "# \\\{ \\"
     concat $x [llength "{$x}"]
@@ -141,6 +179,13 @@ test util-3.5.1 {Tcl_ConverCountedElement procedure - quote leading '#'} {
     rename #\{ {}
     set result
 } {#}
+test util-3.6 {Tcl_ConvertElement, Bug 3371644} {
+    interp create #\\
+    interp alias {} x #\\ concat
+    interp target {} x ;# Crash if bug not fixed
+    interp delete #\\
+} {}
+
 test util-4.1 {Tcl_ConcatObj - backslash-space at end of argument} {
     concat a {b\ } c
 } {a b\  c}
@@ -160,6 +205,11 @@ test util-4.6 {Tcl_ConcatObj - utf-8 sequence with "whitespace" char} {
     # Check for Bug #227512.  If this violates C isspace, then it returns \xc3.
     concat \xe0
 } \xe0
+test util-4.7 {Tcl_ConcatObj - refCount safety} testconcatobj {
+    # Check for Bug #1447328 (actually, bugs in its original "fix"). One of the
+    # symptoms was Bug #2055782. 
+    testconcatobj
+} {}
 
 proc Wrapper_Tcl_StringMatch {pattern string} {
     # Forces use of Tcl_StringMatch, not Tcl_UniCharCaseMatch
@@ -191,7 +241,6 @@ test util-5.8 {Tcl_StringMatch} {
 } 1
 test util-5.9 {Tcl_StringMatch: UTF-8} {
     # skip one character in string
-
     Wrapper_Tcl_StringMatch a?c a\u4e4fc
 } 1
 test util-5.10 {Tcl_StringMatch} {
@@ -205,19 +254,16 @@ test util-5.12 {Tcl_StringMatch} {
 } 1
 test util-5.13 {Tcl_StringMatch: UTF-8} {
     # string += Tcl_UtfToUniChar(string, &ch);
-
     Wrapper_Tcl_StringMatch "\[\u4e4fxy\]bc" "\u4e4fbc"
 } 1
 test util-5.14 {Tcl_StringMatch} {
     # if ((*pattern == ']') || (*pattern == '\0'))
     # badly formed pattern
-
     Wrapper_Tcl_StringMatch {[]} {[]}
 } 0
 test util-5.15 {Tcl_StringMatch} {
     # if ((*pattern == ']') || (*pattern == '\0'))
     # badly formed pattern
-
     Wrapper_Tcl_StringMatch {[} {[}
 } 0
 test util-5.16 {Tcl_StringMatch} {
@@ -226,19 +272,16 @@ test util-5.16 {Tcl_StringMatch} {
 test util-5.17 {Tcl_StringMatch: UTF-8} {
     # pattern += Tcl_UtfToUniChar(pattern, &endChar);
     # get 1 UTF-8 character
-
     Wrapper_Tcl_StringMatch "a\[a\u4e4fc]c" "a\u4e4fc"
 } 1
 test util-5.18 {Tcl_StringMatch: UTF-8} {
     # pattern += Tcl_UtfToUniChar(pattern, &endChar);
     # proper advance: wrong answer would match on UTF trail byte of \u4e4f
-
     Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} [bytestring a\u008fc]
 } 0
 test util-5.19 {Tcl_StringMatch: UTF-8} {
     # pattern += Tcl_UtfToUniChar(pattern, &endChar);
     # proper advance.
-
     Wrapper_Tcl_StringMatch {a[a\u4e4fc]c} "acc"
 } 1
 test util-5.20 {Tcl_StringMatch} {
@@ -319,7 +362,6 @@ test util-5.44 {Tcl_StringMatch: skip correct number of ']'} {
 test util-5.45 {Tcl_StringMatch} {
     # if (*pattern == '\0')
     # badly formed pattern, still treats as a set
-
     Wrapper_Tcl_StringMatch {[a} a
 } 1
 test util-5.46 {Tcl_StringMatch} {
@@ -373,7 +415,6 @@ test util-6.4 {Tcl_PrintDouble - using tcl_precision} -setup {
 } -cleanup {
     set tcl_precision $old_precision
 } -result {x1.1234}
-
 test util-6.5 {Tcl_PrintDouble - make sure there's a decimal point} {
     concat x[expr 2.0]
 } {x2.0}
@@ -440,9 +481,6 @@ test util-8.1 {TclNeedSpace - correct UTF8 handling} {
     interp delete \u5420
     set result
 } "\u5420 foo"
-
-testConstraint testdstring [expr {[info commands testdstring] != {}}]
-
 test util-8.2 {TclNeedSpace - correct UTF8 handling} testdstring {
     # Bug 411825
     # This tests the same bug as the previous test, but
@@ -1109,6 +1147,2881 @@ test util-11.23 {Tcl_PrintDouble - scaling} {
     expr 1.1e17
 } {1.1e+17}
 
+test util-12.1 {TclDoubleDigits - Inf} {testdoubledigits ieeeFloatingPoint} {
+     testdoubledigits Inf -1 shortest
+} {Infinity 9999 +}
+test util-12.2 {TclDoubleDigits - -Inf} {testdoubledigits ieeeFloatingPoint} {
+     testdoubledigits -Inf -1 shortest
+} {Infinity 9999 -}
+test util-12.3 {TclDoubleDigits - NaN} {testdoubledigits ieeeFloatingPoint} {
+     testdoubledigits $ieeeValues(NaN) -1 shortest
+} {NaN 9999 +}
+test util-12.4 {TclDoubleDigits - NaN} {*}{
+     -constraints {testdoubledigits ieeeFloatingPoint controversialNaN}
+     -body {
+	 testdoubledigits -NaN -1 shortest
+     }
+    -result {NaN 9999 -}
+}
+test util-12.5 {TclDoubleDigits - 0} testdoubledigits {
+     testdoubledigits 0.0 -1 shortest
+} {0 0 +}
+test util-12.6 {TclDoubleDigits - -0} testdoubledigits {
+     testdoubledigits -0.0 -1 shortest
+} {0 0 -}
+
+# Verdonk test vectors
+
+test util-13.1 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1754e31cd072da E+1008 +4_000000000000000000& E+303
+    }
+    -result {}
+}
+test util-13.2 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1afcef51f0fb5f E+265 -1_000000000000000000& E+80
+    }
+    -result {}
+}
+test util-13.3 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1754e31cd072da E+1006 +1_000000000000000000& E+303
+    }
+    -result {}
+}
+test util-13.4 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1754e31cd072da E+1007 -2_000000000000000000& E+303
+    }
+    -result {}
+}
+test util-13.5 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1e07b27dd78b14 E-848 +1_00000000000000000& E-255
+    }
+    -result {}
+}
+test util-13.6 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1e29e9c56687fe E-709 -7_00000000000000000& E-214
+    }
+    -result {}
+}
+test util-13.7 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1be03d0bf225c7 E-137 +1_00000000000000000& E-41
+    }
+    -result {}
+}
+test util-13.8 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1a2fe76a3f9475 E-499 -1_00000000000000000& E-150
+    }
+    -result {}
+}
+test util-13.9 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 19a2028368022e E+1019 +8_999999999999999999& E+306
+    }
+    -result {}
+}
+test util-13.10 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1317e5ef3ab327 E+509 -1_999999999999999999& E+153
+    }
+    -result {}
+}
+test util-13.11 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1317e5ef3ab327 E+510 +3_99999999999999999& E+153
+    }
+    -result {}
+}
+test util-13.12 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1317e5ef3ab327 E+511 -7_99999999999999999& E+153
+    }
+    -result {}
+}
+test util-13.13 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1eb8e84fa0b278 E-1008 +6_999999999999999999& E-304
+    }
+    -result {}
+}
+test util-13.14 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -13339131c46f8b E-1004 -6_999999999999999999& E-303
+    }
+    -result {}
+}
+test util-13.15 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1c0f92a6276c9d E-162 +2_999999999999999999& E-49
+    }
+    -result {}
+}
+test util-13.16 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -15ce1f143d7ad2 E-443 -5_99999999999999999& E-134
+    }
+    -result {}
+}
+test util-13.17 {just over exact - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1c0794d9d40e96 E-301 +43_000000000000000000& E-92
+    }
+    -result {}
+}
+test util-13.18 {just over exact - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1c0794d9d40e96 E-300 -86_000000000000000000& E-92
+    }
+    -result {}
+}
+test util-13.19 {just over exact - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1cd5bee57763e6 E-241 +51_000000000000000000& E-74
+    }
+    -result {}
+}
+test util-13.20 {just under exact - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1d1c26db7d0dae E+651 +16_999999999999999999& E+195
+    }
+    -result {}
+}
+test util-13.21 {just under exact - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -13f7ced916872b E-5 -38_999999999999999999& E-3
+    }
+    -result {}
+}
+test util-13.22 {just over exact - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 17d93193f78fc6 E+588 +151_0000000000000000000& E+175
+    }
+    -result {}
+}
+test util-13.23 {just over exact - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1a82a1631eeb30 E-625 -119_000000000000000000& E-190
+    }
+    -result {}
+}
+test util-13.24 {just under exact - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -16c309024bab4b E+290 -282_999999999999999999& E+85
+    }
+    -result {}
+}
+test util-13.25 {just over exact - 8 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1dbbac6f83a821 E-800 +27869147_0000000000000000000& E-248
+    }
+    -result {}
+}
+test util-13.26 {just under exact - 9 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1c569e968e0944 E+430 -491080653_9999999999999999999& E+121
+    }
+    -result {}
+}
+test util-13.27 {just under exact - 9 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1c569e968e0944 E+429 +245540326_9999999999999999999& E+121
+    }
+    -result {}
+}
+test util-13.28 {just over exact - 10 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1fc575867314ee E-330 -9078555839_0000000000000000000& E-109
+    }
+    -result {}
+}
+test util-13.29 {just under exact - 10 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1c569e968e0944 E+428 -1227701634_9999999999999999999& E+120
+    }
+    -result {}
+}
+test util-13.30 {just over exact - 11 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1fc575867314ee E-329 +18157111678_0000000000000000000& E-109
+    }
+    -result {}
+}
+test util-13.31 {just over exact - 14 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -18bf7e7fa6f02a E-196 -15400733123779_0000000000000000000& E-72
+    }
+    -result {}
+}
+test util-13.32 {just over exact - 17 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -13de005bd620df E+217 -26153245263757307_0000000000000000000& E+49
+    }
+    -result {}
+}
+test util-13.33 {just over exact - 18 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1f92bacb3cb40c E+718 +272104041512242479_0000000000000000000& E+199
+    }
+    -result {}
+}
+test util-13.34 {just over exact - 18 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1f92bacb3cb40c E+719 -544208083024484958_0000000000000000000& E+199
+    }
+    -result {}
+}
+test util-13.35 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 142dbf25096cf5 E+148 +4_500000000000000000& E+44
+    }
+    -result {}
+}
+test util-13.36 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1afcef51f0fb5f E+263 -2_500000000000000000& E+79
+    }
+    -result {}
+}
+test util-13.37 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 102498ea6df0c4 E+145 +4_500000000000000000& E+43
+    }
+    -result {}
+}
+test util-13.38 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1754e31cd072da E+1004 -2_500000000000000000& E+302
+    }
+    -result {}
+}
+test util-13.39 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 12deac01e2b4f7 E-557 +2_50000000000000000& E-168
+    }
+    -result {}
+}
+test util-13.40 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1b1df536c13eee E-307 -6_50000000000000000& E-93
+    }
+    -result {}
+}
+test util-13.41 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 10711fed5b19a4 E-154 +4_50000000000000000& E-47
+    }
+    -result {}
+}
+test util-13.42 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -148d67e8b1e00d E-151 -4_50000000000000000& E-46
+    }
+    -result {}
+}
+test util-13.43 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1c8c574c0c6be7 E+187 +3_49999999999999999& E+56
+    }
+    -result {}
+}
+test util-13.44 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1756183c147514 E+206 -1_49999999999999999& E+62
+    }
+    -result {}
+}
+test util-13.45 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 12ab469676c410 E+203 +1_49999999999999999& E+61
+    }
+    -result {}
+}
+test util-13.46 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1539684e774b48 E+246 -1_49999999999999999& E+74
+    }
+    -result {}
+}
+test util-13.47 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 12e5f5dfa4fe9d E-286 +9_499999999999999999& E-87
+    }
+    -result {}
+}
+test util-13.48 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1bdc2417bf7787 E-838 -9_499999999999999999& E-253
+    }
+    -result {}
+}
+test util-13.49 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1eb8e84fa0b278 E-1009 +3_499999999999999999& E-304
+    }
+    -result {}
+}
+test util-13.50 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1e3cbc9907fdc8 E-290 -9_499999999999999999& E-88
+    }
+    -result {}
+}
+test util-13.51 {just over half ulp - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 10ad836f269a17 E-324 +30_500000000000000000& E-99
+    }
+    -result {}
+}
+test util-13.52 {just over half ulp - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1b39ae1909c31b E-687 -26_500000000000000000& E-208
+    }
+    -result {}
+}
+test util-13.53 {just over half ulp - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1b2ab18615fcc6 E-576 +686_500000000000000000& E-176
+    }
+    -result {}
+}
+test util-13.54 {just over half ulp - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -13e1f90a573064 E-624 -178_500000000000000000& E-190
+    }
+    -result {}
+}
+test util-13.55 {just under half ulp - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 16c309024bab4b E+289 +141_499999999999999999& E+85
+    }
+    -result {}
+}
+test util-13.56 {just under half ulp - 4 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -159bd3ad46e346 E+193 -1695_499999999999999999& E+55
+    }
+    -result {}
+}
+test util-13.57 {just under half ulp - 4 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1df4170f0fdecc E+124 +3981_499999999999999999& E+34
+    }
+    -result {}
+}
+test util-13.58 {just over half ulp - 6 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 17e1e0f1c7a4ac E+415 +126300_5000000000000000000& E+120
+    }
+    -result {}
+}
+test util-13.59 {just over half ulp - 6 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1dda592e398dd7 E+418 -126300_5000000000000000000& E+121
+    }
+    -result {}
+}
+test util-13.60 {just under half ulp - 7 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1e597c0b94b7ae E+453 -4411845_499999999999999999& E+130
+    }
+    -result {}
+}
+test util-13.61 {just under half ulp - 9 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1c569e968e0944 E+427 +613850817_4999999999999999999& E+120
+    }
+    -result {}
+}
+test util-13.62 {just under half ulp - 9 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1c569e968e0944 E+428 -122770163_49999999999999999999& E+121
+    }
+    -result {}
+}
+test util-13.63 {just over half ulp - 18 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 17ae0c186d8709 E+719 +408156062268363718_5000000000000000000& E+199
+    }
+    -result {}
+}
+test util-13.64 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 152d02c7e14af7 E+76 +1_0000000000000000& E+23
+    }
+    -result {}
+}
+test util-13.65 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -19d971e4fe8402 E+89 -1_0000000000000000& E+27
+    }
+    -result {}
+}
+test util-13.66 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 19d971e4fe8402 E+90 +2_0000000000000000& E+27
+    }
+    -result {}
+}
+test util-13.67 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -19d971e4fe8402 E+91 -4_0000000000000000& E+27
+    }
+    -result {}
+}
+test util-13.68 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 15798ee2308c3a E-27 +1_0000000000000000& E-8
+    }
+    -result {}
+}
+test util-13.69 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -15798ee2308c3a E-26 -2_0000000000000000& E-8
+    }
+    -result {}
+}
+test util-13.70 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 15798ee2308c3a E-25 +4_0000000000000000& E-8
+    }
+    -result {}
+}
+test util-13.71 {just over exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1ef2d0f5da7dd9 E-84 -1_0000000000000000& E-25
+    }
+    -result {}
+}
+test util-13.72 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1a784379d99db4 E+78 +4_9999999999999999& E+23
+    }
+    -result {}
+}
+test util-13.73 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1a784379d99db4 E+80 -1_9999999999999999& E+24
+    }
+    -result {}
+}
+test util-13.74 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 13da329b633647 E+81 +2_9999999999999999& E+24
+    }
+    -result {}
+}
+test util-13.75 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1cf389cd46047d E+85 -6_9999999999999999& E+25
+    }
+    -result {}
+}
+test util-13.76 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 19999999999999 E-3 +1_99999999999999999& E-1
+    }
+    -result {}
+}
+test util-13.77 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -13333333333333 E-2 -2_99999999999999999& E-1
+    }
+    -result {}
+}
+test util-13.78 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 16849b86a12b9b E-48 +4_99999999999999999& E-15
+    }
+    -result {}
+}
+test util-13.79 {just under exact - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -16849b86a12b9b E-46 -1_99999999999999999& E-14
+    }
+    -result {}
+}
+test util-13.80 {just over exact - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 17ccfc73126788 E-71 +63_00000000000000000& E-23
+    }
+    -result {}
+}
+test util-13.81 {just over exact - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1dc03b8fd7016a E-68 -63_00000000000000000& E-22
+    }
+    -result {}
+}
+test util-13.82 {just under exact - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 13f7ced916872b E-5 +38_999999999999999999& E-3
+    }
+    -result {}
+}
+test util-13.83 {just over exact - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1b297cad9f70b6 E+97 +269_000000000000000000& E+27
+    }
+    -result {}
+}
+test util-13.84 {just over exact - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1b297cad9f70b6 E+98 -538_00000000000000000& E+27
+    }
+    -result {}
+}
+test util-13.85 {just over exact - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1cdc06b20ef183 E-82 +373_00000000000000000& E-27
+    }
+    -result {}
+}
+test util-13.86 {just over exact - 4 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1b297cad9f70b6 E+96 +1345_00000000000000000& E+26
+    }
+    -result {}
+}
+# this one is not 4 digits, it is 3, and it is covered above.
+test util-13.87 {just over exact - 4 digits} {*}{
+    -constraints {testdoubledigits knownBadTest}
+    -body {
+        verdonk_test -1b297cad9f70b6 E+97 -2690_00000000000000000& E+26
+    }
+    -result {}
+}
+test util-13.88 {just over exact - 5 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -150a246ecd44f3 E-63 -14257_00000000000000000& E-23
+    }
+    -result {}
+}
+test util-13.89 {just under exact - 6 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -119b96f36ec68b E-19 -209900_999999999999999999& E-11
+    }
+    -result {}
+}
+test util-13.90 {just over exact - 11 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1c06d366394441 E-35 +50980203373_000000000000000000& E-21
+    }
+    -result {}
+}
+test util-13.91 {just under exact - 12 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1f58ac4db68c90 E+122 -104166211810_99999999999999999& E+26
+    }
+    -result {}
+}
+test util-13.92 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 19d971e4fe8402 E+87 +2_5000000000000000& E+26
+    }
+    -result {}
+}
+test util-13.93 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1dc74be914d16b E+81 -4_500000000000000& E+24
+    }
+    -result {}
+}
+test util-13.94 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 14adf4b7320335 E+84 +2_500000000000000& E+25
+    }
+    -result {}
+}
+test util-13.95 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1ae22487c1042b E+85 -6_5000000000000000& E+25
+    }
+    -result {}
+}
+test util-13.96 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 187fe49aab41e0 E-54 +8_5000000000000000& E-17
+    }
+    -result {}
+}
+test util-13.97 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1f5c05e4b23fd7 E-61 -8_5000000000000000& E-19
+    }
+    -result {}
+}
+test util-13.98 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1faa7ab552a552 E-42 +4_5000000000000000& E-13
+    }
+    -result {}
+}
+test util-13.99 {just over half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1b7cdfd9d7bdbb E-36 -2_5000000000000000& E-11
+    }
+    -result {}
+}
+test util-13.100 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 13da329b633647 E+80 +1_4999999999999999& E+24
+    }
+    -result {}
+}
+test util-13.101 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1cf389cd46047d E+84 -3_49999999999999999& E+25
+    }
+    -result {}
+}
+test util-13.102 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1f04ef12cb04cf E+85 +7_4999999999999999& E+25
+    }
+    -result {}
+}
+test util-13.103 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1f04ef12cb04cf E+86 -1_4999999999999999& E+26
+    }
+    -result {}
+}
+test util-13.104 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 13333333333333 E-3 +1_49999999999999999& E-1
+    }
+    -result {}
+}
+test util-13.105 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -107e1fe91b0b70 E-36 -1_49999999999999999& E-11
+    }
+    -result {}
+}
+test util-13.106 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 149da7e361ce4c E-33 +1_49999999999999999& E-10
+    }
+    -result {}
+}
+test util-13.107 {just under half ulp - 1 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -19c511dc3a41df E-30 -1_49999999999999999& E-9
+    }
+    -result {}
+}
+test util-13.108 {just over half ulp - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1aa83d74267822 E+93 -16_5000000000000000& E+27
+    }
+    -result {}
+}
+test util-13.109 {just over half ulp - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 18f1d5969453de E+89 +96_5000000000000000& E+25
+    }
+    -result {}
+}
+test util-13.110 {just over half ulp - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 11d9bd564dcda6 E-70 +94_50000000000000000& E-23
+    }
+    -result {}
+}
+test util-13.111 {just over half ulp - 2 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1a58973ecbede6 E-48 -58_50000000000000000& E-16
+    }
+    -result {}
+}
+test util-13.112 {just over half ulp - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1b297cad9f70b6 E+95 +672_50000000000000000& E+26
+    }
+    -result {}
+}
+test util-13.113 {just over half ulp - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -1b297cad9f70b6 E+96 -134_500000000000000000& E+27
+    }
+    -result {}
+}
+test util-13.114 {just over half ulp - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1cdc06b20ef183 E-83 +186_50000000000000000& E-27
+    }
+    -result {}
+}
+test util-13.115 {just over half ulp - 3 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -136071dcae4565 E-47 -860_50000000000000000& E-17
+    }
+    -result {}
+}
+test util-13.116 {just over half ulp - 6 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1cb968d297dde8 E+99 +113788_50000000000000000& E+25
+    }
+    -result {}
+}
+test util-13.117 {just over half ulp - 6 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test -11f3e1839eeab1 E+103 -113788_50000000000000000& E+26
+    }
+    -result {}
+}
+test util-13.118 {just under half ulp - 9 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1e9cec176c96f8 E+117 +317903333_49999999999999999& E+27
+    }
+    -result {}
+}
+test util-13.119 {just over half ulp - 11 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1c06d366394441 E-36 +25490101686_500000000000000000& E-21
+    }
+    -result {}
+}
+test util-13.120 {just under half ulp - 11 digits} {*}{
+    -constraints testdoubledigits
+    -body {
+        verdonk_test 1f58ac4db68c90 E+121 +52083105905_49999999999999999& E+26
+    }
+    -result {}
+}
+
+test util-14.1 {funky NaN} {*}{
+    -constraints {ieeeFloatingPoint controversialNaN}
+    -body {
+	set ieeeValues(-NaN)
+    }
+    -result -NaN
+}
+
+test util-14.2 {funky NaN} {*}{
+    -constraints {ieeeFloatingPoint controversialNaN}
+    -body {
+	set ieeeValues(-NaN(3456789abcdef))
+    }
+    -result -NaN(3456789abcdef)
+}
+
+test util-15.1 {largest subnormal} {*}{
+    -body {
+	binary scan [binary format w 0x000fffffffffffff] q x
+	set x
+    }
+    -result 2.225073858507201e-308
+    -cleanup {
+	unset x
+    }
+}
+
+test util-15.2 {largest subnormal} {*}{
+    -body {
+	binary scan [binary format w 0x800fffffffffffff] q x
+	set x
+    }
+    -result -2.225073858507201e-308
+    -cleanup {
+	unset x
+    }
+}
+
+test util-15.3 {largest subnormal} {*}{
+    -body {
+	binary scan [binary format q 2.225073858507201e-308] w x
+	format %#lx $x
+    }
+    -result 0xfffffffffffff
+    -cleanup {
+	unset x
+    }
+}
+
+test util-15.4 {largest subnormal} {*}{
+    -body {
+	binary scan [binary format q -2.225073858507201e-308] w x
+	format %#lx $x
+    }
+    -result 0x800fffffffffffff
+    -cleanup {
+	unset x
+    }
+}
+
+test util-15.5 {smallest normal} {*}{
+    -body {
+	binary scan [binary format w 0x0010000000000000] q x
+	set x
+    }
+    -result 2.2250738585072014e-308
+    -cleanup {
+	unset x
+    }
+}
+
+test util-15.6 {smallest normal} {*}{
+    -body {
+	binary scan [binary format w 0x8010000000000000] q x
+	set x
+    }
+    -result -2.2250738585072014e-308
+    -cleanup {
+	unset x
+    }
+}
+
+test util-15.7 {smallest normal} {*}{
+    -body {
+	binary scan [binary format q 2.2250738585072014e-308] w x
+	format %#lx $x
+    }
+    -result 0x10000000000000
+    -cleanup {
+	unset x
+    }
+}
+
+test util-15.8 {smallest normal} {*}{
+    -body {
+	binary scan [binary format q -2.2250738585072014e-308] w x
+	format %#lx $x
+    }
+    -result 0x8010000000000000
+    -cleanup {
+	unset x
+    }
+}
+
+set saved_precision $::tcl_precision
+foreach ::tcl_precision {0 12} {
+    for {set e -312} {$e < -9} {incr e} {
+	test util-16.1.$::tcl_precision.$e {shortening of numbers} \
+	    "expr 1.1e$e" 1.1e$e
+    }
+}
+set tcl_precision 0
+for {set e -9} {$e < -4} {incr e} {
+    test util-16.1.$::tcl_precision.$e {shortening of numbers} \
+	"expr 1.1e$e" 1.1e$e
+}
+set tcl_precision 12
+for {set e -9} {$e < -4} {incr e} {
+    test util-16.1.$::tcl_precision.$e {8.4 compatible formatting of doubles} \
+	"expr 1.1e$e" 1.1e[format %+03d $e]
+}
+foreach ::tcl_precision {0 12} {
+    test util-16.1.$::tcl_precision.-4 {shortening of numbers} \
+	{expr 1.1e-4} \
+	0.00011
+    test util-16.1.$::tcl_precision.-3 {shortening of numbers} \
+	{expr 1.1e-3} \
+	0.0011
+    test util-16.1.$::tcl_precision.-2 {shortening of numbers} \
+	{expr 1.1e-2} \
+	0.011
+    test util-16.1.$::tcl_precision.-1 {shortening of numbers} \
+	{expr 1.1e-1} \
+	0.11
+    test util-16.1.$::tcl_precision.0 {shortening of numbers} \
+	{expr 1.1} \
+	1.1
+    for {set e 1} {$e < 17} {incr e} {
+	test util-16.1.$::tcl_precision.$e {shortening of numbers} \
+	    "expr 11[string repeat 0 [expr {$e-1}]].0" \
+	    11[string repeat 0 [expr {$e-1}]].0
+    }
+    for {set e 17} {$e < 309} {incr e} {
+	test util-16.1.$::tcl_precision.$e {shortening of numbers} \
+	    "expr 1.1e$e" 1.1e+$e
+    }
+}
+set tcl_precision 17
+test util-16.1.17.-300 {8.4 compatible formatting of doubles} \
+    {expr 1e-300} \
+    1e-300
+test util-16.1.17.-299 {8.4 compatible formatting of doubles} \
+    {expr 1e-299} \
+    9.9999999999999999e-300
+test util-16.1.17.-298 {8.4 compatible formatting of doubles} \
+    {expr 1e-298} \
+    9.9999999999999991e-299
+test util-16.1.17.-297 {8.4 compatible formatting of doubles} \
+    {expr 1e-297} \
+    1e-297
+test util-16.1.17.-296 {8.4 compatible formatting of doubles} \
+    {expr 1e-296} \
+    1e-296
+test util-16.1.17.-295 {8.4 compatible formatting of doubles} \
+    {expr 1e-295} \
+    1.0000000000000001e-295
+test util-16.1.17.-294 {8.4 compatible formatting of doubles} \
+    {expr 1e-294} \
+    1e-294
+test util-16.1.17.-293 {8.4 compatible formatting of doubles} \
+    {expr 1e-293} \
+    1.0000000000000001e-293
+test util-16.1.17.-292 {8.4 compatible formatting of doubles} \
+    {expr 1e-292} \
+    1.0000000000000001e-292
+test util-16.1.17.-291 {8.4 compatible formatting of doubles} \
+    {expr 1e-291} \
+    9.9999999999999996e-292
+test util-16.1.17.-290 {8.4 compatible formatting of doubles} \
+    {expr 1e-290} \
+    1.0000000000000001e-290
+test util-16.1.17.-289 {8.4 compatible formatting of doubles} \
+    {expr 1e-289} \
+    1e-289
+test util-16.1.17.-288 {8.4 compatible formatting of doubles} \
+    {expr 1e-288} \
+    1.0000000000000001e-288
+test util-16.1.17.-287 {8.4 compatible formatting of doubles} \
+    {expr 1e-287} \
+    1e-287
+test util-16.1.17.-286 {8.4 compatible formatting of doubles} \
+    {expr 1e-286} \
+    1.0000000000000001e-286
+test util-16.1.17.-285 {8.4 compatible formatting of doubles} \
+    {expr 1e-285} \
+    1.0000000000000001e-285
+test util-16.1.17.-284 {8.4 compatible formatting of doubles} \
+    {expr 1e-284} \
+    1e-284
+test util-16.1.17.-283 {8.4 compatible formatting of doubles} \
+    {expr 1e-283} \
+    9.9999999999999995e-284
+test util-16.1.17.-282 {8.4 compatible formatting of doubles} \
+    {expr 1e-282} \
+    1e-282
+test util-16.1.17.-281 {8.4 compatible formatting of doubles} \
+    {expr 1e-281} \
+    1e-281
+test util-16.1.17.-280 {8.4 compatible formatting of doubles} \
+    {expr 1e-280} \
+    9.9999999999999996e-281
+test util-16.1.17.-279 {8.4 compatible formatting of doubles} \
+    {expr 1e-279} \
+    1.0000000000000001e-279
+test util-16.1.17.-278 {8.4 compatible formatting of doubles} \
+    {expr 1e-278} \
+    9.9999999999999994e-279
+test util-16.1.17.-277 {8.4 compatible formatting of doubles} \
+    {expr 1e-277} \
+    9.9999999999999997e-278
+test util-16.1.17.-276 {8.4 compatible formatting of doubles} \
+    {expr 1e-276} \
+    1.0000000000000001e-276
+test util-16.1.17.-275 {8.4 compatible formatting of doubles} \
+    {expr 1e-275} \
+    9.9999999999999993e-276
+test util-16.1.17.-274 {8.4 compatible formatting of doubles} \
+    {expr 1e-274} \
+    9.9999999999999997e-275
+test util-16.1.17.-273 {8.4 compatible formatting of doubles} \
+    {expr 1e-273} \
+    1.0000000000000001e-273
+test util-16.1.17.-272 {8.4 compatible formatting of doubles} \
+    {expr 1e-272} \
+    9.9999999999999993e-273
+test util-16.1.17.-271 {8.4 compatible formatting of doubles} \
+    {expr 1e-271} \
+    9.9999999999999996e-272
+test util-16.1.17.-270 {8.4 compatible formatting of doubles} \
+    {expr 1e-270} \
+    1e-270
+test util-16.1.17.-269 {8.4 compatible formatting of doubles} \
+    {expr 1e-269} \
+    9.9999999999999996e-270
+test util-16.1.17.-268 {8.4 compatible formatting of doubles} \
+    {expr 1e-268} \
+    9.9999999999999996e-269
+test util-16.1.17.-267 {8.4 compatible formatting of doubles} \
+    {expr 1e-267} \
+    9.9999999999999998e-268
+test util-16.1.17.-266 {8.4 compatible formatting of doubles} \
+    {expr 1e-266} \
+    9.9999999999999998e-267
+test util-16.1.17.-265 {8.4 compatible formatting of doubles} \
+    {expr 1e-265} \
+    9.9999999999999998e-266
+test util-16.1.17.-264 {8.4 compatible formatting of doubles} \
+    {expr 1e-264} \
+    1e-264
+test util-16.1.17.-263 {8.4 compatible formatting of doubles} \
+    {expr 1e-263} \
+    1e-263
+test util-16.1.17.-262 {8.4 compatible formatting of doubles} \
+    {expr 1e-262} \
+    1e-262
+test util-16.1.17.-261 {8.4 compatible formatting of doubles} \
+    {expr 1e-261} \
+    9.9999999999999998e-262
+test util-16.1.17.-260 {8.4 compatible formatting of doubles} \
+    {expr 1e-260} \
+    9.9999999999999996e-261
+test util-16.1.17.-259 {8.4 compatible formatting of doubles} \
+    {expr 1e-259} \
+    1.0000000000000001e-259
+test util-16.1.17.-258 {8.4 compatible formatting of doubles} \
+    {expr 1e-258} \
+    9.9999999999999995e-259
+test util-16.1.17.-257 {8.4 compatible formatting of doubles} \
+    {expr 1e-257} \
+    9.9999999999999998e-258
+test util-16.1.17.-256 {8.4 compatible formatting of doubles} \
+    {expr 1e-256} \
+    9.9999999999999998e-257
+test util-16.1.17.-255 {8.4 compatible formatting of doubles} \
+    {expr 1e-255} \
+    1e-255
+test util-16.1.17.-254 {8.4 compatible formatting of doubles} \
+    {expr 1e-254} \
+    9.9999999999999991e-255
+test util-16.1.17.-253 {8.4 compatible formatting of doubles} \
+    {expr 1e-253} \
+    1.0000000000000001e-253
+test util-16.1.17.-252 {8.4 compatible formatting of doubles} \
+    {expr 1e-252} \
+    9.9999999999999994e-253
+test util-16.1.17.-251 {8.4 compatible formatting of doubles} \
+    {expr 1e-251} \
+    1e-251
+test util-16.1.17.-250 {8.4 compatible formatting of doubles} \
+    {expr 1e-250} \
+    1.0000000000000001e-250
+test util-16.1.17.-249 {8.4 compatible formatting of doubles} \
+    {expr 1e-249} \
+    1.0000000000000001e-249
+test util-16.1.17.-248 {8.4 compatible formatting of doubles} \
+    {expr 1e-248} \
+    9.9999999999999998e-249
+test util-16.1.17.-247 {8.4 compatible formatting of doubles} \
+    {expr 1e-247} \
+    1e-247
+test util-16.1.17.-246 {8.4 compatible formatting of doubles} \
+    {expr 1e-246} \
+    9.9999999999999996e-247
+test util-16.1.17.-245 {8.4 compatible formatting of doubles} \
+    {expr 1e-245} \
+    9.9999999999999993e-246
+test util-16.1.17.-244 {8.4 compatible formatting of doubles} \
+    {expr 1e-244} \
+    9.9999999999999993e-245
+test util-16.1.17.-243 {8.4 compatible formatting of doubles} \
+    {expr 1e-243} \
+    1e-243
+test util-16.1.17.-242 {8.4 compatible formatting of doubles} \
+    {expr 1e-242} \
+    9.9999999999999997e-243
+test util-16.1.17.-241 {8.4 compatible formatting of doubles} \
+    {expr 1e-241} \
+    9.9999999999999997e-242
+test util-16.1.17.-240 {8.4 compatible formatting of doubles} \
+    {expr 1e-240} \
+    9.9999999999999997e-241
+test util-16.1.17.-239 {8.4 compatible formatting of doubles} \
+    {expr 1e-239} \
+    1.0000000000000001e-239
+test util-16.1.17.-238 {8.4 compatible formatting of doubles} \
+    {expr 1e-238} \
+    9.9999999999999999e-239
+test util-16.1.17.-237 {8.4 compatible formatting of doubles} \
+    {expr 1e-237} \
+    9.9999999999999999e-238
+test util-16.1.17.-236 {8.4 compatible formatting of doubles} \
+    {expr 1e-236} \
+    1e-236
+test util-16.1.17.-235 {8.4 compatible formatting of doubles} \
+    {expr 1e-235} \
+    9.9999999999999996e-236
+test util-16.1.17.-234 {8.4 compatible formatting of doubles} \
+    {expr 1e-234} \
+    9.9999999999999996e-235
+test util-16.1.17.-233 {8.4 compatible formatting of doubles} \
+    {expr 1e-233} \
+    9.9999999999999996e-234
+test util-16.1.17.-232 {8.4 compatible formatting of doubles} \
+    {expr 1e-232} \
+    1e-232
+test util-16.1.17.-231 {8.4 compatible formatting of doubles} \
+    {expr 1e-231} \
+    9.9999999999999999e-232
+test util-16.1.17.-230 {8.4 compatible formatting of doubles} \
+    {expr 1e-230} \
+    1e-230
+test util-16.1.17.-229 {8.4 compatible formatting of doubles} \
+    {expr 1e-229} \
+    1.0000000000000001e-229
+test util-16.1.17.-228 {8.4 compatible formatting of doubles} \
+    {expr 1e-228} \
+    1e-228
+test util-16.1.17.-227 {8.4 compatible formatting of doubles} \
+    {expr 1e-227} \
+    9.9999999999999994e-228
+test util-16.1.17.-226 {8.4 compatible formatting of doubles} \
+    {expr 1e-226} \
+    9.9999999999999992e-227
+test util-16.1.17.-225 {8.4 compatible formatting of doubles} \
+    {expr 1e-225} \
+    9.9999999999999996e-226
+test util-16.1.17.-224 {8.4 compatible formatting of doubles} \
+    {expr 1e-224} \
+    1e-224
+test util-16.1.17.-223 {8.4 compatible formatting of doubles} \
+    {expr 1e-223} \
+    9.9999999999999997e-224
+test util-16.1.17.-222 {8.4 compatible formatting of doubles} \
+    {expr 1e-222} \
+    1e-222
+test util-16.1.17.-221 {8.4 compatible formatting of doubles} \
+    {expr 1e-221} \
+    1e-221
+test util-16.1.17.-220 {8.4 compatible formatting of doubles} \
+    {expr 1e-220} \
+    9.9999999999999999e-221
+test util-16.1.17.-219 {8.4 compatible formatting of doubles} \
+    {expr 1e-219} \
+    1e-219
+test util-16.1.17.-218 {8.4 compatible formatting of doubles} \
+    {expr 1e-218} \
+    1e-218
+test util-16.1.17.-217 {8.4 compatible formatting of doubles} \
+    {expr 1e-217} \
+    1.0000000000000001e-217
+test util-16.1.17.-216 {8.4 compatible formatting of doubles} \
+    {expr 1e-216} \
+    1e-216
+test util-16.1.17.-215 {8.4 compatible formatting of doubles} \
+    {expr 1e-215} \
+    1e-215
+test util-16.1.17.-214 {8.4 compatible formatting of doubles} \
+    {expr 1e-214} \
+    9.9999999999999991e-215
+test util-16.1.17.-213 {8.4 compatible formatting of doubles} \
+    {expr 1e-213} \
+    9.9999999999999995e-214
+test util-16.1.17.-212 {8.4 compatible formatting of doubles} \
+    {expr 1e-212} \
+    9.9999999999999995e-213
+test util-16.1.17.-211 {8.4 compatible formatting of doubles} \
+    {expr 1e-211} \
+    1.0000000000000001e-211
+test util-16.1.17.-210 {8.4 compatible formatting of doubles} \
+    {expr 1e-210} \
+    1e-210
+test util-16.1.17.-209 {8.4 compatible formatting of doubles} \
+    {expr 1e-209} \
+    1e-209
+test util-16.1.17.-208 {8.4 compatible formatting of doubles} \
+    {expr 1e-208} \
+    1.0000000000000001e-208
+test util-16.1.17.-207 {8.4 compatible formatting of doubles} \
+    {expr 1e-207} \
+    9.9999999999999993e-208
+test util-16.1.17.-206 {8.4 compatible formatting of doubles} \
+    {expr 1e-206} \
+    1e-206
+test util-16.1.17.-205 {8.4 compatible formatting of doubles} \
+    {expr 1e-205} \
+    1e-205
+test util-16.1.17.-204 {8.4 compatible formatting of doubles} \
+    {expr 1e-204} \
+    1e-204
+test util-16.1.17.-203 {8.4 compatible formatting of doubles} \
+    {expr 1e-203} \
+    1e-203
+test util-16.1.17.-202 {8.4 compatible formatting of doubles} \
+    {expr 1e-202} \
+    1e-202
+test util-16.1.17.-201 {8.4 compatible formatting of doubles} \
+    {expr 1e-201} \
+    9.9999999999999995e-202
+test util-16.1.17.-200 {8.4 compatible formatting of doubles} \
+    {expr 1e-200} \
+    9.9999999999999998e-201
+test util-16.1.17.-199 {8.4 compatible formatting of doubles} \
+    {expr 1e-199} \
+    9.9999999999999998e-200
+test util-16.1.17.-198 {8.4 compatible formatting of doubles} \
+    {expr 1e-198} \
+    9.9999999999999991e-199
+test util-16.1.17.-197 {8.4 compatible formatting of doubles} \
+    {expr 1e-197} \
+    9.9999999999999999e-198
+test util-16.1.17.-196 {8.4 compatible formatting of doubles} \
+    {expr 1e-196} \
+    1e-196
+test util-16.1.17.-195 {8.4 compatible formatting of doubles} \
+    {expr 1e-195} \
+    1.0000000000000001e-195
+test util-16.1.17.-194 {8.4 compatible formatting of doubles} \
+    {expr 1e-194} \
+    1e-194
+test util-16.1.17.-193 {8.4 compatible formatting of doubles} \
+    {expr 1e-193} \
+    1e-193
+test util-16.1.17.-192 {8.4 compatible formatting of doubles} \
+    {expr 1e-192} \
+    1.0000000000000001e-192
+test util-16.1.17.-191 {8.4 compatible formatting of doubles} \
+    {expr 1e-191} \
+    1e-191
+test util-16.1.17.-190 {8.4 compatible formatting of doubles} \
+    {expr 1e-190} \
+    1e-190
+test util-16.1.17.-189 {8.4 compatible formatting of doubles} \
+    {expr 1e-189} \
+    1.0000000000000001e-189
+test util-16.1.17.-188 {8.4 compatible formatting of doubles} \
+    {expr 1e-188} \
+    9.9999999999999995e-189
+test util-16.1.17.-187 {8.4 compatible formatting of doubles} \
+    {expr 1e-187} \
+    1e-187
+test util-16.1.17.-186 {8.4 compatible formatting of doubles} \
+    {expr 1e-186} \
+    9.9999999999999991e-187
+test util-16.1.17.-185 {8.4 compatible formatting of doubles} \
+    {expr 1e-185} \
+    9.9999999999999999e-186
+test util-16.1.17.-184 {8.4 compatible formatting of doubles} \
+    {expr 1e-184} \
+    1.0000000000000001e-184
+test util-16.1.17.-183 {8.4 compatible formatting of doubles} \
+    {expr 1e-183} \
+    1e-183
+test util-16.1.17.-182 {8.4 compatible formatting of doubles} \
+    {expr 1e-182} \
+    1e-182
+test util-16.1.17.-181 {8.4 compatible formatting of doubles} \
+    {expr 1e-181} \
+    1e-181
+test util-16.1.17.-180 {8.4 compatible formatting of doubles} \
+    {expr 1e-180} \
+    1e-180
+test util-16.1.17.-179 {8.4 compatible formatting of doubles} \
+    {expr 1e-179} \
+    1e-179
+test util-16.1.17.-178 {8.4 compatible formatting of doubles} \
+    {expr 1e-178} \
+    9.9999999999999995e-179
+test util-16.1.17.-177 {8.4 compatible formatting of doubles} \
+    {expr 1e-177} \
+    9.9999999999999995e-178
+test util-16.1.17.-176 {8.4 compatible formatting of doubles} \
+    {expr 1e-176} \
+    1e-176
+test util-16.1.17.-175 {8.4 compatible formatting of doubles} \
+    {expr 1e-175} \
+    1e-175
+test util-16.1.17.-174 {8.4 compatible formatting of doubles} \
+    {expr 1e-174} \
+    1e-174
+test util-16.1.17.-173 {8.4 compatible formatting of doubles} \
+    {expr 1e-173} \
+    1e-173
+test util-16.1.17.-172 {8.4 compatible formatting of doubles} \
+    {expr 1e-172} \
+    1e-172
+test util-16.1.17.-171 {8.4 compatible formatting of doubles} \
+    {expr 1e-171} \
+    9.9999999999999998e-172
+test util-16.1.17.-170 {8.4 compatible formatting of doubles} \
+    {expr 1e-170} \
+    9.9999999999999998e-171
+test util-16.1.17.-169 {8.4 compatible formatting of doubles} \
+    {expr 1e-169} \
+    1e-169
+test util-16.1.17.-168 {8.4 compatible formatting of doubles} \
+    {expr 1e-168} \
+    1e-168
+test util-16.1.17.-167 {8.4 compatible formatting of doubles} \
+    {expr 1e-167} \
+    1e-167
+test util-16.1.17.-166 {8.4 compatible formatting of doubles} \
+    {expr 1e-166} \
+    1e-166
+test util-16.1.17.-165 {8.4 compatible formatting of doubles} \
+    {expr 1e-165} \
+    1e-165
+test util-16.1.17.-164 {8.4 compatible formatting of doubles} \
+    {expr 1e-164} \
+    9.9999999999999996e-165
+test util-16.1.17.-163 {8.4 compatible formatting of doubles} \
+    {expr 1e-163} \
+    9.9999999999999992e-164
+test util-16.1.17.-162 {8.4 compatible formatting of doubles} \
+    {expr 1e-162} \
+    9.9999999999999995e-163
+test util-16.1.17.-161 {8.4 compatible formatting of doubles} \
+    {expr 1e-161} \
+    1e-161
+test util-16.1.17.-160 {8.4 compatible formatting of doubles} \
+    {expr 1e-160} \
+    9.9999999999999999e-161
+test util-16.1.17.-159 {8.4 compatible formatting of doubles} \
+    {expr 1e-159} \
+    9.9999999999999999e-160
+test util-16.1.17.-158 {8.4 compatible formatting of doubles} \
+    {expr 1e-158} \
+    1.0000000000000001e-158
+test util-16.1.17.-157 {8.4 compatible formatting of doubles} \
+    {expr 1e-157} \
+    9.9999999999999994e-158
+test util-16.1.17.-156 {8.4 compatible formatting of doubles} \
+    {expr 1e-156} \
+    1e-156
+test util-16.1.17.-155 {8.4 compatible formatting of doubles} \
+    {expr 1e-155} \
+    1e-155
+test util-16.1.17.-154 {8.4 compatible formatting of doubles} \
+    {expr 1e-154} \
+    9.9999999999999997e-155
+test util-16.1.17.-153 {8.4 compatible formatting of doubles} \
+    {expr 1e-153} \
+    1e-153
+test util-16.1.17.-152 {8.4 compatible formatting of doubles} \
+    {expr 1e-152} \
+    1.0000000000000001e-152
+test util-16.1.17.-151 {8.4 compatible formatting of doubles} \
+    {expr 1e-151} \
+    9.9999999999999994e-152
+test util-16.1.17.-150 {8.4 compatible formatting of doubles} \
+    {expr 1e-150} \
+    1e-150
+test util-16.1.17.-149 {8.4 compatible formatting of doubles} \
+    {expr 1e-149} \
+    9.9999999999999998e-150
+test util-16.1.17.-148 {8.4 compatible formatting of doubles} \
+    {expr 1e-148} \
+    9.9999999999999994e-149
+test util-16.1.17.-147 {8.4 compatible formatting of doubles} \
+    {expr 1e-147} \
+    9.9999999999999997e-148
+test util-16.1.17.-146 {8.4 compatible formatting of doubles} \
+    {expr 1e-146} \
+    1e-146
+test util-16.1.17.-145 {8.4 compatible formatting of doubles} \
+    {expr 1e-145} \
+    9.9999999999999991e-146
+test util-16.1.17.-144 {8.4 compatible formatting of doubles} \
+    {expr 1e-144} \
+    9.9999999999999995e-145
+test util-16.1.17.-143 {8.4 compatible formatting of doubles} \
+    {expr 1e-143} \
+    9.9999999999999995e-144
+test util-16.1.17.-142 {8.4 compatible formatting of doubles} \
+    {expr 1e-142} \
+    1e-142
+test util-16.1.17.-141 {8.4 compatible formatting of doubles} \
+    {expr 1e-141} \
+    1e-141
+test util-16.1.17.-140 {8.4 compatible formatting of doubles} \
+    {expr 1e-140} \
+    9.9999999999999998e-141
+test util-16.1.17.-139 {8.4 compatible formatting of doubles} \
+    {expr 1e-139} \
+    1e-139
+test util-16.1.17.-138 {8.4 compatible formatting of doubles} \
+    {expr 1e-138} \
+    1.0000000000000001e-138
+test util-16.1.17.-137 {8.4 compatible formatting of doubles} \
+    {expr 1e-137} \
+    9.9999999999999998e-138
+test util-16.1.17.-136 {8.4 compatible formatting of doubles} \
+    {expr 1e-136} \
+    1e-136
+test util-16.1.17.-135 {8.4 compatible formatting of doubles} \
+    {expr 1e-135} \
+    1e-135
+test util-16.1.17.-134 {8.4 compatible formatting of doubles} \
+    {expr 1e-134} \
+    1e-134
+test util-16.1.17.-133 {8.4 compatible formatting of doubles} \
+    {expr 1e-133} \
+    1.0000000000000001e-133
+test util-16.1.17.-132 {8.4 compatible formatting of doubles} \
+    {expr 1e-132} \
+    9.9999999999999999e-133
+test util-16.1.17.-131 {8.4 compatible formatting of doubles} \
+    {expr 1e-131} \
+    9.9999999999999999e-132
+test util-16.1.17.-130 {8.4 compatible formatting of doubles} \
+    {expr 1e-130} \
+    1.0000000000000001e-130
+test util-16.1.17.-129 {8.4 compatible formatting of doubles} \
+    {expr 1e-129} \
+    9.9999999999999993e-130
+test util-16.1.17.-128 {8.4 compatible formatting of doubles} \
+    {expr 1e-128} \
+    1.0000000000000001e-128
+test util-16.1.17.-127 {8.4 compatible formatting of doubles} \
+    {expr 1e-127} \
+    1e-127
+test util-16.1.17.-126 {8.4 compatible formatting of doubles} \
+    {expr 1e-126} \
+    9.9999999999999995e-127
+test util-16.1.17.-125 {8.4 compatible formatting of doubles} \
+    {expr 1e-125} \
+    1e-125
+test util-16.1.17.-124 {8.4 compatible formatting of doubles} \
+    {expr 1e-124} \
+    9.9999999999999993e-125
+test util-16.1.17.-123 {8.4 compatible formatting of doubles} \
+    {expr 1e-123} \
+    1.0000000000000001e-123
+test util-16.1.17.-122 {8.4 compatible formatting of doubles} \
+    {expr 1e-122} \
+    1.0000000000000001e-122
+test util-16.1.17.-121 {8.4 compatible formatting of doubles} \
+    {expr 1e-121} \
+    9.9999999999999998e-122
+test util-16.1.17.-120 {8.4 compatible formatting of doubles} \
+    {expr 1e-120} \
+    9.9999999999999998e-121
+test util-16.1.17.-119 {8.4 compatible formatting of doubles} \
+    {expr 1e-119} \
+    1e-119
+test util-16.1.17.-118 {8.4 compatible formatting of doubles} \
+    {expr 1e-118} \
+    9.9999999999999999e-119
+test util-16.1.17.-117 {8.4 compatible formatting of doubles} \
+    {expr 1e-117} \
+    1e-117
+test util-16.1.17.-116 {8.4 compatible formatting of doubles} \
+    {expr 1e-116} \
+    9.9999999999999999e-117
+test util-16.1.17.-115 {8.4 compatible formatting of doubles} \
+    {expr 1e-115} \
+    1.0000000000000001e-115
+test util-16.1.17.-114 {8.4 compatible formatting of doubles} \
+    {expr 1e-114} \
+    1.0000000000000001e-114
+test util-16.1.17.-113 {8.4 compatible formatting of doubles} \
+    {expr 1e-113} \
+    9.9999999999999998e-114
+test util-16.1.17.-112 {8.4 compatible formatting of doubles} \
+    {expr 1e-112} \
+    9.9999999999999995e-113
+test util-16.1.17.-111 {8.4 compatible formatting of doubles} \
+    {expr 1e-111} \
+    1.0000000000000001e-111
+test util-16.1.17.-110 {8.4 compatible formatting of doubles} \
+    {expr 1e-110} \
+    1.0000000000000001e-110
+test util-16.1.17.-109 {8.4 compatible formatting of doubles} \
+    {expr 1e-109} \
+    9.9999999999999999e-110
+test util-16.1.17.-108 {8.4 compatible formatting of doubles} \
+    {expr 1e-108} \
+    1e-108
+test util-16.1.17.-107 {8.4 compatible formatting of doubles} \
+    {expr 1e-107} \
+    1e-107
+test util-16.1.17.-106 {8.4 compatible formatting of doubles} \
+    {expr 1e-106} \
+    9.9999999999999994e-107
+test util-16.1.17.-105 {8.4 compatible formatting of doubles} \
+    {expr 1e-105} \
+    9.9999999999999997e-106
+test util-16.1.17.-104 {8.4 compatible formatting of doubles} \
+    {expr 1e-104} \
+    9.9999999999999993e-105
+test util-16.1.17.-103 {8.4 compatible formatting of doubles} \
+    {expr 1e-103} \
+    9.9999999999999996e-104
+test util-16.1.17.-102 {8.4 compatible formatting of doubles} \
+    {expr 1e-102} \
+    9.9999999999999993e-103
+test util-16.1.17.-101 {8.4 compatible formatting of doubles} \
+    {expr 1e-101} \
+    1.0000000000000001e-101
+test util-16.1.17.-100 {8.4 compatible formatting of doubles} \
+    {expr 1e-100} \
+    1e-100
+test util-16.1.17.-99 {8.4 compatible formatting of doubles} \
+    {expr 1e-99} \
+    1e-99
+test util-16.1.17.-98 {8.4 compatible formatting of doubles} \
+    {expr 1e-98} \
+    9.9999999999999994e-99
+test util-16.1.17.-97 {8.4 compatible formatting of doubles} \
+    {expr 1e-97} \
+    1e-97
+test util-16.1.17.-96 {8.4 compatible formatting of doubles} \
+    {expr 1e-96} \
+    9.9999999999999991e-97
+test util-16.1.17.-95 {8.4 compatible formatting of doubles} \
+    {expr 1e-95} \
+    9.9999999999999999e-96
+test util-16.1.17.-94 {8.4 compatible formatting of doubles} \
+    {expr 1e-94} \
+    9.9999999999999996e-95
+test util-16.1.17.-93 {8.4 compatible formatting of doubles} \
+    {expr 1e-93} \
+    9.999999999999999e-94
+test util-16.1.17.-92 {8.4 compatible formatting of doubles} \
+    {expr 1e-92} \
+    9.9999999999999999e-93
+test util-16.1.17.-91 {8.4 compatible formatting of doubles} \
+    {expr 1e-91} \
+    1e-91
+test util-16.1.17.-90 {8.4 compatible formatting of doubles} \
+    {expr 1e-90} \
+    9.9999999999999999e-91
+test util-16.1.17.-89 {8.4 compatible formatting of doubles} \
+    {expr 1e-89} \
+    1e-89
+test util-16.1.17.-88 {8.4 compatible formatting of doubles} \
+    {expr 1e-88} \
+    9.9999999999999993e-89
+test util-16.1.17.-87 {8.4 compatible formatting of doubles} \
+    {expr 1e-87} \
+    1e-87
+test util-16.1.17.-86 {8.4 compatible formatting of doubles} \
+    {expr 1e-86} \
+    1.0000000000000001e-86
+test util-16.1.17.-85 {8.4 compatible formatting of doubles} \
+    {expr 1e-85} \
+    9.9999999999999998e-86
+test util-16.1.17.-84 {8.4 compatible formatting of doubles} \
+    {expr 1e-84} \
+    1e-84
+test util-16.1.17.-83 {8.4 compatible formatting of doubles} \
+    {expr 1e-83} \
+    1e-83
+test util-16.1.17.-82 {8.4 compatible formatting of doubles} \
+    {expr 1e-82} \
+    9.9999999999999996e-83
+test util-16.1.17.-81 {8.4 compatible formatting of doubles} \
+    {expr 1e-81} \
+    9.9999999999999996e-82
+test util-16.1.17.-80 {8.4 compatible formatting of doubles} \
+    {expr 1e-80} \
+    9.9999999999999996e-81
+test util-16.1.17.-79 {8.4 compatible formatting of doubles} \
+    {expr 1e-79} \
+    1e-79
+test util-16.1.17.-78 {8.4 compatible formatting of doubles} \
+    {expr 1e-78} \
+    1e-78
+test util-16.1.17.-77 {8.4 compatible formatting of doubles} \
+    {expr 1e-77} \
+    9.9999999999999993e-78
+test util-16.1.17.-76 {8.4 compatible formatting of doubles} \
+    {expr 1e-76} \
+    9.9999999999999993e-77
+test util-16.1.17.-75 {8.4 compatible formatting of doubles} \
+    {expr 1e-75} \
+    9.9999999999999996e-76
+test util-16.1.17.-74 {8.4 compatible formatting of doubles} \
+    {expr 1e-74} \
+    9.9999999999999996e-75
+test util-16.1.17.-73 {8.4 compatible formatting of doubles} \
+    {expr 1e-73} \
+    1e-73
+test util-16.1.17.-72 {8.4 compatible formatting of doubles} \
+    {expr 1e-72} \
+    9.9999999999999997e-73
+test util-16.1.17.-71 {8.4 compatible formatting of doubles} \
+    {expr 1e-71} \
+    9.9999999999999992e-72
+test util-16.1.17.-70 {8.4 compatible formatting of doubles} \
+    {expr 1e-70} \
+    1e-70
+test util-16.1.17.-69 {8.4 compatible formatting of doubles} \
+    {expr 1e-69} \
+    9.9999999999999996e-70
+test util-16.1.17.-68 {8.4 compatible formatting of doubles} \
+    {expr 1e-68} \
+    1.0000000000000001e-68
+test util-16.1.17.-67 {8.4 compatible formatting of doubles} \
+    {expr 1e-67} \
+    9.9999999999999994e-68
+test util-16.1.17.-66 {8.4 compatible formatting of doubles} \
+    {expr 1e-66} \
+    9.9999999999999998e-67
+test util-16.1.17.-65 {8.4 compatible formatting of doubles} \
+    {expr 1e-65} \
+    9.9999999999999992e-66
+test util-16.1.17.-64 {8.4 compatible formatting of doubles} \
+    {expr 1e-64} \
+    9.9999999999999997e-65
+test util-16.1.17.-63 {8.4 compatible formatting of doubles} \
+    {expr 1e-63} \
+    1.0000000000000001e-63
+test util-16.1.17.-62 {8.4 compatible formatting of doubles} \
+    {expr 1e-62} \
+    1e-62
+test util-16.1.17.-61 {8.4 compatible formatting of doubles} \
+    {expr 1e-61} \
+    1e-61
+test util-16.1.17.-60 {8.4 compatible formatting of doubles} \
+    {expr 1e-60} \
+    9.9999999999999997e-61
+test util-16.1.17.-59 {8.4 compatible formatting of doubles} \
+    {expr 1e-59} \
+    1e-59
+test util-16.1.17.-58 {8.4 compatible formatting of doubles} \
+    {expr 1e-58} \
+    1e-58
+test util-16.1.17.-57 {8.4 compatible formatting of doubles} \
+    {expr 1e-57} \
+    9.9999999999999995e-58
+test util-16.1.17.-56 {8.4 compatible formatting of doubles} \
+    {expr 1e-56} \
+    1e-56
+test util-16.1.17.-55 {8.4 compatible formatting of doubles} \
+    {expr 1e-55} \
+    9.9999999999999999e-56
+test util-16.1.17.-54 {8.4 compatible formatting of doubles} \
+    {expr 1e-54} \
+    1e-54
+test util-16.1.17.-53 {8.4 compatible formatting of doubles} \
+    {expr 1e-53} \
+    1e-53
+test util-16.1.17.-52 {8.4 compatible formatting of doubles} \
+    {expr 1e-52} \
+    1e-52
+test util-16.1.17.-51 {8.4 compatible formatting of doubles} \
+    {expr 1e-51} \
+    1e-51
+test util-16.1.17.-50 {8.4 compatible formatting of doubles} \
+    {expr 1e-50} \
+    1e-50
+test util-16.1.17.-49 {8.4 compatible formatting of doubles} \
+    {expr 1e-49} \
+    9.9999999999999994e-50
+test util-16.1.17.-48 {8.4 compatible formatting of doubles} \
+    {expr 1e-48} \
+    9.9999999999999997e-49
+test util-16.1.17.-47 {8.4 compatible formatting of doubles} \
+    {expr 1e-47} \
+    9.9999999999999997e-48
+test util-16.1.17.-46 {8.4 compatible formatting of doubles} \
+    {expr 1e-46} \
+    1e-46
+test util-16.1.17.-45 {8.4 compatible formatting of doubles} \
+    {expr 1e-45} \
+    9.9999999999999998e-46
+test util-16.1.17.-44 {8.4 compatible formatting of doubles} \
+    {expr 1e-44} \
+    9.9999999999999995e-45
+test util-16.1.17.-43 {8.4 compatible formatting of doubles} \
+    {expr 1e-43} \
+    1.0000000000000001e-43
+test util-16.1.17.-42 {8.4 compatible formatting of doubles} \
+    {expr 1e-42} \
+    1e-42
+test util-16.1.17.-41 {8.4 compatible formatting of doubles} \
+    {expr 1e-41} \
+    1e-41
+test util-16.1.17.-40 {8.4 compatible formatting of doubles} \
+    {expr 1e-40} \
+    9.9999999999999993e-41
+test util-16.1.17.-39 {8.4 compatible formatting of doubles} \
+    {expr 1e-39} \
+    9.9999999999999993e-40
+test util-16.1.17.-38 {8.4 compatible formatting of doubles} \
+    {expr 1e-38} \
+    9.9999999999999996e-39
+test util-16.1.17.-37 {8.4 compatible formatting of doubles} \
+    {expr 1e-37} \
+    1.0000000000000001e-37
+test util-16.1.17.-36 {8.4 compatible formatting of doubles} \
+    {expr 1e-36} \
+    9.9999999999999994e-37
+test util-16.1.17.-35 {8.4 compatible formatting of doubles} \
+    {expr 1e-35} \
+    1e-35
+test util-16.1.17.-34 {8.4 compatible formatting of doubles} \
+    {expr 1e-34} \
+    9.9999999999999993e-35
+test util-16.1.17.-33 {8.4 compatible formatting of doubles} \
+    {expr 1e-33} \
+    1.0000000000000001e-33
+test util-16.1.17.-32 {8.4 compatible formatting of doubles} \
+    {expr 1e-32} \
+    1.0000000000000001e-32
+test util-16.1.17.-31 {8.4 compatible formatting of doubles} \
+    {expr 1e-31} \
+    1.0000000000000001e-31
+test util-16.1.17.-30 {8.4 compatible formatting of doubles} \
+    {expr 1e-30} \
+    1.0000000000000001e-30
+test util-16.1.17.-29 {8.4 compatible formatting of doubles} \
+    {expr 1e-29} \
+    9.9999999999999994e-30
+test util-16.1.17.-28 {8.4 compatible formatting of doubles} \
+    {expr 1e-28} \
+    9.9999999999999997e-29
+test util-16.1.17.-27 {8.4 compatible formatting of doubles} \
+    {expr 1e-27} \
+    1e-27
+test util-16.1.17.-26 {8.4 compatible formatting of doubles} \
+    {expr 1e-26} \
+    1e-26
+test util-16.1.17.-25 {8.4 compatible formatting of doubles} \
+    {expr 1e-25} \
+    1e-25
+test util-16.1.17.-24 {8.4 compatible formatting of doubles} \
+    {expr 1e-24} \
+    9.9999999999999992e-25
+test util-16.1.17.-23 {8.4 compatible formatting of doubles} \
+    {expr 1e-23} \
+    9.9999999999999996e-24
+test util-16.1.17.-22 {8.4 compatible formatting of doubles} \
+    {expr 1e-22} \
+    1e-22
+test util-16.1.17.-21 {8.4 compatible formatting of doubles} \
+    {expr 1e-21} \
+    9.9999999999999991e-22
+test util-16.1.17.-20 {8.4 compatible formatting of doubles} \
+    {expr 1e-20} \
+    9.9999999999999995e-21
+test util-16.1.17.-19 {8.4 compatible formatting of doubles} \
+    {expr 1e-19} \
+    9.9999999999999998e-20
+test util-16.1.17.-18 {8.4 compatible formatting of doubles} \
+    {expr 1e-18} \
+    1.0000000000000001e-18
+test util-16.1.17.-17 {8.4 compatible formatting of doubles} \
+    {expr 1e-17} \
+    1.0000000000000001e-17
+test util-16.1.17.-16 {8.4 compatible formatting of doubles} \
+    {expr 1e-16} \
+    9.9999999999999998e-17
+test util-16.1.17.-15 {8.4 compatible formatting of doubles} \
+    {expr 1e-15} \
+    1.0000000000000001e-15
+test util-16.1.17.-14 {8.4 compatible formatting of doubles} \
+    {expr 1e-14} \
+    1e-14
+test util-16.1.17.-13 {8.4 compatible formatting of doubles} \
+    {expr 1e-13} \
+    1e-13
+test util-16.1.17.-12 {8.4 compatible formatting of doubles} \
+    {expr 1e-12} \
+    9.9999999999999998e-13
+test util-16.1.17.-11 {8.4 compatible formatting of doubles} \
+    {expr 1e-11} \
+    9.9999999999999994e-12
+test util-16.1.17.-10 {8.4 compatible formatting of doubles} \
+    {expr 1e-10} \
+    1e-10
+test util-16.1.17.-9 {8.4 compatible formatting of doubles} \
+    {expr 1e-9} \
+    1.0000000000000001e-09
+test util-16.1.17.-8 {8.4 compatible formatting of doubles} \
+    {expr 1e-8} \
+    1e-08
+test util-16.1.17.-7 {8.4 compatible formatting of doubles} \
+    {expr 1e-7} \
+    9.9999999999999995e-08
+test util-16.1.17.-6 {8.4 compatible formatting of doubles} \
+    {expr 1e-6} \
+    9.9999999999999995e-07
+test util-16.1.17.-5 {8.4 compatible formatting of doubles} \
+    {expr 1e-5} \
+    1.0000000000000001e-05
+test util-16.1.17.-4 {8.4 compatible formatting of doubles} \
+    {expr 1e-4} \
+    0.0001
+test util-16.1.17.-3 {8.4 compatible formatting of doubles} \
+    {expr 1e-3} \
+    0.001
+test util-16.1.17.-2 {8.4 compatible formatting of doubles} \
+    {expr 1e-2} \
+    0.01
+test util-16.1.17.-1 {8.4 compatible formatting of doubles} \
+    {expr 1e-1} \
+    0.10000000000000001
+test util-16.1.17.0 {8.4 compatible formatting of doubles} \
+    {expr 1e0} \
+    1.0
+test util-16.1.17.1 {8.4 compatible formatting of doubles} \
+    {expr 1e1} \
+    10.0
+test util-16.1.17.2 {8.4 compatible formatting of doubles} \
+    {expr 1e2} \
+    100.0
+test util-16.1.17.3 {8.4 compatible formatting of doubles} \
+    {expr 1e3} \
+    1000.0
+test util-16.1.17.4 {8.4 compatible formatting of doubles} \
+    {expr 1e4} \
+    10000.0
+test util-16.1.17.5 {8.4 compatible formatting of doubles} \
+    {expr 1e5} \
+    100000.0
+test util-16.1.17.6 {8.4 compatible formatting of doubles} \
+    {expr 1e6} \
+    1000000.0
+test util-16.1.17.7 {8.4 compatible formatting of doubles} \
+    {expr 1e7} \
+    10000000.0
+test util-16.1.17.8 {8.4 compatible formatting of doubles} \
+    {expr 1e8} \
+    100000000.0
+test util-16.1.17.9 {8.4 compatible formatting of doubles} \
+    {expr 1e9} \
+    1000000000.0
+test util-16.1.17.10 {8.4 compatible formatting of doubles} \
+    {expr 1e10} \
+    10000000000.0
+test util-16.1.17.11 {8.4 compatible formatting of doubles} \
+    {expr 1e11} \
+    100000000000.0
+test util-16.1.17.12 {8.4 compatible formatting of doubles} \
+    {expr 1e12} \
+    1000000000000.0
+test util-16.1.17.13 {8.4 compatible formatting of doubles} \
+    {expr 1e13} \
+    10000000000000.0
+test util-16.1.17.14 {8.4 compatible formatting of doubles} \
+    {expr 1e14} \
+    100000000000000.0
+test util-16.1.17.15 {8.4 compatible formatting of doubles} \
+    {expr 1e15} \
+    1000000000000000.0
+test util-16.1.17.16 {8.4 compatible formatting of doubles} \
+    {expr 1e16} \
+    10000000000000000.0
+test util-16.1.17.17 {8.4 compatible formatting of doubles} \
+    {expr 1e17} \
+    1e+17
+test util-16.1.17.18 {8.4 compatible formatting of doubles} \
+    {expr 1e18} \
+    1e+18
+test util-16.1.17.19 {8.4 compatible formatting of doubles} \
+    {expr 1e19} \
+    1e+19
+test util-16.1.17.20 {8.4 compatible formatting of doubles} \
+    {expr 1e20} \
+    1e+20
+test util-16.1.17.21 {8.4 compatible formatting of doubles} \
+    {expr 1e21} \
+    1e+21
+test util-16.1.17.22 {8.4 compatible formatting of doubles} \
+    {expr 1e22} \
+    1e+22
+test util-16.1.17.23 {8.4 compatible formatting of doubles} \
+    {expr 1e23} \
+    9.9999999999999992e+22
+test util-16.1.17.24 {8.4 compatible formatting of doubles} \
+    {expr 1e24} \
+    9.9999999999999998e+23
+test util-16.1.17.25 {8.4 compatible formatting of doubles} \
+    {expr 1e25} \
+    1.0000000000000001e+25
+test util-16.1.17.26 {8.4 compatible formatting of doubles} \
+    {expr 1e26} \
+    1e+26
+test util-16.1.17.27 {8.4 compatible formatting of doubles} \
+    {expr 1e27} \
+    1e+27
+test util-16.1.17.28 {8.4 compatible formatting of doubles} \
+    {expr 1e28} \
+    9.9999999999999996e+27
+test util-16.1.17.29 {8.4 compatible formatting of doubles} \
+    {expr 1e29} \
+    9.9999999999999991e+28
+test util-16.1.17.30 {8.4 compatible formatting of doubles} \
+    {expr 1e30} \
+    1e+30
+test util-16.1.17.31 {8.4 compatible formatting of doubles} \
+    {expr 1e31} \
+    9.9999999999999996e+30
+test util-16.1.17.32 {8.4 compatible formatting of doubles} \
+    {expr 1e32} \
+    1.0000000000000001e+32
+test util-16.1.17.33 {8.4 compatible formatting of doubles} \
+    {expr 1e33} \
+    9.9999999999999995e+32
+test util-16.1.17.34 {8.4 compatible formatting of doubles} \
+    {expr 1e34} \
+    9.9999999999999995e+33
+test util-16.1.17.35 {8.4 compatible formatting of doubles} \
+    {expr 1e35} \
+    9.9999999999999997e+34
+test util-16.1.17.36 {8.4 compatible formatting of doubles} \
+    {expr 1e36} \
+    1e+36
+test util-16.1.17.37 {8.4 compatible formatting of doubles} \
+    {expr 1e37} \
+    9.9999999999999995e+36
+test util-16.1.17.38 {8.4 compatible formatting of doubles} \
+    {expr 1e38} \
+    9.9999999999999998e+37
+test util-16.1.17.39 {8.4 compatible formatting of doubles} \
+    {expr 1e39} \
+    9.9999999999999994e+38
+test util-16.1.17.40 {8.4 compatible formatting of doubles} \
+    {expr 1e40} \
+    1e+40
+test util-16.1.17.41 {8.4 compatible formatting of doubles} \
+    {expr 1e41} \
+    1e+41
+test util-16.1.17.42 {8.4 compatible formatting of doubles} \
+    {expr 1e42} \
+    1e+42
+test util-16.1.17.43 {8.4 compatible formatting of doubles} \
+    {expr 1e43} \
+    1e+43
+test util-16.1.17.44 {8.4 compatible formatting of doubles} \
+    {expr 1e44} \
+    1.0000000000000001e+44
+test util-16.1.17.45 {8.4 compatible formatting of doubles} \
+    {expr 1e45} \
+    9.9999999999999993e+44
+test util-16.1.17.46 {8.4 compatible formatting of doubles} \
+    {expr 1e46} \
+    9.9999999999999999e+45
+test util-16.1.17.47 {8.4 compatible formatting of doubles} \
+    {expr 1e47} \
+    1e+47
+test util-16.1.17.48 {8.4 compatible formatting of doubles} \
+    {expr 1e48} \
+    1e+48
+test util-16.1.17.49 {8.4 compatible formatting of doubles} \
+    {expr 1e49} \
+    9.9999999999999995e+48
+test util-16.1.17.50 {8.4 compatible formatting of doubles} \
+    {expr 1e50} \
+    1.0000000000000001e+50
+test util-16.1.17.51 {8.4 compatible formatting of doubles} \
+    {expr 1e51} \
+    9.9999999999999999e+50
+test util-16.1.17.52 {8.4 compatible formatting of doubles} \
+    {expr 1e52} \
+    9.9999999999999999e+51
+test util-16.1.17.53 {8.4 compatible formatting of doubles} \
+    {expr 1e53} \
+    9.9999999999999999e+52
+test util-16.1.17.54 {8.4 compatible formatting of doubles} \
+    {expr 1e54} \
+    1.0000000000000001e+54
+test util-16.1.17.55 {8.4 compatible formatting of doubles} \
+    {expr 1e55} \
+    1e+55
+test util-16.1.17.56 {8.4 compatible formatting of doubles} \
+    {expr 1e56} \
+    1.0000000000000001e+56
+test util-16.1.17.57 {8.4 compatible formatting of doubles} \
+    {expr 1e57} \
+    1e+57
+test util-16.1.17.58 {8.4 compatible formatting of doubles} \
+    {expr 1e58} \
+    9.9999999999999994e+57
+test util-16.1.17.59 {8.4 compatible formatting of doubles} \
+    {expr 1e59} \
+    9.9999999999999997e+58
+test util-16.1.17.60 {8.4 compatible formatting of doubles} \
+    {expr 1e60} \
+    9.9999999999999995e+59
+test util-16.1.17.61 {8.4 compatible formatting of doubles} \
+    {expr 1e61} \
+    9.9999999999999995e+60
+test util-16.1.17.62 {8.4 compatible formatting of doubles} \
+    {expr 1e62} \
+    1e+62
+test util-16.1.17.63 {8.4 compatible formatting of doubles} \
+    {expr 1e63} \
+    1.0000000000000001e+63
+test util-16.1.17.64 {8.4 compatible formatting of doubles} \
+    {expr 1e64} \
+    1e+64
+test util-16.1.17.65 {8.4 compatible formatting of doubles} \
+    {expr 1e65} \
+    9.9999999999999999e+64
+test util-16.1.17.66 {8.4 compatible formatting of doubles} \
+    {expr 1e66} \
+    9.9999999999999995e+65
+test util-16.1.17.67 {8.4 compatible formatting of doubles} \
+    {expr 1e67} \
+    9.9999999999999998e+66
+test util-16.1.17.68 {8.4 compatible formatting of doubles} \
+    {expr 1e68} \
+    9.9999999999999995e+67
+test util-16.1.17.69 {8.4 compatible formatting of doubles} \
+    {expr 1e69} \
+    1.0000000000000001e+69
+test util-16.1.17.70 {8.4 compatible formatting of doubles} \
+    {expr 1e70} \
+    1.0000000000000001e+70
+test util-16.1.17.71 {8.4 compatible formatting of doubles} \
+    {expr 1e71} \
+    1e+71
+test util-16.1.17.72 {8.4 compatible formatting of doubles} \
+    {expr 1e72} \
+    9.9999999999999994e+71
+test util-16.1.17.73 {8.4 compatible formatting of doubles} \
+    {expr 1e73} \
+    9.9999999999999998e+72
+test util-16.1.17.74 {8.4 compatible formatting of doubles} \
+    {expr 1e74} \
+    9.9999999999999995e+73
+test util-16.1.17.75 {8.4 compatible formatting of doubles} \
+    {expr 1e75} \
+    9.9999999999999993e+74
+test util-16.1.17.76 {8.4 compatible formatting of doubles} \
+    {expr 1e76} \
+    1e+76
+test util-16.1.17.77 {8.4 compatible formatting of doubles} \
+    {expr 1e77} \
+    9.9999999999999998e+76
+test util-16.1.17.78 {8.4 compatible formatting of doubles} \
+    {expr 1e78} \
+    1e+78
+test util-16.1.17.79 {8.4 compatible formatting of doubles} \
+    {expr 1e79} \
+    9.9999999999999997e+78
+test util-16.1.17.80 {8.4 compatible formatting of doubles} \
+    {expr 1e80} \
+    1e+80
+test util-16.1.17.81 {8.4 compatible formatting of doubles} \
+    {expr 1e81} \
+    9.9999999999999992e+80
+test util-16.1.17.82 {8.4 compatible formatting of doubles} \
+    {expr 1e82} \
+    9.9999999999999996e+81
+test util-16.1.17.83 {8.4 compatible formatting of doubles} \
+    {expr 1e83} \
+    1e+83
+test util-16.1.17.84 {8.4 compatible formatting of doubles} \
+    {expr 1e84} \
+    1.0000000000000001e+84
+test util-16.1.17.85 {8.4 compatible formatting of doubles} \
+    {expr 1e85} \
+    1e+85
+test util-16.1.17.86 {8.4 compatible formatting of doubles} \
+    {expr 1e86} \
+    1e+86
+test util-16.1.17.87 {8.4 compatible formatting of doubles} \
+    {expr 1e87} \
+    9.9999999999999996e+86
+test util-16.1.17.88 {8.4 compatible formatting of doubles} \
+    {expr 1e88} \
+    9.9999999999999996e+87
+test util-16.1.17.89 {8.4 compatible formatting of doubles} \
+    {expr 1e89} \
+    9.9999999999999999e+88
+test util-16.1.17.90 {8.4 compatible formatting of doubles} \
+    {expr 1e90} \
+    9.9999999999999997e+89
+test util-16.1.17.91 {8.4 compatible formatting of doubles} \
+    {expr 1e91} \
+    1.0000000000000001e+91
+test util-16.1.17.92 {8.4 compatible formatting of doubles} \
+    {expr 1e92} \
+    1e+92
+test util-16.1.17.93 {8.4 compatible formatting of doubles} \
+    {expr 1e93} \
+    1e+93
+test util-16.1.17.94 {8.4 compatible formatting of doubles} \
+    {expr 1e94} \
+    1e+94
+test util-16.1.17.95 {8.4 compatible formatting of doubles} \
+    {expr 1e95} \
+    1e+95
+test util-16.1.17.96 {8.4 compatible formatting of doubles} \
+    {expr 1e96} \
+    1e+96
+test util-16.1.17.97 {8.4 compatible formatting of doubles} \
+    {expr 1e97} \
+    1.0000000000000001e+97
+test util-16.1.17.98 {8.4 compatible formatting of doubles} \
+    {expr 1e98} \
+    1e+98
+test util-16.1.17.99 {8.4 compatible formatting of doubles} \
+    {expr 1e99} \
+    9.9999999999999997e+98
+test util-16.1.17.100 {8.4 compatible formatting of doubles} \
+    {expr 1e100} \
+    1e+100
+test util-16.1.17.101 {8.4 compatible formatting of doubles} \
+    {expr 1e101} \
+    9.9999999999999998e+100
+test util-16.1.17.102 {8.4 compatible formatting of doubles} \
+    {expr 1e102} \
+    9.9999999999999998e+101
+test util-16.1.17.103 {8.4 compatible formatting of doubles} \
+    {expr 1e103} \
+    1e+103
+test util-16.1.17.104 {8.4 compatible formatting of doubles} \
+    {expr 1e104} \
+    1e+104
+test util-16.1.17.105 {8.4 compatible formatting of doubles} \
+    {expr 1e105} \
+    9.9999999999999994e+104
+test util-16.1.17.106 {8.4 compatible formatting of doubles} \
+    {expr 1e106} \
+    1.0000000000000001e+106
+test util-16.1.17.107 {8.4 compatible formatting of doubles} \
+    {expr 1e107} \
+    9.9999999999999997e+106
+test util-16.1.17.108 {8.4 compatible formatting of doubles} \
+    {expr 1e108} \
+    1e+108
+test util-16.1.17.109 {8.4 compatible formatting of doubles} \
+    {expr 1e109} \
+    9.9999999999999998e+108
+test util-16.1.17.110 {8.4 compatible formatting of doubles} \
+    {expr 1e110} \
+    1e+110
+test util-16.1.17.111 {8.4 compatible formatting of doubles} \
+    {expr 1e111} \
+    9.9999999999999996e+110
+test util-16.1.17.112 {8.4 compatible formatting of doubles} \
+    {expr 1e112} \
+    9.9999999999999993e+111
+test util-16.1.17.113 {8.4 compatible formatting of doubles} \
+    {expr 1e113} \
+    1e+113
+test util-16.1.17.114 {8.4 compatible formatting of doubles} \
+    {expr 1e114} \
+    1e+114
+test util-16.1.17.115 {8.4 compatible formatting of doubles} \
+    {expr 1e115} \
+    1e+115
+test util-16.1.17.116 {8.4 compatible formatting of doubles} \
+    {expr 1e116} \
+    1e+116
+test util-16.1.17.117 {8.4 compatible formatting of doubles} \
+    {expr 1e117} \
+    1.0000000000000001e+117
+test util-16.1.17.118 {8.4 compatible formatting of doubles} \
+    {expr 1e118} \
+    9.9999999999999997e+117
+test util-16.1.17.119 {8.4 compatible formatting of doubles} \
+    {expr 1e119} \
+    9.9999999999999994e+118
+test util-16.1.17.120 {8.4 compatible formatting of doubles} \
+    {expr 1e120} \
+    9.9999999999999998e+119
+test util-16.1.17.121 {8.4 compatible formatting of doubles} \
+    {expr 1e121} \
+    1e+121
+test util-16.1.17.122 {8.4 compatible formatting of doubles} \
+    {expr 1e122} \
+    1e+122
+test util-16.1.17.123 {8.4 compatible formatting of doubles} \
+    {expr 1e123} \
+    9.9999999999999998e+122
+test util-16.1.17.124 {8.4 compatible formatting of doubles} \
+    {expr 1e124} \
+    9.9999999999999995e+123
+test util-16.1.17.125 {8.4 compatible formatting of doubles} \
+    {expr 1e125} \
+    9.9999999999999992e+124
+test util-16.1.17.126 {8.4 compatible formatting of doubles} \
+    {expr 1e126} \
+    9.9999999999999992e+125
+test util-16.1.17.127 {8.4 compatible formatting of doubles} \
+    {expr 1e127} \
+    9.9999999999999995e+126
+test util-16.1.17.128 {8.4 compatible formatting of doubles} \
+    {expr 1e128} \
+    1.0000000000000001e+128
+test util-16.1.17.129 {8.4 compatible formatting of doubles} \
+    {expr 1e129} \
+    1e+129
+test util-16.1.17.130 {8.4 compatible formatting of doubles} \
+    {expr 1e130} \
+    1.0000000000000001e+130
+test util-16.1.17.131 {8.4 compatible formatting of doubles} \
+    {expr 1e131} \
+    9.9999999999999991e+130
+test util-16.1.17.132 {8.4 compatible formatting of doubles} \
+    {expr 1e132} \
+    9.9999999999999999e+131
+test util-16.1.17.133 {8.4 compatible formatting of doubles} \
+    {expr 1e133} \
+    1e+133
+test util-16.1.17.134 {8.4 compatible formatting of doubles} \
+    {expr 1e134} \
+    9.9999999999999992e+133
+test util-16.1.17.135 {8.4 compatible formatting of doubles} \
+    {expr 1e135} \
+    9.9999999999999996e+134
+test util-16.1.17.136 {8.4 compatible formatting of doubles} \
+    {expr 1e136} \
+    1.0000000000000001e+136
+test util-16.1.17.137 {8.4 compatible formatting of doubles} \
+    {expr 1e137} \
+    1e+137
+test util-16.1.17.138 {8.4 compatible formatting of doubles} \
+    {expr 1e138} \
+    1e+138
+test util-16.1.17.139 {8.4 compatible formatting of doubles} \
+    {expr 1e139} \
+    1e+139
+test util-16.1.17.140 {8.4 compatible formatting of doubles} \
+    {expr 1e140} \
+    1.0000000000000001e+140
+test util-16.1.17.141 {8.4 compatible formatting of doubles} \
+    {expr 1e141} \
+    1e+141
+test util-16.1.17.142 {8.4 compatible formatting of doubles} \
+    {expr 1e142} \
+    1.0000000000000001e+142
+test util-16.1.17.143 {8.4 compatible formatting of doubles} \
+    {expr 1e143} \
+    1e+143
+test util-16.1.17.144 {8.4 compatible formatting of doubles} \
+    {expr 1e144} \
+    1e+144
+test util-16.1.17.145 {8.4 compatible formatting of doubles} \
+    {expr 1e145} \
+    9.9999999999999999e+144
+test util-16.1.17.146 {8.4 compatible formatting of doubles} \
+    {expr 1e146} \
+    9.9999999999999993e+145
+test util-16.1.17.147 {8.4 compatible formatting of doubles} \
+    {expr 1e147} \
+    9.9999999999999998e+146
+test util-16.1.17.148 {8.4 compatible formatting of doubles} \
+    {expr 1e148} \
+    1e+148
+test util-16.1.17.149 {8.4 compatible formatting of doubles} \
+    {expr 1e149} \
+    1e+149
+test util-16.1.17.150 {8.4 compatible formatting of doubles} \
+    {expr 1e150} \
+    9.9999999999999998e+149
+test util-16.1.17.151 {8.4 compatible formatting of doubles} \
+    {expr 1e151} \
+    1e+151
+test util-16.1.17.152 {8.4 compatible formatting of doubles} \
+    {expr 1e152} \
+    1e+152
+test util-16.1.17.153 {8.4 compatible formatting of doubles} \
+    {expr 1e153} \
+    1e+153
+test util-16.1.17.154 {8.4 compatible formatting of doubles} \
+    {expr 1e154} \
+    1e+154
+test util-16.1.17.155 {8.4 compatible formatting of doubles} \
+    {expr 1e155} \
+    1e+155
+test util-16.1.17.156 {8.4 compatible formatting of doubles} \
+    {expr 1e156} \
+    9.9999999999999998e+155
+test util-16.1.17.157 {8.4 compatible formatting of doubles} \
+    {expr 1e157} \
+    9.9999999999999998e+156
+test util-16.1.17.158 {8.4 compatible formatting of doubles} \
+    {expr 1e158} \
+    9.9999999999999995e+157
+test util-16.1.17.159 {8.4 compatible formatting of doubles} \
+    {expr 1e159} \
+    9.9999999999999993e+158
+test util-16.1.17.160 {8.4 compatible formatting of doubles} \
+    {expr 1e160} \
+    1e+160
+test util-16.1.17.161 {8.4 compatible formatting of doubles} \
+    {expr 1e161} \
+    1e+161
+test util-16.1.17.162 {8.4 compatible formatting of doubles} \
+    {expr 1e162} \
+    9.9999999999999994e+161
+test util-16.1.17.163 {8.4 compatible formatting of doubles} \
+    {expr 1e163} \
+    9.9999999999999994e+162
+test util-16.1.17.164 {8.4 compatible formatting of doubles} \
+    {expr 1e164} \
+    1e+164
+test util-16.1.17.165 {8.4 compatible formatting of doubles} \
+    {expr 1e165} \
+    9.999999999999999e+164
+test util-16.1.17.166 {8.4 compatible formatting of doubles} \
+    {expr 1e166} \
+    9.9999999999999994e+165
+test util-16.1.17.167 {8.4 compatible formatting of doubles} \
+    {expr 1e167} \
+    1e+167
+test util-16.1.17.168 {8.4 compatible formatting of doubles} \
+    {expr 1e168} \
+    9.9999999999999993e+167
+test util-16.1.17.169 {8.4 compatible formatting of doubles} \
+    {expr 1e169} \
+    9.9999999999999993e+168
+test util-16.1.17.170 {8.4 compatible formatting of doubles} \
+    {expr 1e170} \
+    1e+170
+test util-16.1.17.171 {8.4 compatible formatting of doubles} \
+    {expr 1e171} \
+    9.9999999999999995e+170
+test util-16.1.17.172 {8.4 compatible formatting of doubles} \
+    {expr 1e172} \
+    1.0000000000000001e+172
+test util-16.1.17.173 {8.4 compatible formatting of doubles} \
+    {expr 1e173} \
+    1e+173
+test util-16.1.17.174 {8.4 compatible formatting of doubles} \
+    {expr 1e174} \
+    1.0000000000000001e+174
+test util-16.1.17.175 {8.4 compatible formatting of doubles} \
+    {expr 1e175} \
+    9.9999999999999994e+174
+test util-16.1.17.176 {8.4 compatible formatting of doubles} \
+    {expr 1e176} \
+    1e+176
+test util-16.1.17.177 {8.4 compatible formatting of doubles} \
+    {expr 1e177} \
+    1e+177
+test util-16.1.17.178 {8.4 compatible formatting of doubles} \
+    {expr 1e178} \
+    1.0000000000000001e+178
+test util-16.1.17.179 {8.4 compatible formatting of doubles} \
+    {expr 1e179} \
+    9.9999999999999998e+178
+test util-16.1.17.180 {8.4 compatible formatting of doubles} \
+    {expr 1e180} \
+    1e+180
+test util-16.1.17.181 {8.4 compatible formatting of doubles} \
+    {expr 1e181} \
+    9.9999999999999992e+180
+test util-16.1.17.182 {8.4 compatible formatting of doubles} \
+    {expr 1e182} \
+    1.0000000000000001e+182
+test util-16.1.17.183 {8.4 compatible formatting of doubles} \
+    {expr 1e183} \
+    9.9999999999999995e+182
+test util-16.1.17.184 {8.4 compatible formatting of doubles} \
+    {expr 1e184} \
+    1e+184
+test util-16.1.17.185 {8.4 compatible formatting of doubles} \
+    {expr 1e185} \
+    9.9999999999999998e+184
+test util-16.1.17.186 {8.4 compatible formatting of doubles} \
+    {expr 1e186} \
+    9.9999999999999998e+185
+test util-16.1.17.187 {8.4 compatible formatting of doubles} \
+    {expr 1e187} \
+    9.9999999999999991e+186
+test util-16.1.17.188 {8.4 compatible formatting of doubles} \
+    {expr 1e188} \
+    1e+188
+test util-16.1.17.189 {8.4 compatible formatting of doubles} \
+    {expr 1e189} \
+    1e+189
+test util-16.1.17.190 {8.4 compatible formatting of doubles} \
+    {expr 1e190} \
+    1.0000000000000001e+190
+test util-16.1.17.191 {8.4 compatible formatting of doubles} \
+    {expr 1e191} \
+    1.0000000000000001e+191
+test util-16.1.17.192 {8.4 compatible formatting of doubles} \
+    {expr 1e192} \
+    1e+192
+test util-16.1.17.193 {8.4 compatible formatting of doubles} \
+    {expr 1e193} \
+    1.0000000000000001e+193
+test util-16.1.17.194 {8.4 compatible formatting of doubles} \
+    {expr 1e194} \
+    9.9999999999999994e+193
+test util-16.1.17.195 {8.4 compatible formatting of doubles} \
+    {expr 1e195} \
+    9.9999999999999998e+194
+test util-16.1.17.196 {8.4 compatible formatting of doubles} \
+    {expr 1e196} \
+    9.9999999999999995e+195
+test util-16.1.17.197 {8.4 compatible formatting of doubles} \
+    {expr 1e197} \
+    9.9999999999999995e+196
+test util-16.1.17.198 {8.4 compatible formatting of doubles} \
+    {expr 1e198} \
+    1e+198
+test util-16.1.17.199 {8.4 compatible formatting of doubles} \
+    {expr 1e199} \
+    1.0000000000000001e+199
+test util-16.1.17.200 {8.4 compatible formatting of doubles} \
+    {expr 1e200} \
+    9.9999999999999997e+199
+test util-16.1.17.201 {8.4 compatible formatting of doubles} \
+    {expr 1e201} \
+    1e+201
+test util-16.1.17.202 {8.4 compatible formatting of doubles} \
+    {expr 1e202} \
+    9.999999999999999e+201
+test util-16.1.17.203 {8.4 compatible formatting of doubles} \
+    {expr 1e203} \
+    9.9999999999999999e+202
+test util-16.1.17.204 {8.4 compatible formatting of doubles} \
+    {expr 1e204} \
+    9.9999999999999999e+203
+test util-16.1.17.205 {8.4 compatible formatting of doubles} \
+    {expr 1e205} \
+    1e+205
+test util-16.1.17.206 {8.4 compatible formatting of doubles} \
+    {expr 1e206} \
+    1e+206
+test util-16.1.17.207 {8.4 compatible formatting of doubles} \
+    {expr 1e207} \
+    1e+207
+test util-16.1.17.208 {8.4 compatible formatting of doubles} \
+    {expr 1e208} \
+    9.9999999999999998e+207
+test util-16.1.17.209 {8.4 compatible formatting of doubles} \
+    {expr 1e209} \
+    1.0000000000000001e+209
+test util-16.1.17.210 {8.4 compatible formatting of doubles} \
+    {expr 1e210} \
+    9.9999999999999993e+209
+test util-16.1.17.211 {8.4 compatible formatting of doubles} \
+    {expr 1e211} \
+    9.9999999999999996e+210
+test util-16.1.17.212 {8.4 compatible formatting of doubles} \
+    {expr 1e212} \
+    9.9999999999999991e+211
+test util-16.1.17.213 {8.4 compatible formatting of doubles} \
+    {expr 1e213} \
+    9.9999999999999998e+212
+test util-16.1.17.214 {8.4 compatible formatting of doubles} \
+    {expr 1e214} \
+    9.9999999999999995e+213
+test util-16.1.17.215 {8.4 compatible formatting of doubles} \
+    {expr 1e215} \
+    9.9999999999999991e+214
+test util-16.1.17.216 {8.4 compatible formatting of doubles} \
+    {expr 1e216} \
+    1e+216
+test util-16.1.17.217 {8.4 compatible formatting of doubles} \
+    {expr 1e217} \
+    9.9999999999999996e+216
+test util-16.1.17.218 {8.4 compatible formatting of doubles} \
+    {expr 1e218} \
+    1.0000000000000001e+218
+test util-16.1.17.219 {8.4 compatible formatting of doubles} \
+    {expr 1e219} \
+    9.9999999999999997e+218
+test util-16.1.17.220 {8.4 compatible formatting of doubles} \
+    {expr 1e220} \
+    1e+220
+test util-16.1.17.221 {8.4 compatible formatting of doubles} \
+    {expr 1e221} \
+    1e+221
+test util-16.1.17.222 {8.4 compatible formatting of doubles} \
+    {expr 1e222} \
+    1e+222
+test util-16.1.17.223 {8.4 compatible formatting of doubles} \
+    {expr 1e223} \
+    1e+223
+test util-16.1.17.224 {8.4 compatible formatting of doubles} \
+    {expr 1e224} \
+    9.9999999999999997e+223
+test util-16.1.17.225 {8.4 compatible formatting of doubles} \
+    {expr 1e225} \
+    9.9999999999999993e+224
+test util-16.1.17.226 {8.4 compatible formatting of doubles} \
+    {expr 1e226} \
+    9.9999999999999996e+225
+test util-16.1.17.227 {8.4 compatible formatting of doubles} \
+    {expr 1e227} \
+    1.0000000000000001e+227
+test util-16.1.17.228 {8.4 compatible formatting of doubles} \
+    {expr 1e228} \
+    9.9999999999999992e+227
+test util-16.1.17.229 {8.4 compatible formatting of doubles} \
+    {expr 1e229} \
+    9.9999999999999999e+228
+test util-16.1.17.230 {8.4 compatible formatting of doubles} \
+    {expr 1e230} \
+    1.0000000000000001e+230
+test util-16.1.17.231 {8.4 compatible formatting of doubles} \
+    {expr 1e231} \
+    1.0000000000000001e+231
+test util-16.1.17.232 {8.4 compatible formatting of doubles} \
+    {expr 1e232} \
+    1.0000000000000001e+232
+test util-16.1.17.233 {8.4 compatible formatting of doubles} \
+    {expr 1e233} \
+    9.9999999999999997e+232
+test util-16.1.17.234 {8.4 compatible formatting of doubles} \
+    {expr 1e234} \
+    1e+234
+test util-16.1.17.235 {8.4 compatible formatting of doubles} \
+    {expr 1e235} \
+    1.0000000000000001e+235
+test util-16.1.17.236 {8.4 compatible formatting of doubles} \
+    {expr 1e236} \
+    1.0000000000000001e+236
+test util-16.1.17.237 {8.4 compatible formatting of doubles} \
+    {expr 1e237} \
+    9.9999999999999994e+236
+test util-16.1.17.238 {8.4 compatible formatting of doubles} \
+    {expr 1e238} \
+    1e+238
+test util-16.1.17.239 {8.4 compatible formatting of doubles} \
+    {expr 1e239} \
+    9.9999999999999999e+238
+test util-16.1.17.240 {8.4 compatible formatting of doubles} \
+    {expr 1e240} \
+    1e+240
+test util-16.1.17.241 {8.4 compatible formatting of doubles} \
+    {expr 1e241} \
+    1.0000000000000001e+241
+test util-16.1.17.242 {8.4 compatible formatting of doubles} \
+    {expr 1e242} \
+    1.0000000000000001e+242
+test util-16.1.17.243 {8.4 compatible formatting of doubles} \
+    {expr 1e243} \
+    1.0000000000000001e+243
+test util-16.1.17.244 {8.4 compatible formatting of doubles} \
+    {expr 1e244} \
+    1.0000000000000001e+244
+test util-16.1.17.245 {8.4 compatible formatting of doubles} \
+    {expr 1e245} \
+    1e+245
+test util-16.1.17.246 {8.4 compatible formatting of doubles} \
+    {expr 1e246} \
+    1.0000000000000001e+246
+test util-16.1.17.247 {8.4 compatible formatting of doubles} \
+    {expr 1e247} \
+    9.9999999999999995e+246
+test util-16.1.17.248 {8.4 compatible formatting of doubles} \
+    {expr 1e248} \
+    1e+248
+test util-16.1.17.249 {8.4 compatible formatting of doubles} \
+    {expr 1e249} \
+    9.9999999999999992e+248
+test util-16.1.17.250 {8.4 compatible formatting of doubles} \
+    {expr 1e250} \
+    9.9999999999999992e+249
+test util-16.1.17.251 {8.4 compatible formatting of doubles} \
+    {expr 1e251} \
+    1e+251
+test util-16.1.17.252 {8.4 compatible formatting of doubles} \
+    {expr 1e252} \
+    1.0000000000000001e+252
+test util-16.1.17.253 {8.4 compatible formatting of doubles} \
+    {expr 1e253} \
+    9.9999999999999994e+252
+test util-16.1.17.254 {8.4 compatible formatting of doubles} \
+    {expr 1e254} \
+    9.9999999999999994e+253
+test util-16.1.17.255 {8.4 compatible formatting of doubles} \
+    {expr 1e255} \
+    9.9999999999999999e+254
+test util-16.1.17.256 {8.4 compatible formatting of doubles} \
+    {expr 1e256} \
+    1e+256
+test util-16.1.17.257 {8.4 compatible formatting of doubles} \
+    {expr 1e257} \
+    1e+257
+test util-16.1.17.258 {8.4 compatible formatting of doubles} \
+    {expr 1e258} \
+    1.0000000000000001e+258
+test util-16.1.17.259 {8.4 compatible formatting of doubles} \
+    {expr 1e259} \
+    9.9999999999999993e+258
+test util-16.1.17.260 {8.4 compatible formatting of doubles} \
+    {expr 1e260} \
+    1.0000000000000001e+260
+test util-16.1.17.261 {8.4 compatible formatting of doubles} \
+    {expr 1e261} \
+    9.9999999999999993e+260
+test util-16.1.17.262 {8.4 compatible formatting of doubles} \
+    {expr 1e262} \
+    1e+262
+test util-16.1.17.263 {8.4 compatible formatting of doubles} \
+    {expr 1e263} \
+    1e+263
+test util-16.1.17.264 {8.4 compatible formatting of doubles} \
+    {expr 1e264} \
+    1e+264
+test util-16.1.17.265 {8.4 compatible formatting of doubles} \
+    {expr 1e265} \
+    1.0000000000000001e+265
+test util-16.1.17.266 {8.4 compatible formatting of doubles} \
+    {expr 1e266} \
+    1e+266
+test util-16.1.17.267 {8.4 compatible formatting of doubles} \
+    {expr 1e267} \
+    9.9999999999999997e+266
+test util-16.1.17.268 {8.4 compatible formatting of doubles} \
+    {expr 1e268} \
+    9.9999999999999997e+267
+test util-16.1.17.269 {8.4 compatible formatting of doubles} \
+    {expr 1e269} \
+    1e+269
+test util-16.1.17.270 {8.4 compatible formatting of doubles} \
+    {expr 1e270} \
+    1e+270
+test util-16.1.17.271 {8.4 compatible formatting of doubles} \
+    {expr 1e271} \
+    9.9999999999999995e+270
+test util-16.1.17.272 {8.4 compatible formatting of doubles} \
+    {expr 1e272} \
+    1.0000000000000001e+272
+test util-16.1.17.273 {8.4 compatible formatting of doubles} \
+    {expr 1e273} \
+    9.9999999999999995e+272
+test util-16.1.17.274 {8.4 compatible formatting of doubles} \
+    {expr 1e274} \
+    9.9999999999999992e+273
+test util-16.1.17.275 {8.4 compatible formatting of doubles} \
+    {expr 1e275} \
+    9.9999999999999996e+274
+test util-16.1.17.276 {8.4 compatible formatting of doubles} \
+    {expr 1e276} \
+    1.0000000000000001e+276
+test util-16.1.17.277 {8.4 compatible formatting of doubles} \
+    {expr 1e277} \
+    1e+277
+test util-16.1.17.278 {8.4 compatible formatting of doubles} \
+    {expr 1e278} \
+    9.9999999999999996e+277
+test util-16.1.17.279 {8.4 compatible formatting of doubles} \
+    {expr 1e279} \
+    1.0000000000000001e+279
+test util-16.1.17.280 {8.4 compatible formatting of doubles} \
+    {expr 1e280} \
+    1e+280
+test util-16.1.17.281 {8.4 compatible formatting of doubles} \
+    {expr 1e281} \
+    1e+281
+test util-16.1.17.282 {8.4 compatible formatting of doubles} \
+    {expr 1e282} \
+    1e+282
+test util-16.1.17.283 {8.4 compatible formatting of doubles} \
+    {expr 1e283} \
+    9.9999999999999996e+282
+test util-16.1.17.284 {8.4 compatible formatting of doubles} \
+    {expr 1e284} \
+    1.0000000000000001e+284
+test util-16.1.17.285 {8.4 compatible formatting of doubles} \
+    {expr 1e285} \
+    9.9999999999999998e+284
+test util-16.1.17.286 {8.4 compatible formatting of doubles} \
+    {expr 1e286} \
+    1e+286
+test util-16.1.17.287 {8.4 compatible formatting of doubles} \
+    {expr 1e287} \
+    1.0000000000000001e+287
+test util-16.1.17.288 {8.4 compatible formatting of doubles} \
+    {expr 1e288} \
+    1e+288
+test util-16.1.17.289 {8.4 compatible formatting of doubles} \
+    {expr 1e289} \
+    1.0000000000000001e+289
+test util-16.1.17.290 {8.4 compatible formatting of doubles} \
+    {expr 1e290} \
+    1.0000000000000001e+290
+test util-16.1.17.291 {8.4 compatible formatting of doubles} \
+    {expr 1e291} \
+    9.9999999999999996e+290
+test util-16.1.17.292 {8.4 compatible formatting of doubles} \
+    {expr 1e292} \
+    1e+292
+test util-16.1.17.293 {8.4 compatible formatting of doubles} \
+    {expr 1e293} \
+    9.9999999999999992e+292
+test util-16.1.17.294 {8.4 compatible formatting of doubles} \
+    {expr 1e294} \
+    1.0000000000000001e+294
+test util-16.1.17.295 {8.4 compatible formatting of doubles} \
+    {expr 1e295} \
+    9.9999999999999998e+294
+test util-16.1.17.296 {8.4 compatible formatting of doubles} \
+    {expr 1e296} \
+    9.9999999999999998e+295
+test util-16.1.17.297 {8.4 compatible formatting of doubles} \
+    {expr 1e297} \
+    1e+297
+test util-16.1.17.298 {8.4 compatible formatting of doubles} \
+    {expr 1e298} \
+    9.9999999999999996e+297
+test util-16.1.17.299 {8.4 compatible formatting of doubles} \
+    {expr 1e299} \
+    1.0000000000000001e+299
+test util-16.1.17.300 {8.4 compatible formatting of doubles} \
+    {expr 1e300} \
+    1.0000000000000001e+300
+test util-16.1.17.301 {8.4 compatible formatting of doubles} \
+    {expr 1e301} \
+    1.0000000000000001e+301
+test util-16.1.17.302 {8.4 compatible formatting of doubles} \
+    {expr 1e302} \
+    1.0000000000000001e+302
+test util-16.1.17.303 {8.4 compatible formatting of doubles} \
+    {expr 1e303} \
+    1e+303
+test util-16.1.17.304 {8.4 compatible formatting of doubles} \
+    {expr 1e304} \
+    9.9999999999999994e+303
+test util-16.1.17.305 {8.4 compatible formatting of doubles} \
+    {expr 1e305} \
+    9.9999999999999994e+304
+test util-16.1.17.306 {8.4 compatible formatting of doubles} \
+    {expr 1e306} \
+    1e+306
+test util-16.1.17.307 {8.4 compatible formatting of doubles} \
+    {expr 1e307} \
+    9.9999999999999999e+306
+
+test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
+    set r {}
+    foreach {input} {
+	0x1ffffffffffffc000
+	0x1ffffffffffffc800
+	0x1ffffffffffffd000
+	0x1ffffffffffffd800
+	0x1ffffffffffffe000
+	0x1ffffffffffffe800
+	0x1fffffffffffff000
+	0x1fffffffffffff800
+    } {
+	binary scan [binary format q [expr double($input)]] wu x
+	lappend r [format %#llx $x]
+	binary scan [binary format q [expr double(-$input)]] wu x
+	lappend r [format %#llx $x]
+    }
+    set r
+} [list {*}{
+    0x43fffffffffffffc 0xc3fffffffffffffc 
+    0x43fffffffffffffc 0xc3fffffffffffffc
+    0x43fffffffffffffd 0xc3fffffffffffffd
+    0x43fffffffffffffe 0xc3fffffffffffffe
+    0x43fffffffffffffe 0xc3fffffffffffffe
+    0x43fffffffffffffe 0xc3fffffffffffffe
+    0x43ffffffffffffff 0xc3ffffffffffffff
+    0x4400000000000000 0xc400000000000000
+}]
+
+set ::tcl_precision $saved_precision
+
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/var.test b/tests/var.test
index df9d553..208b361 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -1,27 +1,27 @@
-# 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.
-#
-# RCS: @(#) $Id: var.test,v 1.26 2004/09/30 23:06:49 dgp Exp $
-#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2.2
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testupvar [llength [info commands testupvar]]
 testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
 testConstraint testsetnoerr [llength [info commands testsetnoerr]]
@@ -34,14 +34,15 @@ catch {unset y}
 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 {
@@ -116,9 +118,9 @@ test var-1.14 {TclLookupVar, namespace code ignores ":"s in middle and end of va
         set x:y: 789
         list [set :] [set v:] [set x:y:] \
              ${:} ${v:} ${x:y:} \
-             [expr {[lsearch [info vars] :] != -1}] \
-             [expr {[lsearch [info vars] v:] != -1}] \
-             [expr {[lsearch [info vars] x:y:] != -1}]
+             [expr {":" in [info vars]}] \
+             [expr {"v:" in [info vars]}] \
+             [expr {"x:y:" in [info vars]}]
     }
 } {123 456 789 123 456 789 1 1 1}
 test var-1.15 {TclLookupVar, resurrect variable via upvar to deleted namespace: compiled code path} {
@@ -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
@@ -352,14 +363,24 @@ test var-6.4 {Tcl_GlobalObjCmd, variable name matching :*} {
     p
     set :v
 } {fixed}
+test var-6.5 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
+    global
+} {}
+test var-6.6 {Tcl_GlobalObjCmd, no-op case (TIP 323)} {
+    proc p {} {
+	global
+    }
+    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 {
@@ -381,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
@@ -394,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 {
@@ -421,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
@@ -442,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\
@@ -487,165 +511,192 @@ 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.16 {Tcl_VariableObjCmd, no args} {
-    list [catch {variable} msg] $msg
-} {1 {wrong # args: should be "variable ?name value...? name ?value?"}}
-test var-7.17 {Tcl_VariableObjCmd, no args} {
-    namespace eval test_ns_var {
-	list [catch {variable} msg] $msg
-    }
-} {1 {wrong # args: should be "variable ?name value...? name ?value?"}}
+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
+} {}
+test var-7.17 {Tcl_VariableObjCmd, no args (TIP 323)} {
+    namespace eval test_ns_var {
+	variable
+    }
+} {}
 
-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}}
+} -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
+} -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 {
@@ -662,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
@@ -674,11 +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
+} -result os
 
 test var-15.1 {segfault in [unset], [Bug 735335]} {
     proc A { name } {
@@ -693,15 +748,137 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
     namespace eval test A useSomeUnlikelyNameHere
     namespace eval test unset useSomeUnlikelyNameHere
 } {}
-
+test var-15.2 {compiled unset evaluation order, Bug 3970f54c4e} {
+    apply {{} {unset foo [return ok]}}
+} ok
 
 test var-16.1 {CallVarTraces: save/restore interp error state} {
-    trace add variable errorCode write { ;#}
+    trace add variable ::errorCode write " ;#"
     catch {error foo bar baz}
-    trace remove variable errorCode write { ;#}
-    set errorInfo
+    trace remove variable ::errorCode write " ;#"
+    set ::errorInfo
 } bar
 
+test var-17.1 {TclArraySet [Bug 1669489]} -setup {
+    unset -nocomplain ::a
+} -body {
+    namespace eval :: {
+	set elements {1 2 3 4}
+	trace add variable a write "string length \$elements ;#"
+	array set a $elements
+    }
+} -cleanup {
+    unset -nocomplain ::a ::elements
+} -result {}
+
+test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
+    set already 0
+    unset x
+} -body {
+    array set x {e 1 i 1}
+    trace add variable x unset {apply {args {
+	global already x
+	if {!$already} {
+	    set already 1
+	    unset x(i)
+	}
+    }}}
+    # The next command would crash reliably with memory debugging prior to the
+    # bug fix.
+    array unset x *
+    array size x
+} -cleanup {
+    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
+    rename foo {}
+} {}
+
+test var-20.1 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	global x
+	array set x {a 1}
+    }}
+    array size x
+} -result 1
+test var-20.2 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	global x
+	array set x {}
+    }}
+    array size x
+} -result 0
+test var-20.3 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	array set ::x {a 1}
+    }}
+    array size x
+} -result 1
+test var-20.4 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	array set ::x {}
+    }}
+    array size x
+} -result 0
+test var-20.5 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	global x
+	eval {array set x {a 1}}
+    }}
+    array size x
+} -result 1
+test var-20.6 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	global x
+	eval {array set x {}}
+    }}
+    array size x
+} -result 0
+test var-20.7 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	eval {array set ::x {a 1}}
+    }}
+    array size x
+} -result 1
+test var-20.8 {array set compilation correctness: Bug 3603163} -setup {
+    unset -nocomplain x
+} -body {
+    apply {{} {
+	eval {array set ::x {}}
+    }}
+    array size x
+} -result 0
+
+test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
+    proc linenumber {} {dict get [info frame -1] line}
+} -body {
+    apply {n {
+	set foo bar
+        unset foo {*}{
+        } [return [incr n -[linenumber]]]
+    }} [linenumber]
+} -cleanup {
+    rename linenumber {}
+} -result 1
+
+
 catch {namespace delete ns}
 catch {unset arr}
 catch {unset v}
@@ -720,3 +897,7 @@ catch {unset aaaaa}
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/while-old.test b/tests/while-old.test
index a62bcb1..ee17d0b 100644
--- a/tests/while-old.test
+++ b/tests/while-old.test
@@ -12,8 +12,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: while-old.test,v 1.7 2004/05/19 13:06:15 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -103,7 +101,7 @@ test while-old-4.5 {errors in while loops} {
 } {1 {expected boolean value but got "foo"}}
 test while-old-4.6 {errors in while loops} {
     set err [catch {while {1} {error "loop aborted"}} msg]
-    list $err $msg $errorInfo
+    list $err $msg $::errorInfo
 } {1 {loop aborted} {loop aborted
     while executing
 "error "loop aborted""}}
diff --git a/tests/while.test b/tests/while.test
index 0352da4..642ec93 100644
--- a/tests/while.test
+++ b/tests/while.test
@@ -1,18 +1,16 @@
 # Commands covered:  while
 #
-# 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) 1996 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.
-#
-# RCS: @(#) $Id: while.test,v 1.9 2004/09/26 16:36:06 msofer Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
@@ -22,31 +20,31 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 catch {unset i}
 catch {unset a}
 
-test while-1.1 {TclCompileWhileCmd: missing test expression} {
-    catch {while } msg
-    set msg
-} {wrong # args: should be "while test command"}
+test while-1.1 {TclCompileWhileCmd: missing test expression} -body {
+    while
+} -returnCodes error -result {wrong # args: should be "while test command"}
 test while-1.2 {TclCompileWhileCmd: error in test expression} -body {
     set i 0
-    catch {while {$i<} break} msg
-    set errorInfo
-} -match glob -result {syntax error in expression "$i<": premature end of expression*
-    while *ing
-"while {$i<} break"}
-test while-1.3 {TclCompileWhileCmd: error in test expression} {
-    set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
-    list $err $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test while-1.4 {TclCompileWhileCmd: multiline test expr} {
+    catch {while {$i<} break}
+    return $::errorInfo
+} -cleanup {
+    unset i
+} -match glob -result {*"while {$i<} break"}
+test while-1.3 {TclCompileWhileCmd: error in test expression} -body {
+    while {"a"+"b"} {error "loop aborted"}
+} -returnCodes error -result {can't use non-numeric string as operand of "+"}
+test while-1.4 {TclCompileWhileCmd: multiline test expr} -body {
     set value 1
     while {($tcl_platform(platform) != "foobar1") && \
 	    ($tcl_platform(platform) != "foobar2")} {
         incr value
         break
     }
-    set value
-} {2}
-test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
+    return $value
+} -cleanup {
+    unset value
+} -result {2}
+test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} -body {
     set value 1
     while {"true"} {
 	incr value;
@@ -54,25 +52,28 @@ test while-1.5 {TclCompileWhileCmd: non-numeric boolean test expr} {
 	    break;
 	}
     }
-    set value
-} 6
+    return $value
+} -cleanup {
+    unset value
+} -result 6
 test while-1.6 {TclCompileWhileCmd: test expr is enclosed in quotes} {
     set i 0
     while "$i > 5" {}
 } {}
-test while-1.7 {TclCompileWhileCmd: missing command body} {
+test while-1.7 {TclCompileWhileCmd: missing command body} -body {
     set i 0
-    catch {while {$i < 5} } msg
-    set msg
-} {wrong # args: should be "while test command"}
+    while {$i < 5}
+} -returnCodes error -result {wrong # args: should be "while test command"}
 test while-1.8 {TclCompileWhileCmd: error compiling command body} -body {
     set i 0
-    catch {while {$i < 5} {set}} msg
-    set errorInfo
-} -match glob -result {wrong # args: should be "set varName ?newValue?"
+    catch {while {$i < 5} {set}}
+    return $::errorInfo
+} -match glob -cleanup {
+    unset i
+} -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"*}
-test while-1.9 {TclCompileWhileCmd: simple command body} {
+test while-1.9 {TclCompileWhileCmd: simple command body} -body {
     set a {}
     set i 1
     while {$i<6} {
@@ -80,27 +81,34 @@ test while-1.9 {TclCompileWhileCmd: simple command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2 3}
-test while-1.10 {TclCompileWhileCmd: command body in quotes} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 2 3}
+test while-1.10 {TclCompileWhileCmd: command body in quotes} -body {
     set a {}
     set i 1
     while {$i<6} "append a x; incr i"
-    set a
-} {xxxxx}
-test while-1.11 {TclCompileWhileCmd: computed command body} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {xxxxx}
+test while-1.11 {TclCompileWhileCmd: computed command body} -setup {
     catch {unset x1}
     catch {unset bb}
     catch {unset x2}
+} -body {
     set x1 {append a x1; }
     set bb {break}
     set x2 {; append a x2; incr i}
     set a {}
     set i 1
     while {$i<6} $x1$bb$x2
-    set a
-} {x1}
-test while-1.12 {TclCompileWhileCmd: long command body} {
+    return $a
+} -cleanup {
+    unset x1 bb x2 a i
+} -result {x1}
+test while-1.12 {TclCompileWhileCmd: long command body} -body {
     set a {}
     set i 1
     while {$i<6} {
@@ -134,22 +142,28 @@ test while-1.12 {TclCompileWhileCmd: long command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2 3}
-test while-1.13 {TclCompileWhileCmd: while command result} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 2 3}
+test while-1.13 {TclCompileWhileCmd: while command result} -body {
     set i 0
     set a [while {$i < 5} {incr i}]
-    set a
-} {}
-test while-1.14 {TclCompileWhileCmd: while command result} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {}
+test while-1.14 {TclCompileWhileCmd: while command result} -body {
     set i 0
     set a [while {$i < 5} {if $i==3 break; incr i}]
-    set a
-} {}
+    return $a
+} -cleanup {
+    unset a i
+} -result {}
 
 # Check "while" and "continue".
 
-test while-2.1 {continue tests} {
+test while-2.1 {continue tests} -body {
     set a {}
     set i 1
     while {$i <= 4} {
@@ -157,9 +171,11 @@ test while-2.1 {continue tests} {
 	if {$i == 3} continue
 	set a [concat $a $i]
     }
-    set a
-} {2 4 5}
-test while-2.2 {continue tests} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {2 4 5}
+test while-2.2 {continue tests} -body {
     set a {}
     set i 1
     while {$i <= 4} {
@@ -167,9 +183,11 @@ test while-2.2 {continue tests} {
 	if {$i != 2} continue
 	set a [concat $a $i]
     }
-    set a
-} {2}
-test while-2.3 {continue tests, nested loops} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {2}
+test while-2.3 {continue tests, nested loops} -body {
     set msg {}
     set i 1
     while {$i <= 4} {
@@ -181,9 +199,11 @@ test while-2.3 {continue tests, nested loops} {
             set msg [concat $msg "$i.$a"]
         }
     }
-    set msg
-} {2.2 2.3 3.2 4.2 5.2}
-test while-2.4 {continue tests, long command body} {
+    return $msg
+} -cleanup {
+    unset a i msg
+} -result {2.2 2.3 3.2 4.2 5.2}
+test while-2.4 {continue tests, long command body} -body {
     set a {}
     set i 1
     while {$i<6} {
@@ -218,12 +238,14 @@ test while-2.4 {continue tests, long command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 3}
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 3}
 
 # Check "while" and "break".
 
-test while-3.1 {break tests} {
+test while-3.1 {break tests} -body {
     set a {}
     set i 1
     while {$i <= 4} {
@@ -231,9 +253,11 @@ test while-3.1 {break tests} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2}
-test while-3.2 {break tests, nested loops} {
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 2}
+test while-3.2 {break tests, nested loops} -body {
     set msg {}
     set i 1
     while {$i <= 4} {
@@ -245,9 +269,11 @@ test while-3.2 {break tests, nested loops} {
         }
         incr i
     }
-    set msg
-} {1.1 1.2 2.1 3.1 4.1}
-test while-3.3 {break tests, long command body} {
+    return $msg
+} -cleanup {
+    unset a i msg
+} -result {1.1 1.2 2.1 3.1 4.1}
+test while-3.3 {break tests, long command body} -body {
     set a {}
     set i 1
     while {$i<6} {
@@ -283,38 +309,42 @@ test while-3.3 {break tests, long command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 3}
+    return $a
+} -cleanup {
+    unset a i
+} -result {1 3}
 
 # Check "while" with computed command names.
 
-test while-4.1 {while and computed command names} {
+test while-4.1 {while and computed command names} -body {
     set i 0
     set z while
     $z {$i < 10} {
         incr i
     }
-    set i
-} 10
-test while-4.2 {while (not compiled): missing test expression} {
+    return $i
+} -cleanup {
+    unset i z
+} -result 10
+test while-4.2 {while (not compiled): missing test expression} -body {
     set z while
-    catch {$z } msg
-    set msg
-} {wrong # args: should be "while test command"}
-test while-4.3 {while (not compiled): error in test expression} {
+    $z
+} -returnCodes error -cleanup {
+    unset z
+} -result {wrong # args: should be "while test command"}
+test while-4.3 {while (not compiled): error in test expression} -body {
     set i 0
     set z while
-    catch {$z {$i<} {set x 1}} msg
-    set errorInfo
-} {syntax error in expression "$i<": premature end of expression
-    while executing
-"$z {$i<} {set x 1}"}
-test while-4.4 {while (not compiled): error in test expression} {
+    catch {$z {$i<} {set x 1}}
+    return $::errorInfo
+} -match glob -cleanup {
+    unset i z
+} -result {*"$z {$i<} {set x 1}"}
+test while-4.4 {while (not compiled): error in test expression} -body {
     set z while
-    set err [catch {$z {"a"+"b"} {error "loop aborted"}} msg]
-    list $err $msg
-} {1 {can't use non-numeric string as operand of "+"}}
-test while-4.5 {while (not compiled): multiline test expr} {
+    $z {"a"+"b"} {error "loop aborted"}
+} -returnCodes error -result {can't use non-numeric string as operand of "+"}
+test while-4.5 {while (not compiled): multiline test expr} -body {
     set value 1
     set z while
     $z {($tcl_platform(platform) != "foobar1") && \
@@ -322,9 +352,11 @@ test while-4.5 {while (not compiled): multiline test expr} {
         incr value
         break
     }
-    set value
-} {2}
-test while-4.6 {while (not compiled): non-numeric boolean test expr} {
+    return $value
+} -cleanup {
+    unset value z
+} -result {2}
+test while-4.6 {while (not compiled): non-numeric boolean test expr} -body {
     set value 1
     set z while
     $z {"true"} {
@@ -333,31 +365,38 @@ test while-4.6 {while (not compiled): non-numeric boolean test expr} {
 	    break;
 	}
     }
-    set value
-} 6
-test while-4.7 {while (not compiled): test expr is enclosed in quotes} {
+    return $value
+} -cleanup {
+    unset value z
+} -result 6
+test while-4.7 {while (not compiled): test expr is enclosed in quotes} -body {
     set i 0
     set z while
     $z "$i > 5" {}
-} {}
-test while-4.8 {while (not compiled): missing command body} {
+} -cleanup {
+    unset i z
+} -result {}
+test while-4.8 {while (not compiled): missing command body} -body {
     set i 0
     set z while
-    catch {$z {$i < 5} } msg
-    set msg
-} {wrong # args: should be "while test command"}
+    $z {$i < 5}
+} -returnCodes error -cleanup {
+    unset i z
+} -result {wrong # args: should be "while test command"}
 test while-4.9 {while (not compiled): error compiling command body} -body {
     set i 0
     set z while
-    catch {$z {$i < 5} {set}} msg
-    set errorInfo
-} -match glob -result {wrong # args: should be "set varName ?newValue?"
+    catch {$z {$i < 5} {set}}
+    set ::errorInfo
+} -match glob -cleanup {
+    unset i z
+} -result {wrong # args: should be "set varName ?newValue?"
     while *ing
 "set"
     ("while" body line 1)
     invoked from within
 "$z {$i < 5} {set}"}
-test while-4.10 {while (not compiled): simple command body} {
+test while-4.10 {while (not compiled): simple command body} -body {
     set a {}
     set i 1
     set z while
@@ -366,29 +405,36 @@ test while-4.10 {while (not compiled): simple command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2 3}
-test while-4.11 {while (not compiled): command body in quotes} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 2 3}
+test while-4.11 {while (not compiled): command body in quotes} -body {
     set a {}
     set i 1
     set z while
     $z {$i<6} "append a x; incr i"
-    set a
-} {xxxxx}
-test while-4.12 {while (not compiled): computed command body} {
-    set z while
+    return $a
+} -cleanup {
+    unset a i z
+} -result {xxxxx}
+test while-4.12 {while (not compiled): computed command body} -setup {
     catch {unset x1}
     catch {unset bb}
     catch {unset x2}
+} -body {
+    set z while
     set x1 {append a x1; }
     set bb {break}
     set x2 {; append a x2; incr i}
     set a {}
     set i 1
     $z {$i<6} $x1$bb$x2
-    set a
-} {x1}
-test while-4.13 {while (not compiled): long command body} {
+    return $a
+} -cleanup {
+    unset z x1 bb x2 a i
+} -result {x1}
+test while-4.13 {while (not compiled): long command body} -body {
     set a {}
     set z while
     set i 1
@@ -423,33 +469,41 @@ test while-4.13 {while (not compiled): long command body} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2 3}
-test while-4.14 {while (not compiled): while command result} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 2 3}
+test while-4.14 {while (not compiled): while command result} -body {
     set i 0
     set z while
     set a [$z {$i < 5} {incr i}]
-    set a
-} {}
-test while-4.15 {while (not compiled): while command result} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {}
+test while-4.15 {while (not compiled): while command result} -body {
     set i 0
     set z while
     set a [$z {$i < 5} {if $i==3 break; incr i}]
-    set a
-} {}
+    return $a
+} -cleanup {
+    unset a i z
+} -result {}
 
 # Check "break" with computed command names.
 
-test while-5.1 {break and computed command names} {
+test while-5.1 {break and computed command names} -body {
     set i 0
     set z break
     while 1 {
         if {$i > 10} $z
         incr i
     }
-    set i
-} 11
-test while-5.2 {break tests with computed command names} {
+    return $i
+} -cleanup {
+    unset i z
+} -result 11
+test while-5.2 {break tests with computed command names} -body {
     set a {}
     set i 1
     set z break
@@ -458,9 +512,11 @@ test while-5.2 {break tests with computed command names} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 2}
-test while-5.3 {break tests, nested loops with computed command names} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 2}
+test while-5.3 {break tests, nested loops with computed command names} -body {
     set msg {}
     set i 1
     set z break
@@ -473,9 +529,11 @@ test while-5.3 {break tests, nested loops with computed command names} {
         }
         incr i
     }
-    set msg
-} {1.1 1.2 2.1 3.1 4.1}
-test while-5.4 {break tests, long command body with computed command names} {
+    return $msg
+} -cleanup {
+    unset a i z msg
+} -result {1.1 1.2 2.1 3.1 4.1}
+test while-5.4 {break tests, long command body with computed command names} -body {
     set a {}
     set i 1
     set z break
@@ -512,12 +570,14 @@ test while-5.4 {break tests, long command body with computed command names} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 3}
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 3}
 
 # Check "continue" with computed command names.
 
-test while-6.1 {continue and computed command names} {
+test while-6.1 {continue and computed command names} -body {
     set i 0
     set z continue
     while 1 {
@@ -525,9 +585,11 @@ test while-6.1 {continue and computed command names} {
         if {$i < 10} $z
         break
     }
-    set i
-} 10
-test while-6.2 {continue tests} {
+    return $i
+} -cleanup {
+    unset i z
+} -result 10
+test while-6.2 {continue tests} -body {
     set a {}
     set i 1
     set z continue
@@ -536,9 +598,11 @@ test while-6.2 {continue tests} {
 	if {$i == 3} $z
 	set a [concat $a $i]
     }
-    set a
-} {2 4 5}
-test while-6.3 {continue tests with computed command names} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {2 4 5}
+test while-6.3 {continue tests with computed command names} -body {
     set a {}
     set i 1
     set z continue
@@ -547,9 +611,11 @@ test while-6.3 {continue tests with computed command names} {
 	if {$i != 2} $z
 	set a [concat $a $i]
     }
-    set a
-} {2}
-test while-6.4 {continue tests, nested loops with computed command names} {
+    return $a
+} -cleanup {
+    unset a i z
+} -result {2}
+test while-6.4 {continue tests, nested loops with computed command names} -body {
     set msg {}
     set i 1
     set z continue
@@ -562,9 +628,11 @@ test while-6.4 {continue tests, nested loops with computed command names} {
             set msg [concat $msg "$i.$a"]
         }
     }
-    set msg
-} {2.2 2.3 3.2 4.2 5.2}
-test while-6.5 {continue tests, long command body with computed command names} {
+    return $msg
+} -cleanup {
+    unset a i z msg
+} -result {2.2 2.3 3.2 4.2 5.2}
+test while-6.5 {continue tests, long command body with computed command names} -body {
     set a {}
     set i 1
     set z continue
@@ -600,12 +668,14 @@ test while-6.5 {continue tests, long command body with computed command names} {
 	set a [concat $a $i]
         incr i
     }
-    set a
-} {1 3}
+    return $a
+} -cleanup {
+    unset a i z
+} -result {1 3}
 
 # Test for incorrect "double evaluation" semantics
 
-test while-7.1 {delayed substitution of body} {
+test while-7.1 {delayed substitution of body} -body {
     set i 0
     while {[incr i] < 10} "
        set result $i
@@ -615,11 +685,18 @@ test while-7.1 {delayed substitution of body} {
 	while {[incr i] < 10} "
 	    set result $i
 	"
-	set result
+	return $result
     }
     append result [p]
-} {00}
+} -cleanup {
+    unset result i
+} -result {00}
 
 # cleanup
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tests/winConsole.test b/tests/winConsole.test
index 6b8b2db..fdde41c 100644
--- a/tests/winConsole.test
+++ b/tests/winConsole.test
@@ -8,8 +8,6 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winConsole.test,v 1.7 2004/06/23 15:36:58 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -37,7 +35,7 @@ test winConsole-1.1 {Console file channel: non-blocking gets} {win interactive}
 
     #cleanup the fileevent
     fileevent stdin readable {}
-    fconfigure stdin {expand}$oldmode
+    fconfigure stdin {*}$oldmode
 
     set result
 
diff --git a/tests/winDde.test b/tests/winDde.test
index f59a7f2..f04fb45 100644
--- a/tests/winDde.test
+++ b/tests/winDde.test
@@ -8,26 +8,21 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winDde.test,v 1.28 2005/05/10 18:35:25 kennykb Exp $
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
+if {"::tcltest" ni [namespace children]} {
     package require tcltest 2
     #tcltest::configure -verbose {pass start}
     namespace import -force ::tcltest::*
 }
 
+testConstraint debug [::tcl::pkgconfig get debug]
+testConstraint dde 0
 if {[testConstraint win]} {
-    if [catch {
-	# Is the dde extension already static to this shell?
-	if [catch {load {} Dde; set ::ddelib {}}] {
-	    # try the location given to use on the commandline to tcltest
+    if {![catch {
 	    ::tcltest::loadTestedCommands
-	    load $::ddelib Dde
-	}
+	    set ::ddever [package require dde 1.4.0]
+	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
 	testConstraint dde 1
-    }] {
-	testConstraint dde 0
     }
 }
 
@@ -38,22 +33,20 @@ if {[testConstraint win]} {
 
 set scriptName [makeFile {} script1.tcl]
 
-proc createChildProcess { ddeServerName {handler {}}} {
+proc createChildProcess {ddeServerName args} {
     file delete -force $::scriptName
 
     set f [open $::scriptName w+]
     puts $f [list set ddeServerName $ddeServerName]
-    if {$::ddelib != ""} {
-	puts $f [list load $::ddelib Dde]
-    }
+    puts $f [list load $::ddelib dde]
     puts $f {
         # DDE child server -
         #
-	if {[lsearch [namespace children] ::tcltest] == -1} {
+	if {"::tcltest" ni [namespace children]} {
 	    package require tcltest
 	    namespace import -force ::tcltest::*
 	}
-        
+
         # If an error occurs during the tests, this process may end up not
         # being closed down. To deal with this we create a 30s timeout.
         proc ::DoTimeout {} {
@@ -63,16 +56,19 @@ proc createChildProcess { ddeServerName {handler {}}} {
             flush stdout
         }
         set timeout [after 30000 ::DoTimeout]
-        
+
         # Define a restricted handler.
         proc Handler1 {cmd} {
             if {$cmd eq "stop"} {set ::done 1}
-            puts $cmd ; flush stdout 
+            if {$cmd == ""} {
+                set cmd "null data"
+            }
+            puts $cmd ; flush stdout
             return
         }
         proc Handler2 {cmd} {
             if {$cmd eq "stop"} {set ::done 1}
-            puts [uplevel \#0 $cmd] ; flush stdout 
+            puts [uplevel \#0 $cmd] ; flush stdout
             return
         }
         proc Handler3 {prefix cmd} {
@@ -82,11 +78,7 @@ proc createChildProcess { ddeServerName {handler {}}} {
         }
     }
     # set the dde server name to the supplied argument.
-    if {$handler == {}} {
-        puts $f [list dde servername $ddeServerName]
-    } else {
-        puts $f [list dde servername -handler $handler -- $ddeServerName]
-    }        
+    puts $f [list dde servername {*}$args -- $ddeServerName]
     puts $f {
         # run the server and handle final cleanup.
         after 200;# give dde a chance to get going.
@@ -96,12 +88,12 @@ proc createChildProcess { ddeServerName {handler {}}} {
 	# allow enough time for the calling process to
 	# claim all results, to avoid spurious "server did
 	# not respond"
-	after 200 { set reallyDone 1 }
+	after 200 {set reallyDone 1}
 	vwait reallyDone
 	exit
     }
     close $f
-    
+
     # run the child server script.
     set f [open |[list [interpreter] $::scriptName] r]
     fconfigure $f -buffering line
@@ -110,147 +102,184 @@ proc createChildProcess { ddeServerName {handler {}}} {
 }
 
 # -------------------------------------------------------------------------
+test winDde-1.0 {check if we are testing the right dll} {win dde} {
+    set ::ddever
+} {1.4.0}
 
-test winDde-1.1 {Settings the server's topic name} {win dde} {
+test winDde-1.1 {Settings the server's topic name} -constraints dde -body {
     list [dde servername foobar] [dde servername] [dde servername self]
-}  {foobar foobar self}
+} -result {foobar foobar self}
 
-test winDde-2.1 {Checking for other services} {win dde} {
+test winDde-2.1 {Checking for other services} -constraints dde -body {
     expr [llength [dde services {} {}]] >= 0
-} 1
+} -result 1
 test winDde-2.2 {Checking for existence, with service and topic specified} \
-	{win dde} {
+	-constraints dde -body {
     llength [dde services TclEval self]
-} 1
+} -result 1
 test winDde-2.3 {Checking for existence, with only the service specified} \
-	{win dde} {
+	-constraints dde -body {
     expr [llength [dde services TclEval {}]] >= 1
-} 1
+} -result 1
 test winDde-2.4 {Checking for existence, with only the topic specified} \
-	{win dde} {
+	-constraints dde -body {
     expr [llength [dde services {} self]] >= 1
-} 1
+} -result 1
 
 # -------------------------------------------------------------------------
 
-test winDde-3.1 {DDE execute locally} {win dde} {
-    set a ""
-    dde execute TclEval self {set a "foo"}
-    set a
-} foo
-test winDde-3.2 {DDE execute -async locally} {win dde} {
-    set a ""
-    dde execute -async TclEval self {set a "foo"}
+test winDde-3.1 {DDE execute locally} -constraints dde -body {
+    set \xe1 ""
+    dde execute TclEval self [list set \xe1 foo]
+    set \xe1
+} -result foo
+test winDde-3.2 {DDE execute -async locally} -constraints dde -body {
+    set \xe1 ""
+    dde execute -async TclEval self [list set \xe1 foo]
     update
-    set a
-} foo
-test winDde-3.3 {DDE request locally} {win dde} {
-    set a ""
-    dde execute TclEval self {set a "foo"}
-    dde request TclEval self a
-} foo
-test winDde-3.4 {DDE eval locally} {win dde} {
-    set a ""
-    dde eval self set a "foo"
-} foo
-test winDde-3.5 {DDE request locally} {win dde} {
-    set a ""
-    dde execute TclEval self {set a "foo"}
-    dde request -binary TclEval self a
-} "foo\x00"
+    set \xe1
+} -result foo
+test winDde-3.3 {DDE request locally} -constraints dde -body {
+    set \xe1 ""
+    dde execute TclEval self [list set \xe1 foo]
+    dde request TclEval self \xe1
+} -result foo
+test winDde-3.4 {DDE eval locally} -constraints dde -body {
+    set \xe1 ""
+    dde eval self set \xe1 foo
+} -result foo
+test winDde-3.5 {DDE request locally} -constraints dde -body {
+    set \xe1 ""
+    dde execute TclEval self [list set \xe1 foo]
+    dde request -binary TclEval self \xe1
+} -result "foo\x00"
+# Set variable a to A with diaeresis (unicode C4) by relying on the fact
+# that utf8 is sent (e.g. "c3 84" on the wire)
+test winDde-3.6 {DDE request utf8} -constraints dde -body {
+    set \xe1 "not set"
+    dde execute TclEval self "set \xe1 \xc4"
+    scan [set \xe1] %c
+} -result 196
+# Set variable a to A with diaeresis (unicode C4) using binary execute
+# and compose utf-8 (e.g. "c3 84" ) manualy
+test winDde-3.7 {DDE request binary} -constraints dde -body {
+    set \xe1 "not set"
+    dde execute -binary TclEval self [list set \xc3\xa1 \xc3\x84\x00]
+    scan [set \xe1] %c
+} -result 196
+test winDde-3.8 {DDE poke locally} -constraints {dde debug} -body {
+    set \xe1 ""
+    dde poke TclEval self \xe1 \xc4
+    dde request TclEval self \xe1
+} -result \xc4
+test winDde-3.9 {DDE poke -binary locally} -constraints {dde debug} -body {
+    set \xe1 ""
+    dde poke -binary TclEval self \xe1 \xc3\x84\x00
+    dde request TclEval self \xe1
+} -result \xc4
 
 # -------------------------------------------------------------------------
 
-test winDde-4.1 {DDE execute remotely} {stdio win dde} {
-    set a ""
-    set name child-4.1
+test winDde-4.1 {DDE execute remotely} -constraints {dde stdio} -body {
+    set \xe1 ""
+    set name ch\xEDld-4.1
     set child [createChildProcess $name]
-    dde execute TclEval $name {set a "foo"}
+    dde execute TclEval $name [list set \xe1 foo]
     dde execute TclEval $name {set done 1}
     update
-    set a
-} ""
-test winDde-4.2 {DDE execute async remotely} {stdio win dde} {
-    set a ""
-    set name child-4.2
+    set \xe1
+} -result ""
+test winDde-4.2 {DDE execute async remotely} -constraints {dde stdio} -body {
+    set \xe1 ""
+    set name ch\xEDld-4.2
     set child [createChildProcess $name]
-    dde execute -async TclEval $name {set a "foo"}
+    dde execute -async TclEval $name [list set \xe1 foo]
     update
     dde execute TclEval $name {set done 1}
     update
-    set a
-} ""
-test winDde-4.3 {DDE request remotely} {stdio win dde} {
-    set a ""
-    set name chile-4.3
+    set \xe1
+} -result ""
+test winDde-4.3 {DDE request remotely} -constraints {dde stdio} -body {
+    set \xe1 ""
+    set name ch\xEDld-4.3
     set child [createChildProcess $name]
-    dde execute TclEval $name {set a "foo"}
-    set a [dde request TclEval $name a]
+    dde execute TclEval $name [list set \xe1 foo]
+    set \xe1 [dde request TclEval $name \xe1]
     dde execute TclEval $name {set done 1}
     update
-    set a
-} foo
-test winDde-4.4 {DDE eval remotely} {stdio win dde} {
-    set a ""
-    set name child-4.4
+    set \xe1
+} -result foo
+test winDde-4.4 {DDE eval remotely} -constraints {dde stdio} -body {
+    set \xe1 ""
+    set name ch\xEDld-4.4
     set child [createChildProcess $name]
-    set a [dde eval $name set a "foo"]
+    set \xe1 [dde eval $name set \xe1 foo]
     dde execute TclEval $name {set done 1}
     update
-    set a
-} foo
+    set \xe1
+}  -result foo
+test winDde-4.5 {DDE poke remotely} -constraints {dde debug stdio} -body {
+    set \xe1 ""
+    set name ch\xEDld-4.5
+    set child [createChildProcess $name]
+    dde poke TclEval $name \xe1 foo
+    set \xe1 [dde request TclEval $name \xe1]
+    dde execute TclEval $name {set done 1}
+    update
+    set \xe1
+} -result foo
 
 # -------------------------------------------------------------------------
 
-test winDde-5.1 {check for bad arguments} -constraints {win dde} -body {
+test winDde-5.1 {check for bad arguments} -constraints dde -body {
     dde execute "" "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
-test winDde-5.2 {check for bad arguments} -constraints {win dde} -body {
-    dde execute "" "" ""
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
+test winDde-5.2 {check for bad arguments} -constraints dde -body {
+    dde execute -binary "" "" ""
 } -returnCodes error -result {cannot execute null data}
-test winDde-5.3 {check for bad arguments} -constraints {win dde} -body {
+test winDde-5.3 {check for bad arguments} -constraints dde -body {
     dde execute -foo "" "" ""
-} -returnCodes error -result {wrong # args: should be "dde execute ?-async? serviceName topicName value"}
-test winDde-5.4 {DDE eval bad arguments} -constraints {win dde} -body {
+} -returnCodes error -result {wrong # args: should be "dde execute ?-async? ?-binary? serviceName topicName value"}
+test winDde-5.4 {DDE eval bad arguments} -constraints dde -body {
     dde eval "" "foo"
 } -returnCodes error -result {invalid service name ""}
 
 # -------------------------------------------------------------------------
 
-test winDde-6.1 {DDE servername bad arguments} -constraints {win dde} -body {
+test winDde-6.1 {DDE servername bad arguments} -constraints dde -body {
     dde servername -z -z -z
 } -returnCodes error -result {bad option "-z": must be -force, -handler, or --}
-test winDde-6.2 {DDE servername set name} -constraints {win dde} -body {
+test winDde-6.2 {DDE servername set name} -constraints dde -body {
     dde servername -- winDde-6.2
 } -result {winDde-6.2}
-test winDde-6.3 {DDE servername set exact name} -constraints {win dde} -body {
+test winDde-6.3 {DDE servername set exact name} -constraints dde -body {
     dde servername -force winDde-6.3
 } -result {winDde-6.3}
-test winDde-6.4 {DDE servername set exact name} -constraints {win dde} -body {
+test winDde-6.4 {DDE servername set exact name} -constraints dde -body {
     dde servername -force -- winDde-6.4
 } -result {winDde-6.4}
-test winDde-6.5 {DDE remote servername collision} -constraints {stdio win dde} -setup {
-    set name child-6.5
+test winDde-6.5 {DDE remote servername collision} -constraints {dde stdio} -setup {
+    set name ch\xEDld-6.5
     set child [createChildProcess $name]
 } -body {
     dde servername -- $name
 } -cleanup {
     dde execute TclEval $name {set done 1}
     update
-} -result "child-6.5 #2"
-test winDde-6.6 {DDE remote servername collision force} -constraints {stdio win dde} -setup {
-    set name child-6.6
+} -result "ch\xEDld-6.5 #2"
+test winDde-6.6 {DDE remote servername collision force} -constraints {dde stdio} -setup {
+    set name ch\xEDld-6.6
     set child [createChildProcess $name]
 } -body {
     dde servername -force -- $name
 } -cleanup {
     dde execute TclEval $name {set done 1}
     update
-} -result {child-6.6}
+} -result "ch\xEDld-6.6"
 
 # -------------------------------------------------------------------------
 
-test winDde-7.1 {Load DDE in slave interpreter } -constraints {win dde} -setup {
+test winDde-7.1 {Load DDE in slave interpreter} -constraints dde -setup {
     interp create slave
 } -body {
     slave eval [list load $::ddelib Dde]
@@ -258,7 +287,7 @@ test winDde-7.1 {Load DDE in slave interpreter } -constraints {win dde} -setup {
 } -cleanup {
     interp delete slave
 } -result {dde-interp-7.1}
-test winDde-7.2 {DDE slave cleanup} -constraints {win dde} -setup {
+test winDde-7.2 {DDE slave cleanup} -constraints dde -setup {
     interp create slave
     slave eval [list load $::ddelib Dde]
     slave eval [list dde servername -- dde-interp-7.5]
@@ -267,11 +296,11 @@ test winDde-7.2 {DDE slave cleanup} -constraints {win dde} -setup {
     dde services TclEval {}
     set s [dde services TclEval {}]
     set m [list [list TclEval dde-interp-7.5]]
-    if {[lsearch -exact $s $m] != -1} {
+    if {$m in $s} {
 	set s
     }
 } -result {}
-test winDde-7.3 {DDE present in slave interp} -constraints {win dde} -setup {
+test winDde-7.3 {DDE present in slave interp} -constraints dde -setup {
     interp create slave
     slave eval [list load $::ddelib Dde]
     slave eval [list dde servername -- dde-interp-7.3]
@@ -280,7 +309,7 @@ test winDde-7.3 {DDE present in slave interp} -constraints {win dde} -setup {
 } -cleanup {
     interp delete slave
 } -result {{TclEval dde-interp-7.3}}
-test winDde-7.4 {interp name collision with -force} -constraints {win dde} -setup {
+test winDde-7.4 {interp name collision with -force} -constraints dde -setup {
     interp create slave
     slave eval [list load $::ddelib Dde]
     slave eval [list dde servername -- dde-interp-7.4]
@@ -289,7 +318,7 @@ test winDde-7.4 {interp name collision with -force} -constraints {win dde} -setu
 } -cleanup {
     interp delete slave
 } -result {dde-interp-7.4}
-test winDde-7.5 {interp name collision without -force} -constraints {win dde} -setup {
+test winDde-7.5 {interp name collision without -force} -constraints dde -setup {
     interp create slave
     slave eval [list load $::ddelib Dde]
     slave eval [list dde servername -- dde-interp-7.5]
@@ -301,7 +330,7 @@ test winDde-7.5 {interp name collision without -force} -constraints {win dde} -s
 
 # -------------------------------------------------------------------------
 
-test winDde-8.1 {Safe DDE load} -constraints {win dde} -setup {
+test winDde-8.1 {Safe DDE load} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
 } -body {
@@ -309,20 +338,20 @@ test winDde-8.1 {Safe DDE load} -constraints {win dde} -setup {
 } -cleanup {
     interp delete slave
 } -returnCodes error -result {invalid command name "dde"}
-test winDde-8.2 {Safe DDE set servername} -constraints {win dde} -setup {
+test winDde-8.2 {Safe DDE set servername} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
 } -body {
     slave invokehidden dde servername slave
 } -cleanup {interp delete slave} -result {slave}
-test winDde-8.3 {Safe DDE check handler required for eval} -constraints {win dde} -setup {
+test winDde-8.3 {Safe DDE check handler required for eval} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
     slave invokehidden dde servername slave
 } -body {
     catch {dde eval slave set a 1} msg
 } -cleanup {interp delete slave} -result {1}
-test winDde-8.4 {Safe DDE check that execute is denied} -constraints {win dde} -setup {
+test winDde-8.4 {Safe DDE check that execute is denied} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
     slave invokehidden dde servername slave
@@ -331,7 +360,7 @@ test winDde-8.4 {Safe DDE check that execute is denied} -constraints {win dde} -
     dde execute TclEval slave {set a 2}
     slave eval set a
 } -cleanup {interp delete slave} -result 1
-test winDde-8.5 {Safe DDE check that request is denied} -constraints {win dde} -setup {
+test winDde-8.5 {Safe DDE check that request is denied} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
     slave invokehidden dde servername slave
@@ -341,14 +370,14 @@ test winDde-8.5 {Safe DDE check that request is denied} -constraints {win dde} -
 } -cleanup {
     interp delete slave
 } -returnCodes error -result {remote server cannot handle this command}
-test winDde-8.6 {Safe DDE assign handler procedure} -constraints {win dde} -setup {
+test winDde-8.6 {Safe DDE assign handler procedure} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
     slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
 } -body {
     slave invokehidden dde servername -handler DDEACCEPT slave
 } -cleanup {interp delete slave} -result slave
-test winDde-8.7 {Safe DDE check simple command} -constraints {win dde} -setup {
+test winDde-8.7 {Safe DDE check simple command} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
     slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
@@ -356,7 +385,7 @@ test winDde-8.7 {Safe DDE check simple command} -constraints {win dde} -setup {
 } -body {
     dde eval slave set x 1
 } -cleanup {interp delete slave} -result {set x 1}
-test winDde-8.8 {Safe DDE check non-list command} -constraints {win dde} -setup {
+test winDde-8.8 {Safe DDE check non-list command} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
     slave eval {proc DDEACCEPT {cmd} {set ::DDECMD $cmd}}
@@ -366,16 +395,16 @@ test winDde-8.8 {Safe DDE check non-list command} -constraints {win dde} -setup
     dde eval slave $s
     string equal [slave eval set DDECMD] $s
 } -cleanup {interp delete slave} -result 1
-test winDde-8.9 {Safe DDE check command evaluation} -constraints {win dde} -setup {
+test winDde-8.9 {Safe DDE check command evaluation} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
     slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
     slave invokehidden dde servername -handler DDEACCEPT slave
 } -body {
-    dde eval slave set x 1
-    slave eval set x
+    dde eval slave set \xe1 1
+    slave eval set \xe1
 } -cleanup {interp delete slave} -result 1
-test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints {win dde} -setup {
+test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
     slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
@@ -384,7 +413,7 @@ test winDde-8.10 {Safe DDE check command evaluation (2)} -constraints {win dde}
     dde eval slave [list set x 1]
     slave eval set x
 } -cleanup {interp delete slave} -result 1
-test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints {win dde} -setup {
+test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints dde -setup {
     interp create -safe slave
     slave invokehidden load $::ddelib Dde
     slave eval {proc DDEACCEPT {cmd} {set ::DDECMD [uplevel \#0 $cmd]}}
@@ -396,9 +425,9 @@ test winDde-8.11 {Safe DDE check command evaluation (3)} -constraints {win dde}
 
 # -------------------------------------------------------------------------
 
-test winDde-9.1 {External safe DDE check string passing} -constraints {win dde stdio} -setup {
-    set name child-9.1
-    set child [createChildProcess $name Handler1]
+test winDde-9.1 {External safe DDE check string passing} -constraints {dde stdio} -setup {
+    set name ch\xEDld-9.1
+    set child [createChildProcess $name -handler Handler1]
     file copy -force script1.tcl dde-script.tcl
 } -body {
     dde eval $name set x 1
@@ -409,9 +438,9 @@ test winDde-9.1 {External safe DDE check string passing} -constraints {win dde s
     update
     file delete -force -- dde-script.tcl
 } -result {set x 1}
-test winDde-9.2 {External safe DDE check command evaluation} -constraints {win dde stdio} -setup {
-    set name child-9.2
-    set child [createChildProcess $name Handler2]
+test winDde-9.2 {External safe DDE check command evaluation} -constraints {dde stdio} -setup {
+    set name ch\xEDld-9.2
+    set child [createChildProcess $name -handler Handler2]
     file copy -force script1.tcl dde-script.tcl
 } -body {
     dde eval $name set x 1
@@ -422,9 +451,9 @@ test winDde-9.2 {External safe DDE check command evaluation} -constraints {win d
     update
     file delete -force -- dde-script.tcl
 } -result 1
-test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {win dde stdio} -setup {
-    set name child-9.3
-    set child [createChildProcess $name [list Handler3 ARG]]
+test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {dde stdio} -setup {
+    set name ch\xEDld-9.3
+    set child [createChildProcess $name -handler [list Handler3 ARG]]
     file copy -force script1.tcl dde-script.tcl
 } -body {
     dde eval $name set x 1
@@ -435,6 +464,19 @@ test winDde-9.3 {External safe DDE check prefixed arguments} -constraints {win d
     update
     file delete -force -- dde-script.tcl
 } -result {ARG {set x 1}}
+test winDde-9.4 {External safe DDE check null data passing} -constraints {dde stdio} -setup {
+    set name ch\xEDld-9.4
+    set child [createChildProcess $name -handler Handler1]
+    file copy -force script1.tcl dde-script.tcl
+} -body {
+    dde execute TclEval $name ""
+    gets $child line
+    set line
+} -cleanup {
+    dde execute TclEval $name stop
+    update
+    file delete -force -- dde-script.tcl
+} -result {null data}
 
 # -------------------------------------------------------------------------
 
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 51c0726..28257c6 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -9,15 +9,27 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winFCmd.test,v 1.38 2005/05/10 18:35:25 kennykb Exp $
-#
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+# Initialise the test constraints
+
+testConstraint winVista 0
+testConstraint win2000orXP 0
+testConstraint winOlderThan2000 0
+testConstraint testvolumetype [llength [info commands testvolumetype]]
+testConstraint testfile       [llength [info commands testfile]]
+testConstraint testchmod      [llength [info commands testchmod]]
+testConstraint cdrom 0
+testConstraint exdev 0
+testConstraint longFileNames 0
+
 proc createfile {file {string a}} {
     set f [open $file w]
     puts -nonewline $f $string
@@ -39,77 +51,61 @@ proc cleanup {args} {
 	    set x [glob -directory $p tf* td*]
 	}
 	if {$x != ""} {
-	    catch {file delete -force -- {expand}$x}
+	    catch {file delete -force -- {*}$x}
 	}
     }
 }
 
-if {[string equal $tcl_platform(platform) "windows"]} {
-    if {[string equal $tcl_platform(os) "Windows NT"] \
-      && [string equal [string index $tcl_platform(osVersion) 0] "5"]} {
-	tcltest::testConstraint win2000orXP 1
-	tcltest::testConstraint winOlderThan2000 0
+if {[testConstraint winOnly]} {
+    set major [string index $tcl_platform(osVersion) 0]
+    if {[testConstraint nt] && $major > 4} {
+        if {$major > 5} {
+            testConstraint winVista 1
+        } elseif {$major == 5} {
+            testConstraint win2000orXP 1
+        }
     } else {
-	tcltest::testConstraint win2000orXP 0
-	tcltest::testConstraint winOlderThan2000 1
+	testConstraint winOlderThan2000 1
     }
-} else {
-    tcltest::testConstraint win2000orXP 0
-    tcltest::testConstraint winOlderThan2000 0
 }
 
 # find a CD-ROM so we can test read-only filesystems.
 
-set cdrom {}
-if { [info commands ::testvolumetype] ne {} } {
-    foreach p {d e f g h i j k l m n o p q r s t u v w x y z} {
-        if { ! [catch { testvolumetype ${p}: } result] && $result eq {CDFS} } {
-            set cdrom ${p}:
-        }
-    }
-}
-
 proc findfile {dir} {
-    foreach p [glob $dir/*] {
-        if {[file type $p] == "file"} {
-	    return $p
-	}
+    foreach p [glob -nocomplain -type f -directory $dir *] {
+	return $p
     }
-    foreach p [glob $dir/*] {
-        if {[file type $p] == "directory"} {
-	    set f [findfile $p]
-	    if {$f != ""} {
-	        return $f
-	    }
+    foreach p [glob -nocomplain -type d -directory $dir *] {
+	set f [findfile $p]
+	if {$f ne ""} {
+	    return $f
 	}
     }
     return ""
 }
 
-if {$cdrom != ""} {
-    testConstraint cdrom 1
-    set cdfile [findfile $cdrom]
-} else {
-    testConstraint cdrom 0
+if {[testConstraint testvolumetype]} {
+    foreach p {d e f g h i j k l m n o p q r s t u v w x y z} {
+        if {![catch {testvolumetype ${p}:} result] && $result in {CDFS UDF}} {
+            set cdrom ${p}:
+	    set cdfile [findfile $cdrom]
+	    testConstraint cdrom 1
+	    break
+        }
+    }
 }
 
+# NB: filename is chosen to be short but unlikely to clash with other apps
 if {[file exists c:/] && [file exists d:/]} {
-    catch {file delete d:/tf1}
-    if {[catch {close [open d:/tf1 w]}] == 0} {
-	file delete d:/tf1
+    catch {file delete d:/TclTmpF.1}
+    if {[catch {createfile d:/TclTmpF.1 {}}] == 0} {
+	file delete d:/TclTmpF.1
 	testConstraint exdev 1
-    } else {
-	testConstraint exdev 0
     }
-} else {
-    testConstraint exdev 0
 }
 
 file delete -force -- td1
-set foo [catch {open td1 w} testfile]
-if {$foo} {
-    testConstraint longFileNames 0
-} else {
+if {![catch {open td1 w} testfile]} {
     close $testfile
     testConstraint longFileNames 1
     file delete -force -- td1
@@ -131,622 +127,764 @@ append longname $longname
 # it can be difficult to actually forward "insane" arguments to the
 # low-level posix emulation layer.
 
-test winFCmd-1.1 {TclpRenameFile: errno: EACCES} {win cdrom} {
-    list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
-} {1 EACCES}
-test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} {win} {
+test winFCmd-1.1 {TclpRenameFile: errno: EACCES} -body {
+    testfile mv $cdfile $cdrom/dummy~~.fil
+} -constraints {win cdrom testfile} -returnCodes error -result EACCES
+test winFCmd-1.2 {TclpRenameFile: errno: EEXIST} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1/td2/td3
     file mkdir td2
-    list [catch {testfile mv td2 td1/td2} msg] $msg
-} {1 EEXIST} 
-test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} {win} {
+    testfile mv td2 td1/td2
+} -returnCodes error -result EEXIST
+test winFCmd-1.3 {TclpRenameFile: errno: EINVAL} -setup {
     cleanup
-    list [catch {testfile mv / td1} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} {win} {
+} -constraints {win testfile} -body {
+    testfile mv / td1
+} -returnCodes error -result EINVAL
+test winFCmd-1.4 {TclpRenameFile: errno: EINVAL} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
-    list [catch {testfile mv td1 td1/td2} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} {win} {
+    testfile mv td1 td1/td2
+} -returnCodes error -result EINVAL
+test winFCmd-1.5 {TclpRenameFile: errno: EISDIR} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile tf1
-    list [catch {testfile mv tf1 td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} {win} {
+    testfile mv tf1 td1
+} -returnCodes error -result EISDIR
+test winFCmd-1.6 {TclpRenameFile: errno: ENOENT} -setup {
     cleanup
-    list [catch {testfile mv tf1 tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} {win} {
+} -constraints {win testfile} -body {
+    testfile mv tf1 tf2
+} -returnCodes error -result ENOENT
+test winFCmd-1.7 {TclpRenameFile: errno: ENOENT} -setup {
     cleanup
-    list [catch {testfile mv "" tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} {win} {
+} -constraints {win testfile} -body {
+    testfile mv "" tf2
+} -returnCodes error -result ENOENT
+test winFCmd-1.8 {TclpRenameFile: errno: ENOENT} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1
-    list [catch {testfile mv tf1 ""} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} {win} {
+    testfile mv tf1 ""
+} -returnCodes error -result ENOENT
+test winFCmd-1.9 {TclpRenameFile: errno: ENOTDIR} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile tf1
-    list [catch {testfile mv td1 tf1} msg] $msg
-} {1 ENOTDIR}
-test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} {win exdev} {
+    testfile mv td1 tf1
+} -returnCodes error -result ENOTDIR
+test winFCmd-1.10 {TclpRenameFile: errno: EXDEV} -setup {
     file delete -force d:/tf1
+} -constraints {win exdev testfile} -body {
     file mkdir c:/tf1
-    set msg [list [catch {testfile mv c:/tf1 d:/tf1} msg] $msg]
+    testfile mv c:/tf1 d:/tf1
+} -cleanup {
     file delete -force c:/tf1
-    set msg
-} {1 EXDEV}
-test winFCmd-1.11 {TclpRenameFile: errno: EACCES} {win} {
+} -returnCodes error -result EXDEV
+test winFCmd-1.11 {TclpRenameFile: errno: EACCES} -setup {
     cleanup
+} -constraints {win testfile} -body {
     set fd [open tf1 w]
-    set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
-    close $fd
-    set msg
-} {1 EACCES}
-test winFCmd-1.12 {TclpRenameFile: errno: EACCES} {win} {
+    testfile mv tf1 tf2
+} -cleanup {
+    catch {close $fd}
+} -returnCodes error -result EACCES
+test winFCmd-1.12 {TclpRenameFile: errno: EACCES} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1
     set fd [open tf2 w]
-    set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
-    close $fd
-    set msg
-} {1 EACCES}
-test winFCmd-1.13 {TclpRenameFile: errno: EACCES} {win win2000orXP} {
-    cleanup
-    list [catch {testfile mv nul tf1} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.13.1 {TclpRenameFile: errno: EACCES} {win nt winOlderThan2000} {
-    cleanup
-    list [catch {testfile mv nul tf1} msg] $msg
-} {1 EACCES}
-test winFCmd-1.13.2 {TclpRenameFile: errno: ENOENT} {win 95} {
+    testfile mv tf1 tf2
+} -cleanup {
+    catch {close $fd}
+} -returnCodes error -result EACCES
+test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
     cleanup
-    list [catch {testfile mv nul tf1} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.14 {TclpRenameFile: errno: EACCES} {win 95} {
+} -constraints {win win2000orXP testfile} -body {
+    testfile mv nul tf1
+} -returnCodes error -result EINVAL
+test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
     cleanup
-    createfile tf1
-    list [catch {testfile mv tf1 nul} msg] $msg
-} {1 EACCES}
-test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} {win nt} {
+} -constraints {win nt winOlderThan2000 testfile} -body {
+    testfile mv nul tf1
+} -returnCodes error -result EACCES
+test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
     cleanup
+} -constraints {win nt testfile} -body {
     createfile tf1
-    list [catch {testfile mv tf1 nul} msg] $msg
-} {1 EEXIST}
-test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} {win} {
+    testfile mv tf1 nul
+} -returnCodes error -result EEXIST
+test winFCmd-1.16 {TclpRenameFile: MoveFile() != FALSE} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1 tf1
     testfile mv tf1 tf2
     list [file exists tf1] [contents tf2]
-} {0 tf1}
-test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} {win} {
+} -result {0 tf1}
+test winFCmd-1.17 {TclpRenameFile: MoveFile() == FALSE} -setup {
     cleanup
-    list [catch {testfile mv tf1 tf2} msg] $msg
-} {1 ENOENT} 
-test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} {win} {
+} -constraints {win testfile} -body {
+    testfile mv tf1 tf2
+} -returnCodes error -result ENOENT
+test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} -setup {
     cleanup
-    list [catch {testfile mv tf1 tf2} msg] $msg
-} {1 ENOENT} 
-test winFCmd-1.19 {TclpRenameFile: errno == EACCES} {win win2000orXP} {
+} -constraints {win testfile} -body {
+    testfile mv tf1 tf2
+} -returnCodes error -result ENOENT
+test winFCmd-1.19 {TclpRenameFile: errno == EACCES} -setup {
     cleanup
-    list [catch {testfile mv nul tf1} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} {win nt winOlderThan2000} {
+} -constraints {win win2000orXP testfile} -body {
+    testfile mv nul tf1
+} -returnCodes error -result EINVAL
+test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup {
     cleanup
-    list [catch {testfile mv nul tf1} msg] $msg
-} {1 EACCES}
-test winFCmd-1.19.2 {TclpRenameFile: errno == ENOENT} {win 95} {
+} -constraints {win nt winOlderThan2000 testfile} -body {
+    testfile mv nul tf1
+} -returnCodes error -result EACCES
+test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
     cleanup
-    list [catch {testfile mv nul tf1} msg] $msg
-} {1 ENOENT}
-test winFCmd-1.20 {TclpRenameFile: src is dir} {win nt} {
-    # under 95, this would actually succeed and move the current dir out from 
+} -constraints {win nt testfile} -body {
+    # under 95, this would actually succeed and move the current dir out from
     # under the current process!
-    cleanup
     file delete /tf1
-    list [catch {testfile mv [pwd] /tf1} msg] $msg
-} {1 EACCES}
-test winFCmd-1.21 {TclpRenameFile: long src} {win} {
+    testfile mv [pwd] /tf1
+} -returnCodes error -result EACCES
+test winFCmd-1.21 {TclpRenameFile: long src} -setup {
     cleanup
-    list [catch {testfile mv $longname tf1} msg] $msg
-} {1 ENAMETOOLONG}
-test winFCmd-1.22 {TclpRenameFile: long dst} {win} {
+} -constraints {win testfile} -body {
+    testfile mv $longname tf1
+} -returnCodes error -result ENAMETOOLONG
+test winFCmd-1.22 {TclpRenameFile: long dst} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1
-    list [catch {testfile mv tf1 $longname} msg] $msg
-} {1 ENAMETOOLONG}
-test winFCmd-1.23 {TclpRenameFile: move dir into self} {win} {
+    testfile mv tf1 $longname
+} -returnCodes error -result ENAMETOOLONG
+test winFCmd-1.23 {TclpRenameFile: move dir into self} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
-    list [catch {testfile mv [pwd]/td1 td1/td2} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.24 {TclpRenameFile: move a root dir} {win} {
+    testfile mv [pwd]/td1 td1/td2
+} -returnCodes error -result EINVAL
+test winFCmd-1.24 {TclpRenameFile: move a root dir} -setup {
     cleanup
-    list [catch {testfile mv / c:/} msg] $msg
-} {1 EINVAL}
-test winFCmd-1.25 {TclpRenameFile: cross file systems} {win cdrom} {
+} -constraints {win testfile} -body {
+    testfile mv / c:/
+} -returnCodes error -result EINVAL
+test winFCmd-1.25 {TclpRenameFile: cross file systems} -setup {
     cleanup
+} -constraints {win cdrom testfile} -body {
     file mkdir td1
-    list [catch {testfile mv td1 $cdrom/td1} msg] $msg
-} {1 EXDEV} 
-test winFCmd-1.26 {TclpRenameFile: readonly fs} {win cdrom} {
+    testfile mv td1 $cdrom/td1
+} -returnCodes error -result EXDEV
+test winFCmd-1.26 {TclpRenameFile: readonly fs} -setup {
     cleanup
-    list [catch {testfile mv $cdfile $cdrom/dummy~~.fil} msg] $msg
-} {1 EACCES}
-test winFCmd-1.27 {TclpRenameFile: open file} {win} {
+} -constraints {win cdrom testfile} -body {
+    testfile mv $cdfile $cdrom/dummy~~.fil
+} -returnCodes error -result EACCES
+test winFCmd-1.27 {TclpRenameFile: open file} -setup {
     cleanup
+} -constraints {win testfile} -body {
     set fd [open tf1 w]
-    set msg [list [catch {testfile mv tf1 tf2} msg] $msg]
-    close $fd
-    set msg
-} {1 EACCES}    
-test winFCmd-1.28 {TclpRenameFile: errno == EEXIST} {win} {
+    testfile mv tf1 tf2
+} -cleanup {
+    catch {close $fd}
+} -returnCodes error -result EACCES
+test winFCmd-1.28 {TclpRenameFile: errno == EEXIST} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1
     createfile tf2
     testfile mv tf1 tf2
     list [file exists tf1] [file exists tf2]
-} {0 1}
-test winFCmd-1.29 {TclpRenameFile: src is dir} {win} {
+} -result {0 1}
+test winFCmd-1.29 {TclpRenameFile: src is dir} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile tf1
-    list [catch {testfile mv td1 tf1} msg] $msg
-} {1 ENOTDIR} 
-test winFCmd-1.30 {TclpRenameFile: dst is dir} {win} {
+    testfile mv td1 tf1
+} -returnCodes error -result ENOTDIR
+test winFCmd-1.30 {TclpRenameFile: dst is dir} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     file mkdir td2/td2
-    list [catch {testfile mv td1 td2} msg] $msg
-} {1 EEXIST}
-test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} {win} {
+    testfile mv td1 td2
+} -returnCodes error -result EEXIST
+test winFCmd-1.31 {TclpRenameFile: TclpRemoveDirectory fails} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     file mkdir td2/td2
-    list [catch {testfile mv td1 td2} msg] $msg
-} {1 EEXIST}
-test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} {win} {
+    testfile mv td1 td2
+} -returnCodes error -result EEXIST
+test winFCmd-1.32 {TclpRenameFile: TclpRemoveDirectory succeeds} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1/td2
     file mkdir td2
     testfile mv td1 td2
     list [file exists td1] [file exists td2] [file exists td2/td2]
-} {0 1 1}
+} -result {0 1 1}
 test winFCmd-1.33 {TclpRenameFile: After removing dst dir, MoveFile fails} \
-	{win exdev} {
+	-constraints {win exdev testfile testchmod} -body {
     file mkdir d:/td1
     testchmod 000 d:/td1
     file mkdir c:/tf1
-    set msg [list [catch {testfile mv c:/tf1 d:/td1} msg] $msg]
-    set msg "$msg [file writable d:/td1]"
+    catch {testfile mv c:/tf1 d:/td1} msg
+    list $msg [file writable d:/td1]
+} -cleanup {
+    catch {testchmod 666 d:/td1}
     file delete d:/td1
     file delete -force c:/tf1
-    set msg
-} {1 EXDEV 0}
-test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} {win} {
+} -result {EXDEV 0}
+test winFCmd-1.34 {TclpRenameFile: src is dir, dst is not} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile tf1
-    list [catch {testfile mv td1 tf1} msg] $msg
-} {1 ENOTDIR}
-test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} {win} {
+    testfile mv td1 tf1
+} -cleanup {
+    cleanup
+} -returnCodes error -result ENOTDIR
+test winFCmd-1.35 {TclpRenameFile: src is not dir, dst is} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile tf1
-    list [catch {testfile mv tf1 td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-1.36 {TclpRenameFile: src and dst not dir} {win} {
+    testfile mv tf1 td1
+} -cleanup {
+    cleanup
+} -returnCodes error -result EISDIR
+test winFCmd-1.36 {TclpRenameFile: src and dst not dir} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     createfile tf1 tf1
     createfile tf2 tf2
     testfile mv tf1 tf2
     contents tf2
-} {tf1}
-test winFCmd-1.37 {TclpRenameFile: need to restore temp file} {win} {
-    # Can't figure out how to cause this. 
+} -cleanup {
+    cleanup
+} -result {tf1}
+test winFCmd-1.37 {TclpRenameFile: need to restore temp file} {win emptyTest} {
+    # Can't figure out how to cause this.
     # Need a file that can't be copied.
 } {}
 
-test winFCmd-2.1 {TclpCopyFile: errno: EACCES} {win cdrom} {
+# If the native filesystem produces 0 for inodes numbers there is no point
+# doing the following test.
+testConstraint winNonZeroInodes [eval {
+    file stat [info nameofexecutable] statExe
+    expr {$statExe(ino) != 0}
+}]
+
+proc MakeFiles {dirname} {
+    set inodes {}
+    set ndx -1
+    while {1} {
+        # upped to 50K for 64bit Server 2008
+        if {$ndx > 50000} {
+            return -code error "limit reached without finding a collistion."
+        }
+        set filename [file join $dirname Test[incr ndx]]
+        set f [open $filename w]
+        close $f
+        file stat $filename stat
+        if {[set n [lsearch -exact -integer $inodes $stat(ino)]] != -1} {
+            return [list [file join $dirname Test$n] $filename]
+        }
+        lappend inodes $stat(ino)
+        unset stat
+    }
+}
+
+test winFCmd-1.38 {TclpRenameFile: check rename of conflicting inodes} -setup {
     cleanup
-    list [catch {testfile cp $cdfile $cdrom/dummy~~.fil} msg] $msg
-} {1 EACCES}
-test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} {win} {
+} -constraints {win winNonZeroInodes} -body {
+    file mkdir td1
+    foreach {a b} [MakeFiles td1] break
+    file rename -force $a $b
+    file exists $a
+} -cleanup {
     cleanup
+} -result {0}
+
+
+test winFCmd-2.1 {TclpCopyFile: errno: EACCES} -setup {
+    cleanup
+} -constraints {win cdrom testfile} -body {
+    testfile cp $cdfile $cdrom/dummy~~.fil
+} -returnCodes error -result EACCES
+test winFCmd-2.2 {TclpCopyFile: errno: EISDIR} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
-    list [catch {testfile cp td1 tf1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} {win} {
+    testfile cp td1 tf1
+} -cleanup {
+    cleanup
+} -returnCodes error -result EISDIR
+test winFCmd-2.3 {TclpCopyFile: errno: EISDIR} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1
     file mkdir td1
-    list [catch {testfile cp tf1 td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} {win} {
+    testfile cp tf1 td1
+} -cleanup {
     cleanup
-    list [catch {testfile cp tf1 tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} {win} {
+} -returnCodes error -result EISDIR
+test winFCmd-2.4 {TclpCopyFile: errno: ENOENT} -setup {
     cleanup
-    list [catch {testfile cp "" tf2} msg] $msg
-} {1 ENOENT}
-test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} {win} {
+} -constraints {win testfile} -body {
+    testfile cp tf1 tf2
+} -returnCodes error -result ENOENT
+test winFCmd-2.5 {TclpCopyFile: errno: ENOENT} -setup {
     cleanup
-    createfile tf1
-    list [catch {testfile cp tf1 ""} msg] $msg
-} {1 ENOENT}
-test winFCmd-2.7 {TclpCopyFile: errno: EACCES} {win 95} {
+} -constraints {win testfile} -body {
+    testfile cp "" tf2
+} -returnCodes error -result ENOENT
+test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1
-    set fd [open tf2 w]
-    set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
-    close $fd
-    set msg
-} {1 EACCES}
-test winFCmd-2.8 {TclpCopyFile: errno: EACCES} {win win2000orXP} {
+    testfile cp tf1 ""
+} -cleanup {
     cleanup
-    list [catch {testfile cp nul tf1} msg] $msg
-} {1 EINVAL}
-test winFCmd-2.8.1 {TclpCopyFile: errno: EACCES} {win nt winOlderThan2000} {
+} -returnCodes error -result ENOENT
+test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
     cleanup
-    list [catch {testfile cp nul tf1} msg] $msg
-} {1 EACCES}
-test winFCmd-2.9 {TclpCopyFile: errno: ENOENT} {win 95} {
+} -constraints {win win2000orXP testfile} -body {
+    testfile cp nul tf1
+} -returnCodes error -result EINVAL
+test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
     cleanup
-    list [catch {testfile cp nul tf1} msg] $msg
-} {1 ENOENT}
-test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} {win} {
+} -constraints {win nt winOlderThan2000 testfile} -body {
+    testfile cp nul tf1
+} -returnCodes error -result EACCES
+test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1 tf1
     testfile cp tf1 tf2
     list [contents tf1] [contents tf2]
-} {tf1 tf1}
-test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} {win} {
+} -cleanup {
+    cleanup
+} -result {tf1 tf1}
+test winFCmd-2.11 {TclpCopyFile: CopyFile succeeds} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1 tf1
     createfile tf2 tf2
     testfile cp tf1 tf2
     list [contents tf1] [contents tf2]
-} {tf1 tf1}
-test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} {win} {
+} -cleanup {
+    cleanup
+} -result {tf1 tf1}
+test winFCmd-2.12 {TclpCopyFile: CopyFile succeeds} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1 tf1
     testchmod 000 tf1
     testfile cp tf1 tf2
     list [contents tf2] [file writable tf2]
-} {tf1 0}
-test winFCmd-2.13 {TclpCopyFile: CopyFile fails} {win} {
+} -cleanup {
+    catch {testchmod 666 tf1}
     cleanup
+} -result {tf1 0}
+test winFCmd-2.13 {TclpCopyFile: CopyFile fails} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     createfile tf1
     file mkdir td1
-    list [catch {testfile cp tf1 td1} msg] $msg
-} {1 EISDIR} 
-test winFCmd-2.14 {TclpCopyFile: errno == EACCES} {win} {
+    testfile cp tf1 td1
+} -cleanup {
     cleanup
+} -returnCodes error -result EISDIR
+test winFCmd-2.14 {TclpCopyFile: errno == EACCES} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
-    list [catch {testfile cp td1 tf1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.15 {TclpCopyFile: src is directory} {win} {
+    testfile cp td1 tf1
+} -cleanup {
     cleanup
+} -returnCodes error -result EISDIR
+test winFCmd-2.15 {TclpCopyFile: src is directory} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
-    list [catch {testfile cp td1 tf1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.16 {TclpCopyFile: dst is directory} {win} {
+    testfile cp td1 tf1
+} -cleanup {
     cleanup
+} -returnCodes error -result EISDIR
+test winFCmd-2.16 {TclpCopyFile: dst is directory} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     createfile tf1
     file mkdir td1
-    list [catch {testfile cp tf1 td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-2.17 {TclpCopyFile: dst is readonly} {win} {
+    testfile cp tf1 td1
+} -cleanup {
     cleanup
+} -returnCodes error -result EISDIR
+test winFCmd-2.17 {TclpCopyFile: dst is readonly} -setup {
+    cleanup
+} -constraints {win testfile testchmod} -body {
     createfile tf1 tf1
     createfile tf2 tf2
     testchmod 000 tf2
     testfile cp tf1 tf2
     list [file writable tf2] [contents tf2]
-} {1 tf1}
-test winFCmd-2.18 {TclpCopyFile: still can't copy onto dst} {win 95} {
+} -cleanup {
+    catch {testchmod 666 tf2}
     cleanup
-    createfile tf1
-    createfile tf2
-    testchmod 000 tf2
-    set fd [open tf2]
-    set msg [list [catch {testfile cp tf1 tf2} msg] $msg]
-    close $fd
-    set msg "$msg [file writable tf2]"
-} {1 EACCES 0}    
+} -result {1 tf1}
 
-test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} {win cdrom} {
-    list [catch {testfile rm $cdfile $cdrom/dummy~~.fil} msg] $msg
-} {1 EACCES}
-test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} {win} {
+test winFCmd-3.1 {TclpDeleteFile: errno: EACCES} -body {
+    testfile rm $cdfile $cdrom/dummy~~.fil
+} -constraints {win cdrom testfile} -returnCodes error -result EACCES
+test winFCmd-3.2 {TclpDeleteFile: errno: EISDIR} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
-    list [catch {testfile rm td1} msg] $msg
-} {1 EISDIR} 
-test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} {win} {
+    testfile rm td1
+} -cleanup {
+    cleanup
+} -returnCodes error -result EISDIR
+test winFCmd-3.3 {TclpDeleteFile: errno: ENOENT} -setup {
     cleanup
-    list [catch {testfile rm tf1} msg] $msg
-} {1 ENOENT}
-test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} {win} {
+} -constraints {win testfile} -body {
+    testfile rm tf1
+} -returnCodes error -result ENOENT
+test winFCmd-3.4 {TclpDeleteFile: errno: ENOENT} -setup {
     cleanup
-    list [catch {testfile rm ""} msg] $msg
-} {1 ENOENT}
-test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} {win} {
+} -constraints {win testfile} -body {
+    testfile rm ""
+} -returnCodes error -result ENOENT
+test winFCmd-3.5 {TclpDeleteFile: errno: EACCES} -setup {
     cleanup
+} -constraints {win testfile} -body {
     set fd [open tf1 w]
-    set msg [list [catch {testfile rm tf1} msg] $msg]
+    testfile rm tf1
+} -cleanup {
     close $fd
-    set msg
-} {1 EACCES}
-test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} {win} {
     cleanup
-    list [catch {testfile rm nul} msg] $msg
-} {1 EACCES}
-test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} {win} {
+} -returnCodes error -result EACCES
+test winFCmd-3.6 {TclpDeleteFile: errno: EACCES} -setup {
     cleanup
+} -constraints {win testfile} -body {
+    testfile rm nul
+} -returnCodes error -result EACCES
+test winFCmd-3.7 {TclpDeleteFile: DeleteFile succeeds} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     createfile tf1
     testfile rm tf1
     file exists tf1
-} {0}
-test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} {win} {
+} -result {0}
+test winFCmd-3.8 {TclpDeleteFile: DeleteFile fails} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
-    list [catch {testfile rm td1} msg] $msg
-} {1 EISDIR}
-test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} {win} {
+    testfile rm td1
+} -cleanup {
     cleanup
+} -returnCodes error -result EISDIR
+test winFCmd-3.9 {TclpDeleteFile: errno == EACCES} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     set fd [open tf1 w]
-    set msg [list [catch {testfile rm tf1} msg] $msg]
+    testfile rm tf1
+} -cleanup {
     close $fd
-    set msg
-} {1 EACCES}
-test winFCmd-3.10 {TclpDeleteFile: path is readonly} {win} {
+} -returnCodes error -result EACCES
+test winFCmd-3.10 {TclpDeleteFile: path is readonly} -setup {
     cleanup
+} -constraints {win testfile testchmod} -body {
     createfile tf1
     testchmod 000 tf1
     testfile rm tf1
     file exists tf1
-} {0}
-test winFCmd-3.11 {TclpDeleteFile: still can't remove path} {win} {
+} -result {0}
+test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup {
     cleanup
+} -constraints {win testfile testchmod} -body {
     set fd [open tf1 w]
     testchmod 000 tf1
-    set msg [list [catch {testfile rm tf1} msg] $msg]
+    testfile rm tf1
+} -cleanup {
     close $fd
-    set msg
-} {1 EACCES}
+    catch {testchmod 666 tf1}
+    cleanup
+} -returnCodes error -result EACCES
 
-test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} {win nt cdrom} {
-    list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
-} {1 EACCES}
-test winFCmd-4.2 {TclpCreateDirectory: errno: EACCES} {win 95 cdrom} {
-    list [catch {testfile mkdir $cdrom/dummy~~.dir} msg] $msg
-} {1 ENOSPC}
-test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} {win} {
+test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
+    testfile mkdir $cdrom/dummy~~.dir
+} -constraints {win nt cdrom testfile} -returnCodes error -result EACCES
+test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
-    list [catch {testfile mkdir td1} msg] $msg
-} {1 EEXIST}
-test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} {win} {
+    testfile mkdir td1
+} -cleanup {
     cleanup
-    list [catch {testfile mkdir td1/td2} msg] $msg
-} {1 ENOENT}
-test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} {win} {
+} -returnCodes error -result EEXIST
+test winFCmd-4.4 {TclpCreateDirectory: errno: ENOENT} -setup {
     cleanup
+} -constraints {win testfile} -body {
+    testfile mkdir td1/td2
+} -returnCodes error -result ENOENT
+test winFCmd-4.5 {TclpCreateDirectory: CreateDirectory succeeds} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     testfile mkdir td1
     file type td1
-} {directory}
+} -cleanup cleanup -result directory
 
-test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} {win} {
+test winFCmd-5.1 {TclpCopyDirectory: calls TraverseWinTree} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     testfile cpdir td1 td2
     list [file type td1] [file type td2]
-} {directory directory}
+} -cleanup {
+    cleanup
+} -result {directory directory}
 
-test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} {win} {
+test winFCmd-6.1 {TclpRemoveDirectory: errno: EACCES} -setup {
     cleanup
+} -constraints {winVista testfile testchmod} -body {
     file mkdir td1
     testchmod 000 td1
     testfile rmdir td1
     file exists td1
-} {0}
-test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} {win} {
+} -returnCodes error -cleanup {
+    catch {testchmod 666 td1}
+    cleanup
+} -result {td1 EACCES}
+# This next test has a very hokey way of matching...
+test winFCmd-6.2 {TclpRemoveDirectory: errno: EEXIST} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1/td2
     list [catch {testfile rmdir td1} msg] [file tail $msg]
-} {1 {td1 EEXIST}}
-test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win} {
+} -result {1 {td1 EEXIST}}
+test winFCmd-6.3 {TclpRemoveDirectory: errno: EACCES} {win emptyTest} {
     # can't test this w/o removing everything on your hard disk first!
     # testfile rmdir /
 } {}
-test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} {win} {
+# This next test has a very hokey way of matching...
+test winFCmd-6.4 {TclpRemoveDirectory: errno: ENOENT} -setup {
     cleanup
+} -constraints {win testfile} -body {
     list [catch {testfile rmdir td1} msg] [file tail $msg]
-} {1 {td1 ENOENT}}
-test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} {win} {
+} -result {1 {td1 ENOENT}}
+test winFCmd-6.5 {TclpRemoveDirectory: errno: ENOENT} -setup {
     cleanup
-    list [catch {testfile rmdir ""} msg] $msg
-} {1 ENOENT}
-test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} {win} {
+} -constraints {win testfile} -body {
+    testfile rmdir ""
+} -returnCodes error -result ENOENT
+# This next test has a very hokey way of matching...
+test winFCmd-6.6 {TclpRemoveDirectory: errno: ENOTDIR} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1
     list [catch {testfile rmdir tf1} msg] [file tail $msg]
-} {1 {tf1 ENOTDIR}}
-test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} {win} {
+} -result {1 {tf1 ENOTDIR}}
+test winFCmd-6.7 {TclpRemoveDirectory: RemoveDirectory succeeds} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     testfile rmdir td1
     file exists td1
-} {0}
-test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} {win} {
+} -result {0}
+# This next test has a very hokey way of matching...
+test winFCmd-6.8 {TclpRemoveDirectory: RemoveDirectory fails} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1
     list [catch {testfile rmdir tf1} msg] [file tail $msg]
-} {1 {tf1 ENOTDIR}}
-test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} {win} {
+} -result {1 {tf1 ENOTDIR}}
+test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
     cleanup
+} -constraints {winVista testfile testchmod} -body {
     file mkdir td1
     testchmod 000 td1
     testfile rmdir td1
     file exists td1
-} {0}
-test winFCmd-6.10 {TclpRemoveDirectory: attr == -1} {win 95} {
+} -returnCodes error -cleanup {
+    catch {testchmod 666 td1}
     cleanup
-    list [catch {testfile rmdir nul} msg] $msg
-} {1 {nul EACCES}}
-test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} {win nt} {
+} -result {td1 EACCES}
+test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
     cleanup
-    set res [list [catch {testfile rmdir /} msg] $msg]
+} -constraints {win nt testfile} -body {
+    testfile rmdir /
     # WinXP returns EEXIST, WinNT seems to return EACCES.  No policy
     # decision has been made as to which is correct.
-    regsub {E(ACCES|EXIST)} $res "EACCES or EEXIST"
-} [list 1 [list / EACCES or EEXIST]]
-test winFCmd-6.12 {TclpRemoveDirectory: errno == EACCES} {win 95} {
-    cleanup
-    createfile tf1
-    set res [catch {testfile rmdir tf1} msg]
-    # get rid of path
-    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
-    list $res $msg
-} {1 {tf1 ENOTDIR}}
-test winFCmd-6.13 {TclpRemoveDirectory: write-protected} {win} {
+} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
+test winFCmd-6.13 {TclpRemoveDirectory: write-protected} -setup {
     cleanup
+} -constraints {winVista testfile testchmod} -body {
     file mkdir td1
     testchmod 000 td1
     testfile rmdir td1
     file exists td1
-} {0}
-test winFCmd-6.14 {TclpRemoveDirectory: check if empty dir} {win 95} {
+} -cleanup {
+    catch {testchmod 666 td1}
     cleanup
-    file mkdir td1/td2
-    set res [catch {testfile rmdir td1} msg]
-    # get rid of path
-    set msg [list [file tail [lindex $msg 0]] [lindex $msg 1]]
-    list $res $msg
-} {1 {td1 EEXIST}}
-test winFCmd-6.15 {TclpRemoveDirectory: !recursive} {win} {
+} -returnCodes error -result {td1 EACCES}
+# This next test has a very hokey way of matching...
+test winFCmd-6.15 {TclpRemoveDirectory: !recursive} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1/td2
     list [catch {testfile rmdir td1} msg] [file tail $msg]
-} {1 {td1 EEXIST}}
-test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} {win} {
+} -result {1 {td1 EEXIST}}
+test winFCmd-6.16 {TclpRemoveDirectory: recursive, but errno != EEXIST} -setup {
     cleanup
+} -constraints {win testfile} -body {
     createfile tf1
-    list [catch {testfile rmdir -force tf1} msg] $msg
-} {1 {tf1 ENOTDIR}}
-test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} {win} {
+    testfile rmdir -force tf1
+} -returnCodes error -result {tf1 ENOTDIR}
+test winFCmd-6.17 {TclpRemoveDirectory: calls TraverseWinTree} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1/td2
     testfile rmdir -force td1
     file exists td1
-} {0}
+} -result {0}
 
-test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} {win} {
+test winFCmd-7.1 {TraverseWinTree: targetPtr == NULL} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1/td2/td3
     testfile rmdir -force td1
     file exists td1
-} {0}
-test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} {win} {
+} -result {0}
+test winFCmd-7.2 {TraverseWinTree: targetPtr != NULL} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1/td2/td3
     testfile cpdir td1 td2
     list [file exists td1] [file exists td2]
-} {1 1}
-test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} {win} {
+} -cleanup {
     cleanup
-    list [catch {testfile cpdir td1 td2} msg] $msg
-} {1 {td1 ENOENT}}
-test winFCmd-7.4 {TraverseWinTree: source isn't directory} {win} {
+} -result {1 1}
+test winFCmd-7.3 {TraverseWinTree: sourceAttr == -1} -setup {
+    cleanup
+} -constraints {win testfile} -body {
+    testfile cpdir td1 td2
+} -returnCodes error -result {td1 ENOENT}
+test winFCmd-7.4 {TraverseWinTree: source isn't directory} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/tf1 tf1
     testfile cpdir td1 td2
     contents td2/tf1
-} {tf1}
-test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} {win} {
+} -cleanup {
+    cleanup
+} -result {tf1}
+test winFCmd-7.5 {TraverseWinTree: call TraversalCopy: DOTREE_F} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/tf1 tf1
     testfile cpdir td1 td2
     contents td2/tf1
-} {tf1}
-test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} {win} {
+} -cleanup {
+    cleanup
+} -result {tf1}
+test winFCmd-7.6 {TraverseWinTree: call TraversalDelete: DOTREE_F} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/tf1 tf1
     testfile rmdir -force td1
     file exists td1
-} {0}
-test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} {win} {
+} -result {0}
+test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/tf1 tf1
     testfile cpdir td1 td2
     contents td2/tf1
-} {tf1}    
-test winFCmd-7.8 {TraverseWinTree: append \ to source if necessary} {win 95 cdrom} {
-    # cdrom can return either d:\ or D:/, but we only care about the errcode
-    list [catch {testfile rmdir $cdrom/} msg] [lindex $msg 1]
-} {1 EACCES} ; # was EEXIST, but changed for win98.
-test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} {win nt cdrom} {
-    list [catch {testfile rmdir $cdrom/} msg]  [lindex $msg 1]
-} {1 EACCES}
+} -cleanup {
+    cleanup
+} -result {tf1}
+test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
+    testfile rmdir $cdrom/
+} -constraints {win nt cdrom testfile} -returnCodes error -match glob \
+    -result {* EACCES}
 test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
-	{win} {
+	{win emptyTest} {
     # can't make it happen
 } {}
-test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} {win} {
+test winFCmd-7.11 {TraverseWinTree: call TraversalCopy: DOTREE_PRED} -setup {
     cleanup
+} -constraints {win testfile testchmod} -body {
     file mkdir td1
-    testchmod 000 td1
     createfile td1/tf1 tf1
+    testchmod 000 td1
     testfile cpdir td1 td2
     list [file exists td2] [file writable td2]
-} {1 0}
-test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} {win} {
+} -cleanup {
+    catch {testchmod 666 td1}
+    cleanup
+} -result {1 1}
+test winFCmd-7.12 {TraverseWinTree: call TraversalDelete: DOTREE_PRED} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/tf1 tf1
     testfile rmdir -force td1
     file exists td1
-} {0}
-test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} {win} {
+} -result {0}
+test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/tf1 tf1
     testfile cpdir td1 td2
     contents td2/tf1
-} {tf1}    
-test winFCmd-7.14 {TraverseWinTree: append \ to target if necessary} {win 95} {
+} -cleanup {
     cleanup
-    file mkdir td1
-    list [catch {testfile cpdir td1 /} msg] $msg
-} {1 {/ EEXIST}}
-test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} {win nt} {
+} -result {tf1}
+test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
     cleanup
+} -constraints {win nt testfile} -body {
     file mkdir td1
-    list [catch {testfile cpdir td1 /} msg] $msg
-} {1 {/ EACCES}}
-test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} {win} {
+    testfile cpdir td1 /
+} -cleanup {
     cleanup
+    # Windows7 returns EEXIST, XP returns EACCES
+} -returnCodes error -match regexp -result {^/ E(ACCES|EXIST)$}
+test winFCmd-7.16 {TraverseWinTree: recurse on files: no files} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     testfile cpdir td1 td2
-} {}
-test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} {win} {
+} -cleanup {
+    cleanup
+} -result {}
+test winFCmd-7.17 {TraverseWinTree: recurse on files: one file} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/td2
     testfile cpdir td1 td2
     glob td2/*
-} {td2/td2}
-test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} \
-	{win} {
+} -cleanup {
+    cleanup
+} -result {td2/td2}
+test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/tf1
     createfile td1/tf2
@@ -755,277 +893,359 @@ test winFCmd-7.18 {TraverseWinTree: recurse on files: several files and dir} \
     createfile td1/tf4
     testfile cpdir td1 td2
     lsort [glob td2/*]
-} {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4}
-test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} {win} {
+} -cleanup {
+    cleanup
+} -result {td2/td2 td2/tf1 td2/tf2 td2/tf3 td2/tf4}
+test winFCmd-7.19 {TraverseWinTree: call TraversalCopy: DOTREE_POSTD} -setup {
     cleanup
+} -constraints {win testfile testchmod} -body {
     file mkdir td1
-    testchmod 000 td1
     createfile td1/tf1 tf1
+    testchmod 000 td1
     testfile cpdir td1 td2
     list [file exists td2] [file writable td2]
-} {1 0}
-test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} \
-	{win} {
+} -cleanup {
+    catch {testchmod 666 td1}
+    cleanup
+} -result {1 1}
+test winFCmd-7.20 {TraverseWinTree: call TraversalDelete: DOTREE_POSTD} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/tf1 tf1
     testfile rmdir -force td1
     file exists td1
-} {0}
-test winFCmd-7.21 {TraverseWinTree: fill errorPtr} {win} {
+} -result {0}
+test winFCmd-7.21 {TraverseWinTree: fill errorPtr} -setup {
     cleanup
-    list [catch {testfile cpdir td1 td2} msg] $msg
-} {1 {td1 ENOENT}}
+} -constraints {win testfile} -body {
+    testfile cpdir td1 td2
+} -returnCodes error -result {td1 ENOENT}
 
-test winFCmd-8.1 {TraversalCopy: DOTREE_F} {win} {
+test winFCmd-8.1 {TraversalCopy: DOTREE_F} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
-    list [catch {testfile cpdir td1 td1} msg] $msg
-} {1 {td1 EEXIST}}
-test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} {win} {
+    testfile cpdir td1 td1
+} -returnCodes error -result {td1 EEXIST}
+test winFCmd-8.2 {TraversalCopy: DOTREE_PRED} -setup {
     cleanup
+} -constraints {win testfile testchmod} -body {
     file mkdir td1/td2
     testchmod 000 td1
     testfile cpdir td1 td2
     list [file writable td1] [file writable td1/td2]
-} {0 1}
-test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} {win} {
+} -cleanup {
+    catch {testchmod 666 td1}
+    cleanup
+} -result {0 1}
+test winFCmd-8.3 {TraversalCopy: DOTREE_POSTD} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     testfile cpdir td1 td2
-} {}
+} -cleanup {
+    cleanup
+} -result {}
 
-test winFCmd-9.1 {TraversalDelete: DOTREE_F} {win} {
+test winFCmd-9.1 {TraversalDelete: DOTREE_F} -setup {
     cleanup
+} -constraints {win testfile} -body {
     file mkdir td1
     createfile td1/tf1
     testfile rmdir -force td1
-} {}
-test winFCmd-9.2 {TraversalDelete: DOTREE_F} {win 95} {
-    cleanup
-    file mkdir td1
-    set fd [open td1/tf1 w]
-    set msg [list [catch {testfile rmdir -force td1} msg] $msg]
-    close $fd
-    set msg
-} {1 {td1\tf1 EACCES}}
-test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} {win} {
+} -result {}
+test winFCmd-9.3 {TraversalDelete: DOTREE_PRED} -setup {
     cleanup
+} -constraints {winVista testfile testchmod} -body {
     file mkdir td1/td2
     testchmod 000 td1
     testfile rmdir -force td1
     file exists td1
-} {0}
-test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} {win} {
+} -cleanup {
+    catch {testchmod 666 td1}
     cleanup
+} -returnCodes error -result {td1 EACCES}
+test winFCmd-9.4 {TraversalDelete: DOTREE_POSTD} -setup {
+    cleanup
+} -constraints {win testfile} -body {
     file mkdir td1/td1/td3/td4/td5
     testfile rmdir -force td1
-} {}
+} -result {}
 
-test winFCmd-10.1 {AttributesPosixError - get} {win} {
+test winFCmd-10.1 {AttributesPosixError - get} -constraints {win} -setup {
     cleanup
-    list [catch {file attributes td1 -archive} msg] $msg
-} {1 {could not read "td1": no such file or directory}}
-test winFCmd-10.2 {AttributesPosixError - set} {win} {
+} -body {
+    file attributes td1 -archive
+} -returnCodes error -result {could not read "td1": no such file or directory}
+test winFCmd-10.2 {AttributesPosixError - set} -constraints {win} -setup {
     cleanup
-    list [catch {file attributes td1 -archive 0} msg] $msg
-} {1 {could not read "td1": no such file or directory}}
-
-test winFCmd-11.1 {GetWinFileAttributes} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -archive} msg] $msg [cleanup]
-} {0 1 {}}
-test winFCmd-11.2 {GetWinFileAttributes} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -readonly} msg] $msg [cleanup]
-} {0 0 {}}
-test winFCmd-11.3 {GetWinFileAttributes} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -hidden} msg] $msg [cleanup]
-} {0 0 {}}
-test winFCmd-11.4 {GetWinFileAttributes} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -system} msg] $msg [cleanup]
-} {0 0 {}}
-test winFCmd-11.5 {GetWinFileAttributes} {win} {
-    # attr of relative paths that resolve to root was failing
-    # don't care about answer, just that test runs.
+} -body {
+    file attributes td1 -archive 0
+} -returnCodes error -result {could not read "td1": no such file or directory}
 
+test winFCmd-11.1 {GetWinFileAttributes} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    file attributes td1 -archive
+} -cleanup {
+    cleanup
+} -result 1
+test winFCmd-11.2 {GetWinFileAttributes} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    file attributes td1 -readonly
+} -cleanup {
+    cleanup
+} -result 0
+test winFCmd-11.3 {GetWinFileAttributes} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    file attributes td1 -hidden
+} -cleanup {
+    cleanup
+} -result 0
+test winFCmd-11.4 {GetWinFileAttributes} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    file attributes td1 -system
+} -cleanup {
+    cleanup
+} -result 0
+test winFCmd-11.5 {GetWinFileAttributes} -constraints {win} -setup {
     set old [pwd]
+} -body {
+    # Attr of relative paths that resolve to root was failing don't care about
+    # answer, just that test runs.
     cd c:/
-    file attr c:	    
+    file attr c:
     file attr c:.
-    file attr . 
+    file attr .
+} -cleanup {
     cd $old
-} {}
-test winFCmd-11.6 {GetWinFileAttributes} {win} {
+} -match glob -result *
+test winFCmd-11.6 {GetWinFileAttributes} -constraints {win} -body {
     file attr c:/ -hidden
-} {0}
+} -result {0}
 
-test winFCmd-12.1 {ConvertFileNameFormat} {win} {
+test winFCmd-12.1 {ConvertFileNameFormat} -constraints {win} -setup {
     cleanup
-    close [open td1 w]
-    list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
-} {0 td1 {}}
-test winFCmd-12.2 {ConvertFileNameFormat} {win} {
+} -body {
+    createfile td1 {}
+    string tolower [file attributes td1 -longname]
+} -cleanup {
     cleanup
+} -result {td1}
+test winFCmd-12.2 {ConvertFileNameFormat} -constraints {win} -setup {
+    cleanup
+} -body {
     file mkdir td1
-    close [open td1/td1 w]
-    list [catch {string tolower [file attributes td1/td1 -longname]} msg] $msg [cleanup]
-} {0 td1/td1 {}}
-test winFCmd-12.3 {ConvertFileNameFormat} {win} {
+    createfile td1/td1 {}
+    string tolower [file attributes td1/td1 -longname]
+} -cleanup {
+    cleanup
+} -result {td1/td1}
+test winFCmd-12.3 {ConvertFileNameFormat} -constraints {win} -setup {
     cleanup
+} -body {
     file mkdir td1
     file mkdir td1/td2
-    close [open td1/td3 w]
-    list [catch {string tolower [file attributes td1/td2/../td3 -longname]} msg] $msg [cleanup]
-} {0 td1/td2/../td3 {}}
-test winFCmd-12.4 {ConvertFileNameFormat} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {string tolower [file attributes ./td1 -longname]} msg] $msg [cleanup]
-} {0 ./td1 {}}
-test winFCmd-12.5 {ConvertFileNameFormat: absolute path} {win} {
+    createfile td1/td3 {}
+    string tolower [file attributes td1/td2/../td3 -longname]
+} -cleanup {
+    cleanup
+} -result {td1/td2/../td3}
+test winFCmd-12.4 {ConvertFileNameFormat} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    string tolower [file attributes ./td1 -longname]
+} -cleanup {
+    cleanup
+} -result {./td1}
+test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body {
     list [file attributes / -longname] [file attributes \\ -longname]
-} {/ /}
-test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} {win} {
+} -constraints {win} -result {/ /}
+test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup {
     catch {file delete -force -- c:/td1}
-    close [open c:/td1 w]
-    list [catch {string tolower [file attributes c:/td1 -longname]} msg] $msg [file delete -force -- c:/td1]
-} {0 c:/td1 {}}
-test winFCmd-12.7 {ConvertFileNameFormat} {nonPortable win} {
+} -constraints {win win2000orXP} -body {
+    createfile c:/td1 {}
+    string tolower [file attributes c:/td1 -longname]
+} -cleanup {
+    file delete -force -- c:/td1
+} -result {c:/td1}
+test winFCmd-12.7 {ConvertFileNameFormat} -body {
     string tolower [file attributes //bisque/tcl/ws -longname]
-} {//bisque/tcl/ws}
-test winFCmd-12.8 {ConvertFileNameFormat} {win longFileNames} {
-    cleanup
-    close [open td1 w]
-    list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
-} {0 td1 {}}
-test winFCmd-12.10 {ConvertFileNameFormat} {longFileNames win} {
-    cleanup
-    close [open td1td1td1 w]
-    list [catch {file attributes td1td1td1 -shortname}] [cleanup]
-} {0 {}}
-test winFCmd-12.11 {ConvertFileNameFormat} {longFileNames win} {
-    cleanup
-    close [open td1 w]
-    list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
-} {0 td1 {}}
+} -constraints {nonPortable win} -result {//bisque/tcl/ws}
+test winFCmd-12.8 {ConvertFileNameFormat} -setup {
+    cleanup
+} -constraints {win longFileNames} -body {
+    createfile td1 {}
+    string tolower [file attributes td1 -longname]
+} -cleanup {
+    cleanup
+} -result {td1}
+test winFCmd-12.10 {ConvertFileNameFormat} -setup {
+    cleanup
+} -constraints {longFileNames win} -body {
+    createfile td1td1td1 {}
+    file attributes td1td1td1 -shortname
+} -cleanup {
+    cleanup
+} -match glob -result *
+test winFCmd-12.11 {ConvertFileNameFormat} -setup {
+    cleanup
+} -constraints {longFileNames win} -body {
+    createfile td1 {}
+    string tolower [file attributes td1 -shortname]
+} -cleanup {
+    cleanup
+} -result {td1}
 
-test winFCmd-13.1 {GetWinFileLongName} {win} {
+test winFCmd-13.1 {GetWinFileLongName} -constraints {win} -setup {
     cleanup
-    close [open td1 w]
-    list [catch {string tolower [file attributes td1 -longname]} msg] $msg [cleanup]
-} {0 td1 {}}
+} -body {
+    createfile td1 {}
+    string tolower [file attributes td1 -longname]
+} -cleanup {
+    cleanup
+} -result td1
+
+test winFCmd-14.1 {GetWinFileShortName} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    string tolower [file attributes td1 -shortname]
+} -cleanup {
+    cleanup
+} -result td1
 
-test winFCmd-14.1 {GetWinFileShortName} {win} {
+test winFCmd-15.1 {SetWinFileAttributes} -constraints {win} -setup {
+    cleanup
+} -body {
+    file attributes td1 -archive 0
+} -returnCodes error -result {could not read "td1": no such file or directory}
+test winFCmd-15.2 {SetWinFileAttributes - archive} -constraints {win} -setup {
     cleanup
-    close [open td1 w]
-    list [catch {string tolower [file attributes td1 -shortname]} msg] $msg [cleanup]
-} {0 td1 {}}
+} -body {
+    createfile td1 {}
+    list [file attributes td1 -archive 1] [file attributes td1 -archive]
+} -cleanup {
+    cleanup
+} -result {{} 1}
+test winFCmd-15.3 {SetWinFileAttributes - archive} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    list [file attributes td1 -archive 0] [file attributes td1 -archive]
+} -cleanup {
+    cleanup
+} -result {{} 0}
+test winFCmd-15.4 {SetWinFileAttributes - hidden} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    list [file attributes td1 -hidden 1] [file attributes td1 -hidden] \
+	[file attributes td1 -hidden 0]
+} -cleanup {
+    cleanup
+} -result {{} 1 {}}
+test winFCmd-15.5 {SetWinFileAttributes - hidden} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    list [file attributes td1 -hidden 0] [file attributes td1 -hidden]
+} -cleanup {
+    cleanup
+} -result {{} 0}
+test winFCmd-15.6 {SetWinFileAttributes - readonly} -setup {
+    cleanup
+} -constraints {win} -body {
+    createfile td1 {}
+    list [file attributes td1 -readonly 1] [file attributes td1 -readonly]
+} -cleanup {
+    cleanup
+} -result {{} 1}
+test winFCmd-15.7 {SetWinFileAttributes - readonly} -setup {
+    cleanup
+} -constraints {win} -body {
+    createfile td1 {}
+    list [file attributes td1 -readonly 0] [file attributes td1 -readonly]
+} -cleanup {
+    cleanup
+} -result {{} 0}
+test winFCmd-15.8 {SetWinFileAttributes - system} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    list [file attributes td1 -system 1] [file attributes td1 -system]
+} -cleanup {
+    cleanup
+} -result {{} 1}
+test winFCmd-15.9 {SetWinFileAttributes - system} -constraints {win} -setup {
+    cleanup
+} -body {
+    createfile td1 {}
+    list [file attributes td1 -system 0] [file attributes td1 -system]
+} -cleanup {
+    cleanup
+} -result {{} 0}
+test winFCmd-15.10 {SetWinFileAttributes - failing} -setup {
+    cleanup
+} -constraints {win cdrom} -body {
+    file attributes $cdfile -archive 1
+} -returnCodes error -match glob -result *
 
-test winFCmd-15.1 {SetWinFileAttributes} {win} {
-    cleanup
-    list [catch {file attributes td1 -archive 0} msg] $msg
-} {1 {could not read "td1": no such file or directory}}
-test winFCmd-15.2 {SetWinFileAttributes - archive} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -archive 1} msg] $msg [file attributes td1 -archive] [cleanup]
-} {0 {} 1 {}}
-test winFCmd-15.3 {SetWinFileAttributes - archive} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -archive 0} msg] $msg [file attributes td1 -archive] [cleanup]
-} {0 {} 0 {}}
-test winFCmd-15.4 {SetWinFileAttributes - hidden} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -hidden 1} msg] $msg [file attributes td1 -hidden] [file attributes td1 -hidden 0] [cleanup]
-} {0 {} 1 {} {}}
-test winFCmd-15.5 {SetWinFileAttributes - hidden} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -hidden 0} msg] $msg [file attributes td1 -hidden] [cleanup]
-} {0 {} 0 {}}
-test winFCmd-15.6 {SetWinFileAttributes - readonly} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -readonly 1} msg] $msg [file attributes td1 -readonly] [cleanup]
-} {0 {} 1 {}}
-test winFCmd-15.7 {SetWinFileAttributes - readonly} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -readonly 0} msg] $msg [file attributes td1 -readonly] [cleanup]
-} {0 {} 0 {}}
-test winFCmd-15.8 {SetWinFileAttributes - system} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -system 1} msg] $msg [file attributes td1 -system] [cleanup]
-} {0 {} 1 {}}
-test winFCmd-15.9 {SetWinFileAttributes - system} {win} {
-    cleanup
-    close [open td1 w]
-    list [catch {file attributes td1 -system 0} msg] $msg [file attributes td1 -system] [cleanup]
-} {0 {} 0 {}}
-test winFCmd-15.10 {SetWinFileAttributes - failing} {win cdrom} {
-    cleanup
-    catch {file attributes $cdfile -archive 1}
-} {1}
-test winFCmd-16.1 {Windows file normalization} {win} {
+test winFCmd-16.1 {Windows file normalization} -constraints {win} -body {
     list [file normalize c:/] [file normalize C:/]
-} {C:/ C:/}
-test winFCmd-16.2 {Windows file normalization} {win} {
-    close [open td1... w]
-    set res [file tail [file normalize td1]]
+} -result {C:/ C:/}
+test winFCmd-16.2 {Windows file normalization} -constraints {win} -body {
+    createfile td1... {}
+    file tail [file normalize td1]
+} -cleanup {
     file delete td1...
-    set res
-} {td1}
-
+} -result {td1}
 set pwd [pwd]
 set d [string index $pwd 0]
-
-test winFCmd-16.3 {Windows file normalization} {win} {
+test winFCmd-16.3 {Windows file normalization} -constraints {win} -body {
     file norm ${d}:foo
-} [file join $pwd foo]
-test winFCmd-16.4 {Windows file normalization} {win} {
+} -result [file join $pwd foo]
+test winFCmd-16.4 {Windows file normalization} -constraints {win} -body {
     file norm [string tolower ${d}]:foo
-} [file join $pwd foo]
-test winFCmd-16.5 {Windows file normalization} {win} {
+} -result [file join $pwd foo]
+test winFCmd-16.5 {Windows file normalization} -constraints {win} -body {
     file norm ${d}:foo/bar
-} [file join $pwd foo/bar]
-test winFCmd-16.6 {Windows file normalization} {win} {
+} -result [file join $pwd foo/bar]
+test winFCmd-16.6 {Windows file normalization} -constraints {win} -body {
     file norm ${d}:foo\\bar
-} [file join $pwd foo/bar]
-test winFCmd-16.7 {Windows file normalization} {win} {
+} -result [file join $pwd foo/bar]
+test winFCmd-16.7 {Windows file normalization} -constraints {win} -body {
     file norm /bar
-} "${d}:/bar"
-test winFCmd-16.8 {Windows file normalization} {win} {
+} -result "${d}:/bar"
+test winFCmd-16.8 {Windows file normalization} -constraints {win} -body {
     file norm ///bar
-} "${d}:/bar"
-test winFCmd-16.9 {Windows file normalization} {win} {
+} -result "${d}:/bar"
+test winFCmd-16.9 {Windows file normalization} -constraints {win} -body {
     file norm /bar/foo
-} "${d}:/bar/foo"
+} -result "${d}:/bar/foo"
 if {$d eq "C"} { set dd "D" } else { set dd "C" }
-test winFCmd-16.10 {Windows file normalization} {win} {
+test winFCmd-16.10 {Windows file normalization} -constraints {win} -body {
     file norm ${dd}:foo
-} "${dd}:/foo"
-test winFCmd-16.11 {Windows file normalization} -constraints {win cdrom} \
--body {
+} -result "${dd}:/foo"
+test winFCmd-16.11 {Windows file normalization} -body {
     cd ${d}:
     cd $cdrom
     cd ${d}:
     cd $cdrom
     # Must not crash
     set result "no crash"
-} -cleanup {
+} -constraints {win cdrom} -cleanup {
     cd $pwd
 } -result {no crash}
-
 test winFCmd-16.12 {Windows file normalization - no crash} \
   -constraints win -setup {
     set oldhome ""
@@ -1041,43 +1261,30 @@ test winFCmd-16.12 {Windows file normalization - no crash} \
     set ::env(HOME) $oldhome
     cd $pwd
 } -result {no crash}
-
-test winFCmd-16.13 {Windows file normalization} -constraints win -setup {
+test winFCmd-16.13 {Windows file normalization - absolute HOME} -setup {
     set oldhome ""
     catch {set oldhome $::env(HOME)}
-} -body {
+} -constraints win -body {
     # Test 'cd' normalization when HOME is absolute
-    set expectedResult [file normalize ${d}:/]
     set ::env(HOME) ${d}:/
     cd
-    set result [pwd]
-    if { [string equal $result $expectedResult] } {
-	concat ok
-    } else {
-	list $result != $expectedResult
-    }
+    pwd
 } -cleanup {
     set ::env(HOME) $oldhome
     cd $pwd
-} -result ok
-
-test winFCmd-16.14 {Windows file normalization} -constraints win -setup {
+} -result [file normalize ${d}:/]
+test winFCmd-16.14 {Windows file normalization - relative HOME} -setup {
     set oldhome ""
     catch {set oldhome $::env(HOME)}
-} -body {
+} -constraints win -body {
     # Test 'cd' normalization when HOME is relative
     set ::env(HOME) ${d}:
     cd
-    set result [pwd]
-    if { [string equal $result $pwd] } {
-	concat ok
-    } else {
-	list $result != $pwd
-    }
+    pwd
 } -cleanup {
     set ::env(HOME) $oldhome
     cd $pwd
-} -result ok
+} -result $pwd
 
 test winFCmd-17.1 {Windows bad permissions cd} -constraints win -body {
     set d {}
@@ -1085,7 +1292,7 @@ test winFCmd-17.1 {Windows bad permissions cd} -constraints win -body {
 	eval lappend d [glob -nocomplain \
 	  -types hidden -dir $dd "System Volume Information"]
     }
-    # Old versions of Tcl gave a misleading error that the 
+    # Old versions of Tcl gave a misleading error that the
     # directory in question didn't exist.
     if {[llength $d] && [catch {cd [lindex $d 0]} err]} {
 	regsub ".*: " $err "" err
@@ -1103,59 +1310,118 @@ unset d dd pwd
 test winFCmd-18.1 {Windows reserved path names} -constraints win -body {
     file pathtype com1
 } -result "absolute"
-
 test winFCmd-18.1.2 {Windows reserved path names} -constraints win -body {
     file pathtype com4
 } -result "absolute"
-
 test winFCmd-18.1.3 {Windows reserved path names} -constraints win -body {
     file pathtype com5
 } -result "relative"
-
 test winFCmd-18.1.4 {Windows reserved path names} -constraints win -body {
     file pathtype lpt3
 } -result "absolute"
-
 test winFCmd-18.1.5 {Windows reserved path names} -constraints win -body {
     file pathtype lpt4
 } -result "relative"
-
 test winFCmd-18.1.6 {Windows reserved path names} -constraints win -body {
     file pathtype nul
 } -result "absolute"
-
 test winFCmd-18.1.7 {Windows reserved path names} -constraints win -body {
     file pathtype null
 } -result "relative"
-
 test winFCmd-18.2 {Windows reserved path names} -constraints win -body {
     file pathtype com1:
 } -result "absolute"
-
 test winFCmd-18.3 {Windows reserved path names} -constraints win -body {
     file pathtype COM1
 } -result "absolute"
-
 test winFCmd-18.4 {Windows reserved path names} -constraints win -body {
     file pathtype CoM1:
 } -result "absolute"
-
 test winFCmd-18.5 {Windows reserved path names} -constraints win -body {
     file normalize com1:
 } -result COM1
-
 test winFCmd-18.6 {Windows reserved path names} -constraints win -body {
     file normalize COM1:
 } -result COM1
-
 test winFCmd-18.7 {Windows reserved path names} -constraints win -body {
     file normalize cOm1
 } -result COM1
-
 test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
     file normalize cOm1:
 } -result COM1
 
+test winFCmd-19.1 {Windows extended path names} -constraints nt -body {
+    file normalize //?/c:/windows/win.ini
+} -result //?/c:/windows/win.ini
+test winFCmd-19.2 {Windows extended path names} -constraints nt -body {
+    file normalize //?/c:/windows/../windows/win.ini
+} -result //?/c:/windows/win.ini
+test winFCmd-19.3 {Windows extended path names} -constraints nt -setup {
+    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
+    set tmpfile [file normalize $tmpfile]
+} -body {
+    list [catch {
+        set f [open $tmpfile [list WRONLY CREAT]]
+        close $f
+    } res] $res
+} -cleanup {
+    catch {file delete $tmpfile}
+} -result [list 0 {}]
+test winFCmd-19.4 {Windows extended path names} -constraints nt -setup {
+    set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
+    set tmpfile //?/[file normalize $tmpfile]
+} -body {
+    list [catch {
+        set f [open $tmpfile [list WRONLY CREAT]]
+        close $f
+    } res] $res
+} -cleanup {
+    catch {file delete $tmpfile}
+} -result [list 0 {}]
+test winFCmd-19.5 {Windows extended path names} -constraints nt -setup {
+    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
+    set tmpfile [file normalize $tmpfile]
+} -body {
+    list [catch {
+        set f [open $tmpfile [list WRONLY CREAT]]
+        close $f
+    } res] $res
+} -cleanup {
+    catch {file delete $tmpfile}
+} -result [list 0 {}]
+test winFCmd-19.6 {Windows extended path names} -constraints nt -setup {
+    set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
+    set tmpfile //?/[file normalize $tmpfile]
+} -body {
+    list [catch {
+        set f [open $tmpfile [list WRONLY CREAT]]
+        close $f
+    } res] $res
+} -cleanup {
+    catch {file delete $tmpfile}
+} -result [list 0 {}]
+test winFCmd-19.7 {Windows extended path names} -constraints nt -setup {
+    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
+    set tmpfile [file normalize $tmpfile]
+} -body {
+    list [catch {
+        set f [open $tmpfile [list WRONLY CREAT]]
+        close $f
+    } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*]
+} -cleanup {
+    catch {file delete $tmpfile}
+} -result [list 0 {} [list tcl[pid].tmp]]
+test winFCmd-19.8 {Windows extended path names} -constraints nt -setup {
+    set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
+    set tmpfile //?/[file normalize $tmpfile]
+} -body {
+    list [catch {
+        set f [open $tmpfile [list WRONLY CREAT]]
+        close $f
+    } res] $res [glob -directory $::env(TEMP) -tails tcl[pid].*]
+} -cleanup {
+    catch {file delete $tmpfile}
+} -result [list 0 {} [list "tcl[pid].tmp "]]
 
 # This block of code used to occur after the "return" call, so I'm
 # commenting it out and assuming that this code is still under construction.
diff --git a/tests/winFile.test b/tests/winFile.test
index ffbb776..2c47f5f 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -1,16 +1,14 @@
 # This file tests the tclWinFile.c file.
 #
-# 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) 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.
-#
-# RCS: @(#) $Id: winFile.test,v 1.16 2004/11/08 19:19:27 davygrvy Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 if {[catch {package require tcltest 2.0.2}]} {
     puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -18,81 +16,59 @@ if {[catch {package require tcltest 2.0.2}]} {
 }
 namespace import -force ::tcltest::*
 
-if {[info commands ::testvolumetype] == ""} {
-    tcltest::testConstraint notNTFS 0
-} else {
-    if {![string equal "NTFS" [testvolumetype]]} {
-	tcltest::testConstraint notNTFS 0
-    } else {
-	tcltest::testConstraint notNTFS 1
-    }
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
+testConstraint testvolumetype [llength [info commands testvolumetype]]
+testConstraint notNTFS 0
+testConstraint win2000 0
+
+if {[testConstraint testvolumetype]} {
+    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
 }
-if {[string equal $::tcl_platform(os) "Windows NT"] &&
-	    $::tcl_platform(osVersion) >= 5.0} {
-    tcltest::testConstraint win2000 1
-} else {
-    tcltest::testConstraint win2000 0
+if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
+    testConstraint win2000 1
 }
 
-test winFile-1.1 {TclpGetUserHome} {win} {
-    list [catch {glob ~nosuchuser} msg] $msg
-} {1 {user "nosuchuser" doesn't exist}}
-test winFile-1.2 {TclpGetUserHome} {win nt nonPortable} {
+test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
+    glob ~nosuchuser
+} -returnCodes error -result {user "nosuchuser" doesn't exist}
+test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
     # The administrator account should always exist.
-
-    catch {glob ~administrator}
-} {0}
-test winFile-1.3 {TclpGetUserHome} {win 95} {
-    # Find some user in system.ini and then see if they have a home.
-
-    set f [open $::env(windir)/system.ini]
-    set x 0
-    while {![eof $f]} {
-	set line [gets $f]
-	if {$line == "\[Password Lists]"} {
-	    gets $f
-	    set name [lindex [split [gets $f] =] 0]
-	    if {$name != ""} {
-		set x [catch {glob ~$name}]
-		break
-	    }
-	}
-    }
-    close $f
-    set x
-} {0}
+    glob ~administrator
+} -match glob -result *
 test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
     catch {glob ~stanton@workgroup}
 } {0}
 
-test winFile-2.1 {TclpMatchFiles: case sensitivity} {win} {
+test winFile-2.1 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
     makeFile {} GlobCapS
-    set result [list [glob -nocomplain GlobC*] [glob -nocomplain globc*]]
+    list [glob -nocomplain GlobC*] [glob -nocomplain globc*]
+} -cleanup {
     removeFile GlobCapS
-    set result
-} {GlobCapS GlobCapS}
-test winFile-2.2 {TclpMatchFiles: case sensitivity} {win} {
+} -result {GlobCapS GlobCapS}
+test winFile-2.2 {TclpMatchFiles: case sensitivity} -constraints {win} -body {
     makeFile {} globlower
-    set result [list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]]
+    list [glob -nocomplain globl*] [glob -nocomplain gLOBl*]
+} -cleanup {
     removeFile globlower
-    set result
-} {globlower globlower}
+} -result {globlower globlower}
 
-test winFile-3.1 {file system} {win} {
-    set res "volume types ok"
+test winFile-3.1 {file system} -constraints {win testvolumetype} -setup {
+    set res ""
+} -body {
     foreach vol [file volumes] {
 	# Have to catch in case there is a removable drive (CDROM, floppy)
 	# with nothing in it.
 	catch {
-	    if {![string equal [lindex [file system $vol] 1] [testvolumetype $vol]]} {
-		set res "For $vol, we found [file system $vol]\
-		  and [testvolumetype $vol] are different"
-		break
+	    if {[lindex [file system $vol] 1] ne [testvolumetype $vol]} {
+		append res "For $vol, we found [file system $vol]\
+			and [testvolumetype $vol] are different\n"
 	    }
 	}
     }
     set res
-} {volume types ok}
+} -result {}
 
 proc cacls {fname args} {
     string trim [eval [list exec cacls [file nativename $fname]] $args <<y]
@@ -100,30 +76,41 @@ proc cacls {fname args} {
 
 # dir/q output:
 # 2003-11-03  20:36                  598 OCTAVIAN\benny         filename.txt
+# Note this output from a german win2k machine:
+# 14.12.2007  14:26                   30 VORDEFINIERT\Administratest.dat
+#
+# Modified to cope with Msys environment and use ls -l.
 proc getuser {fname} {
+    global env
     set tryname $fname
     if {[file isdirectory $fname]} {
 	set tryname [file dirname $fname]
     }
-    set tail [file tail $tryname]
-    set dirtext [exec cmd /c dir /q [file nativename $fname]]
     set owner ""
-    foreach line [split $dirtext "\n"] {
-	if {[string match -nocase "* $tail" $line]} {
-	    set attrs [string range $line \
-	      0 end-[string length $tail]]
-	    regexp { [A-Z]+\\.*$} $attrs owner
-	    set owner [string trim $owner]
-	}
+    set tail [file tail $tryname]
+    if {[info exists env(OSTYPE)] && $env(OSTYPE) eq "msys"} {
+        set dirtext [exec ls -l $fname]
+        foreach line [split $dirtext "\n"] {
+            set owner [lindex $line 2]
+        }
+    } else {
+        set dirtext [exec cmd /c dir /q [file nativename $fname]]
+        foreach line [split $dirtext "\n"] {
+            if {[string match -nocase "*$tail" $line]} {
+                set attrs [string range $line 0 end-[string length $tail]]
+                regexp { [^ \\]+\\.*$} $attrs owner
+                set owner [string trim $owner]
+            }
+        }
     }
-    if {"" == "$owner"} {
+    if {$owner eq ""} {
 	error "getuser: Owner not found in output of dir/q"
     }
     return $owner
 }
 
 proc test_read {fname} {
-    if {[catch {set ifs [open $fname r]}]} {
+    if {[catch {open $fname r} ifs]} {
 	return 0
     }
     set readfailed [catch {read $ifs}]
@@ -131,7 +118,7 @@ proc test_read {fname} {
 }
 
 proc test_writ {fname} {
-    if {[catch {set ofs [open $fname w]}]} {
+    if {[catch {open $fname w} ofs]} {
 	return 0
     }
     set writefailed [catch {puts $ofs "Hello"}]
@@ -148,20 +135,21 @@ proc test_access {fname read writ} {
 	    lappend problem "[set $type] != \[test_${type} $fname\]"
 	}
     }
-    if {[llength $problem]} {
-	return "Problem [join $problem \n]\nActual rights are: [cacls $fname]"
-    } else {
-	return ""
+    if {![llength $problem]} {
+	return
     }
+    return "Problem [join $problem \n]\nActual rights are: [cacls $fname]"
 }
 
-# Create the test file
-# NOTE: [tcltest::makeFile] not used.  Presumably to force file
-# creation in a particular filesystem?  If not, try [makeFile]
-# in a -setup script.
-set fname test.dat
-file delete $fname
-close [open $fname w]
+if {[testConstraint win]} {
+    # Create the test file
+    # NOTE: [tcltest::makeFile] not used.  Presumably to force file
+    # creation in a particular filesystem?  If not, try [makeFile]
+    # in a -setup script.
+    set fname test.dat
+    file delete $fname
+    close [open $fname w]
+}
 
 test winFile-4.0 {
     Enhanced NTFS user/group permissions: test no acccess
@@ -227,8 +215,10 @@ test winFile-4.4 {
     test_access $fname 1 1
 } -result {}
 
-file delete $fname
+if {[testConstraint win]} {
+    file delete $fname
+}
 
 # cleanup
-::tcltest::cleanupTests
+cleanupTests
 return
diff --git a/tests/winNotify.test b/tests/winNotify.test
index 09ddc1c..3e9aa29 100644
--- a/tests/winNotify.test
+++ b/tests/winNotify.test
@@ -9,14 +9,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winNotify.test,v 1.10 2004/06/23 15:36:59 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testeventloop [expr {[info commands testeventloop] != {}}]
 
 # There is no explicit test for InitNotifier or NotifierExitHandler
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 1572348..9c6f94d 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -1,35 +1,36 @@
-# 
+#
 # winPipe.test --
 #
 # This file contains a collection of tests for tclWinPipe.c
 #
-# 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 (except for one message) means no errors were found.
 #
 # Copyright (c) 1996 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.
-#
-# RCS: @(#) $Id: winPipe.test,v 1.31 2004/07/02 18:46:18 kennykb Exp $
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
 package require tcltest
 namespace import -force ::tcltest::*
 unset -nocomplain path
 
-testConstraint exec [llength [info commands exec]]
+catch {
+    ::tcltest::loadTestedCommands
+    package require -exact Tcltest [info patchlevel]
+    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
+}
 
 set bindir [file join [pwd] [file dirname [info nameofexecutable]]]
 set cat32 [file join $bindir cat32.exe]
 
-testConstraint cat32 [file exists $cat32]
+testConstraint exec         [llength [info commands exec]]
+testConstraint cat32        [file exists $cat32]
+testConstraint AllocConsole [catch {puts console1 ""}]
+testConstraint RealConsole  [expr {![testConstraint AllocConsole]}]
+testConstraint testexcept   [llength [info commands testexcept]]
 
-if {[catch {puts console1 ""}]} {
-    testConstraint AllocConsole 1
-} else {
-    testConstraint .console 1
-}
 
 set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
 append big $big
@@ -64,7 +65,7 @@ set path(more) [makeFile {
 
 set path(stdout) [makeFile {} stdout]
 set path(stderr) [makeFile {} stderr]
-
+
 test winpipe-1.1 {32 bit comprehensive tests: from little file} {win exec cat32} {
     exec $cat32 < $path(little) > $path(stdout) 2> $path(stderr)
     list [contents $path(stdout)] [contents $path(stderr)]
@@ -74,15 +75,11 @@ test winpipe-1.2 {32 bit comprehensive tests: from big file} {win exec cat32} {
     list [contents $path(stdout)] [contents $path(stderr)]
 } "{$big} stderr32"
 test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win nt exec cat32} {
-    exec [interpreter] more < little | $cat32 > $path(stdout) 2> $path(stderr)
+    exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
     list [contents $path(stdout)] [contents $path(stderr)]
 } {little stderr32}
 test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} {
-    exec [interpreter] more < big | $cat32 > $path(stdout) 2> $path(stderr)
-    list [contents $path(stdout)] [contents $path(stderr)]
-} "{$big} stderr32"
-test winpipe-1.5 {32 bit comprehensive tests: a lot from pipe} {win 95 exec cat32} {
-    exec command /c type big |& $cat32 > $path(stdout) 2> $path(stderr)
+    exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
     list [contents $path(stdout)] [contents $path(stderr)]
 } "{$big} stderr32"
 test winpipe-1.6 {32 bit comprehensive tests: from console} \
@@ -97,7 +94,7 @@ test winpipe-1.8 {32 bit comprehensive tests: from socket} {win cat32} {
     # doesn't work
 } {}
 test winpipe-1.9 {32 bit comprehensive tests: from nowhere} \
-	{win exec cat32 .console} {
+	{win exec cat32 RealConsole} {
     exec $cat32 > $path(stdout) 2> $path(stderr)
     list [contents $path(stdout)] [contents $path(stderr)]
 } {{} stderr32}
@@ -145,8 +142,8 @@ test winpipe-1.17 {32 bit comprehensive tests: to NUL} {win exec cat32} {
     set msg
 } stderr32
 test winpipe-1.18 {32 bit comprehensive tests: to nowhere} \
-	{win exec cat32 .console} {
-    exec $cat32 < $path(big) >&@stdout 
+	{win exec cat32 RealConsole} {
+    exec $cat32 < $path(big) >&@stdout
 } {}
 test winpipe-1.19 {32 bit comprehensive tests: to file handle} {win exec cat32} {
     set f1 [open $path(stdout) w]
@@ -173,11 +170,6 @@ test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
     catch {close $f}
     set r
 } "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
-test winpipe-1.22 {Checking command.com for Win95/98 hanging} {win 95 exec} {
-    exec command.com /c dir /b
-    set result 1
-} 1
-file delete more
 
 test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
     proc readResults {f} {
@@ -190,8 +182,7 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
 	    set result "$result$line"
 	}
     }
-
-    set f [open "|[list $cat32] < big 2> $path(stderr)" r]
+    set f [open "|[list $cat32] < $path(big) 2> $path(stderr)" r]
     fconfigure $f  -buffering none -blocking 0
     fileevent $f readable "readResults $f"
     set x 0
@@ -199,30 +190,34 @@ test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
     vwait x
     list $result $x [contents $path(stderr)]
 } "{$big} 1 stderr32"
-test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec} {
-    set f [open "|[tcltest::interpreter]" w+]
+test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept} {
+    set f [open "|[list [interpreter]]" w+]
     set pid [pid $f]
+    puts $f "load $::tcltestlib Tcltest"
     puts $f "testexcept float_underflow"
     set status [catch {close $f}]
     list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
 } {1 1 SIGFPE}
-test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec} {
-    set f [open "|[tcltest::interpreter]" w+]
+test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept} {
+    set f [open "|[list [interpreter]]" w+]
     set pid [pid $f]
+    puts $f "load $::tcltestlib Tcltest"
     puts $f "testexcept access_violation"
     set status [catch {close $f}]
     list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
 } {1 1 SIGSEGV}
-test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec} {
-    set f [open "|[tcltest::interpreter]" w+]
+test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept} {
+    set f [open "|[list [interpreter]]" w+]
     set pid [pid $f]
+    puts $f "load $::tcltestlib Tcltest"
     puts $f "testexcept illegal_instruction"
     set status [catch {close $f}]
     list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
 } {1 1 SIGILL}
-test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec} {
-    set f [open "|[tcltest::interpreter]" w+]
+test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept} {
+    set f [open "|[list [interpreter]]" w+]
     set pid [pid $f]
+    puts $f "load $::tcltestlib Tcltest"
     puts $f "testexcept ctrl+c"
     set status [catch {close $f}]
     list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
@@ -240,9 +235,9 @@ set env(TEMP) c:/
 test winpipe-5.1 {TclpCreateTempFile: cleanup temp files} {win exec} {
     set x {}
     set existing [glob -nocomplain c:/tcl*.tmp]
-    exec [interpreter] < nothing 
+    exec [interpreter] < $path(nothing)
     foreach p [glob -nocomplain c:/tcl*.tmp] {
-	if {[lsearch $existing $p] == -1} {
+	if {$p ni $existing} {
 	    lappend x $p
 	}
     }
@@ -253,7 +248,7 @@ test winpipe-5.2 {TclpCreateTempFile: TMP and TEMP not defined} {win exec} {
     set temp $env(TEMP)
     unset env(TMP)
     unset env(TEMP)
-    exec [interpreter] < nothing
+    exec [interpreter] < $path(nothing)
     set env(TMP) $tmp
     set env(TEMP) $temp
     set x {}
@@ -262,7 +257,7 @@ test winpipe-5.3 {TclpCreateTempFile: TMP specifies non-existent directory} \
 	{win exec } {
     set tmp $env(TMP)
     set env(TMP) snarky
-    exec [interpreter] < nothing
+    exec [interpreter] < $path(nothing)
     set env(TMP) $tmp
     set x {}
 } {}
@@ -272,7 +267,7 @@ test winpipe-5.4 {TclpCreateTempFile: TEMP specifies non-existent directory} \
     set temp $env(TEMP)
     unset env(TMP)
     set env(TEMP) snarky
-    exec [interpreter] < nothing
+    exec [interpreter] < $path(nothing)
     set env(TMP) $tmp
     set env(TEMP) $temp
     set x {}
@@ -317,7 +312,6 @@ set path(echoArgs.tcl) [makeFile {
     puts "[list $argv0 $argv]"
 } echoArgs.tcl]
 
-
 ### validate the raw output of BuildCommandLine().
 ###
 test winpipe-7.1 {BuildCommandLine: null arguments} {win exec} {
@@ -327,13 +321,13 @@ test winpipe-7.2 {BuildCommandLine: null arguments} {win exec} {
     exec $env(COMSPEC) /c echo foo {} bar
 } {foo "" bar}
 test winpipe-7.3 {BuildCommandLine: dbl quote quoting #1} {win exec} {
-    exec $env(COMSPEC) /c echo foo {"} bar
+    exec $env(COMSPEC) /c echo foo "\"" bar
 } {foo \" bar}
 test winpipe-7.4 {BuildCommandLine: dbl quote quoting #2} {win exec} {
     exec $env(COMSPEC) /c echo foo {""} bar
 } {foo \"\" bar}
 test winpipe-7.5 {BuildCommandLine: dbl quote quoting #3} {win exec} {
-    exec $env(COMSPEC) /c echo foo {" } bar
+    exec $env(COMSPEC) /c echo foo "\" " bar
 } {foo "\" " bar}
 test winpipe-7.6 {BuildCommandLine: dbl quote quoting #4} {win exec} {
     exec $env(COMSPEC) /c echo foo {a="b"} bar
@@ -342,7 +336,7 @@ test winpipe-7.7 {BuildCommandLine: dbl quote quoting #5} {win exec} {
     exec $env(COMSPEC) /c echo foo {a = "b"} bar
 } {foo "a = \"b\"" bar}
 test winpipe-7.8 {BuildCommandLine: dbl quote quoting #6} {win exec} {
-    exec $env(COMSPEC) /c echo {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}
+    exec $env(COMSPEC) /c echo {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} "he \" llo"
 } {\"hello\" \"\"hello\"\" \"\"\"hello\"\"\" \"\\\"hello\\\"\" "he llo" "he \" llo"}
 test winpipe-7.9 {BuildCommandLine: N backslashes followed a quote rule #1} {win exec} {
     exec $env(COMSPEC) /c echo foo \\ bar
@@ -384,14 +378,14 @@ test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win
     exec [interpreter] $path(echoArgs.tcl) foo {} bar
 } [list $path(echoArgs.tcl) [list foo {} bar]]
 test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #1} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {"} bar
-} [list $path(echoArgs.tcl) [list foo {"} bar]]
+    exec [interpreter] $path(echoArgs.tcl) foo "\"" bar
+} [list $path(echoArgs.tcl) [list foo "\"" bar]]
 test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #2} {win exec} {
     exec [interpreter] $path(echoArgs.tcl) foo {""} bar
 } [list $path(echoArgs.tcl) [list foo {""} bar]]
 test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #3} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {" } bar
-} [list $path(echoArgs.tcl) [list foo {" } bar]]
+    exec [interpreter] $path(echoArgs.tcl) foo "\" " bar
+} [list $path(echoArgs.tcl) [list foo "\" " bar]]
 test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #4} {win exec} {
     exec [interpreter] $path(echoArgs.tcl) foo {a="b"} bar
 } [list $path(echoArgs.tcl) [list foo {a="b"} bar]]
@@ -434,7 +428,7 @@ test winpipe-8.18 {BuildCommandLine/parse_cmdline pass-thru: special chars #2} {
 test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {win exec} {
     exec [interpreter] $path(echoArgs.tcl) foo * makefile.?c bar
 } [list $path(echoArgs.tcl) [list foo * makefile.?c bar]]
-
+
 # restore old values for env(TMP) and env(TEMP)
 
 if {[catch {set env(TMP) $env_tmp}]} {
@@ -445,6 +439,16 @@ if {[catch {set env(TEMP) $env_temp}]} {
 }
 
 # cleanup
-file delete big little stdout stderr nothing echoArgs.tcl
+removeFile little
+removeFile big
+removeFile more
+removeFile stdout
+removeFile stderr
+removeFile nothing
+removeFile echoArgs.tcl
 ::tcltest::cleanupTests
 return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/winTime.test b/tests/winTime.test
index 00cf4d8..add8f98 100644
--- a/tests/winTime.test
+++ b/tests/winTime.test
@@ -9,14 +9,15 @@
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-# RCS: @(#) $Id: winTime.test,v 1.10 2004/06/23 15:36:59 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
 
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
 testConstraint testwinclock [llength [info commands testwinclock]]
 
 # The next two tests will crash on Windows if the check for negative
diff --git a/tests/zlib.test b/tests/zlib.test
new file mode 100644
index 0000000..4e51ebb
--- /dev/null
+++ b/tests/zlib.test
@@ -0,0 +1,878 @@
+# The file tests the tclZlib.c file.
+#
+# 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) 1996-1998 by 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.
+
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::*
+}
+
+testConstraint zlib [llength [info commands zlib]]
+testConstraint recentZlib 0
+catch {
+    # Work around a bug in some versions of zlib; known to manifest on at
+    # least Mac OS X Mountain Lion...
+    testConstraint recentZlib \
+	    [package vsatisfies [zlib::pkgconfig get zlibVersion] 1.2.6]
+}
+
+test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body {
+    zlib
+} -result {wrong # args: should be "zlib command arg ?...?"}
+test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body {
+    zlib ? {}
+} -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream}
+test zlib-1.3 {zlib basics} -constraints zlib -body {
+    zlib::pkgconfig list
+} -result zlibVersion
+test zlib-1.4 {zlib basics} -constraints zlib -body {
+    package present zlib
+} -result 2.0
+
+test zlib-2.1 {zlib compress/decompress} zlib {
+    zlib decompress [zlib compress abcdefghijklm]
+} abcdefghijklm
+
+test zlib-3.1 {zlib deflate/inflate} zlib {
+    zlib inflate [zlib deflate abcdefghijklm]
+} abcdefghijklm
+
+test zlib-4.1 {zlib gzip/gunzip} zlib {
+    zlib gunzip [zlib gzip abcdefghijklm]
+} abcdefghijklm
+test zlib-4.2 {zlib gzip/gunzip} zlib {
+    set s [string repeat abcdef 5]
+    list [zlib gunzip [zlib gzip $s -header {comment gorp}] -header head] \
+	[dict get $head comment] [dict get $head size]
+} {abcdefabcdefabcdefabcdefabcdef gorp 30}
+
+test zlib-5.1 {zlib adler32} zlib {
+    format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}]
+} b3b50b9b
+test zlib-5.2 {zlib adler32} zlib {
+    format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}]
+} b8830bc4
+test zlib-5.3 {zlib adler32} -constraints zlib -returnCodes error -body {
+    zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42 x
+} -result {wrong # args: should be "zlib adler32 data ?startValue?"}
+
+test zlib-6.1 {zlib crc32} zlib {
+    format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}]
+} 6f73e901
+test zlib-6.2 {zlib crc32} zlib {
+    format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}]
+} ce1c4914
+test zlib-6.3 {zlib crc32} -constraints zlib -returnCodes error -body {
+    zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42 x
+} -result {wrong # args: should be "zlib crc32 data ?startValue?"}
+test zlib-6.4 {zlib crc32: bug 2662434} -constraints zlib -body {
+    zlib crc32 "dabale arroz a la zorra el abad"
+} -result 3842832571
+
+test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup {
+    set s [zlib stream compress]
+} -body {
+    $s ?
+} -cleanup {
+    $s close
+} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset}
+test zlib-7.1 {zlib stream} zlib {
+    set s [zlib stream compress]
+    $s put -finalize abcdeEDCBA
+    set data [$s get]
+    set result [list [$s get] [format %x [$s checksum]]]
+    $s close
+    lappend result [zlib decompress $data]
+} {{} 136f033f abcdeEDCBA}
+test zlib-7.2 {zlib stream} zlib {
+    set s [zlib stream decompress]
+    $s put -finalize [zlib compress abcdeEDCBA]
+    set data [$s get]
+    set result [list [$s get] [format %x [$s checksum]]]
+    $s close
+    lappend result $data
+} {{} 136f033f abcdeEDCBA}
+test zlib-7.3 {zlib stream} zlib {
+    set s [zlib stream deflate]
+    $s put -finalize abcdeEDCBA
+    set data [$s get]
+    set result [list [$s get] [format %x [$s checksum]]]
+    $s close
+    lappend result [zlib inflate $data]
+} {{} 1 abcdeEDCBA}
+test zlib-7.4 {zlib stream} zlib {
+    set s [zlib stream inflate]
+    $s put -finalize [zlib deflate abcdeEDCBA]
+    set data [$s get]
+    set result [list [$s get] [format %x [$s checksum]]]
+    $s close
+    lappend result $data
+} {{} 1 abcdeEDCBA}
+test zlib-7.5 {zlib stream} zlib {
+    set s [zlib stream gzip]
+    $s put -finalize abcdeEDCBA..
+    set data [$s get]
+    set result [list [$s get] [format %x [$s checksum]]]
+    $s close
+    lappend result [zlib gunzip $data]
+} {{} 69f34b6a abcdeEDCBA..}
+test zlib-7.6 {zlib stream} zlib {
+    set s [zlib stream gunzip]
+    $s put -finalize [zlib gzip abcdeEDCBA..]
+    set data [$s get]
+    set result [list [$s get] [format %x [$s checksum]]]
+    $s close
+    lappend result $data
+} {{} 69f34b6a abcdeEDCBA..}
+
+test zlib-8.1 {zlib transformation} -constraints zlib -setup {
+    set file [makeFile {} test.gz]
+} -body {
+    set f [zlib push gzip [open $file w] -header {comment gorp}]
+    puts $f "ok"
+    close $f
+    set f [zlib push gunzip [open $file]]
+    list [gets $f] [dict get [chan configure $f -header] comment]
+} -cleanup {
+    close $f
+    removeFile $file
+} -result {ok gorp}
+test zlib-8.2 {zlib transformation} -constraints zlib -setup {
+    set file [makeFile {} test.z]
+} -body {
+    set f [zlib push compress [open $file w]]
+    puts $f "ok"
+    close $f
+    set f [zlib push decompress [open $file]]
+    gets $f
+} -cleanup {
+    close $f
+    removeFile $file
+} -result ok
+test zlib-8.3 {zlib transformation and fileevent} -constraints zlib -setup {
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        fconfigure $c -translation binary -buffering none -blocking 0
+        puts -nonewline $c [zlib gzip [string repeat a 81920]]
+        close $c
+    }}} 0]
+    set port [lindex [fconfigure $srv -sockname] 2]
+    set file [makeFile {} test.gz]
+    set fout [open $file wb]
+} -body {
+    set sin [socket localhost $port]
+    try {
+	fconfigure $sin -translation binary
+	zlib push gunzip $sin
+	after 1000 {set total timeout}
+	fcopy $sin $fout -command {apply {{c {e {}}} {
+	    set ::total [expr {$e eq {} ? $c : $e}]
+	}}}
+	vwait total
+	after cancel {set total timeout}
+    } finally {
+	close $sin
+    }
+    append total --> [file size $file]
+} -cleanup {
+    close $fout
+    close $srv
+    removeFile $file
+} -result 81920-->81920
+test zlib-8.4 {transformation and flushing: Bug 3517696} -setup {
+    set file [makeFile {} test.z]
+    set fd [open $file w]
+} -constraints zlib -body {
+    zlib push compress $fd
+    puts $fd "qwertyuiop"
+    fconfigure $fd -flush sync
+    puts $fd "qwertyuiop"
+} -cleanup {
+    catch {close $fd}
+    removeFile $file
+} -result {}
+test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup {
+    foreach {r w} [chan pipe] break
+} -constraints zlib -body {
+    set ::res {}
+    fconfigure $w -buffering none
+    zlib push compress $w
+    puts -nonewline $w qwertyuiop
+    chan configure $w -flush sync
+    after 500 {puts -nonewline $w asdfghjkl;close $w}
+    fconfigure $r -blocking 0 -buffering none
+    zlib push decompress $r
+    fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}}
+    after 250 {lappend ::res MIDDLE}
+    vwait ::done
+    set ::res
+} -cleanup {
+    catch {close $r}
+} -result {qwertyuiop MIDDLE asdfghjkl}
+test zlib-8.6 {transformation and fconfigure} -setup {
+    set file [makeFile {} test.z]
+    set fd [open $file wb]
+} -constraints zlib -body {
+    list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
+	[chan pop $fd; fconfigure $fd]
+} -cleanup {
+    catch {close $fd}
+    removeFile $file
+} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
+test zlib-8.7 {transformation and fconfigure} -setup {
+    set file [makeFile {} test.gz]
+    set fd [open $file wb]
+} -constraints zlib -body {
+    list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
+	[chan pop $fd; fconfigure $fd]
+} -cleanup {
+    catch {close $fd}
+    removeFile $file
+} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
+# Input is headers from fetching SPDY draft
+# Dictionary is that which is proposed _in_ SPDY draft
+set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
+set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
+test zlib-8.8 {transformation and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+} -constraints zlib -body {
+    zlib push compress $outSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary -buffering none
+    fconfigure $inSide -blocking 0 -translation binary
+    puts -nonewline $outSide $spdyHeaders
+    chan pop $outSide
+    set compressed [read $inSide]
+    catch {zlib decompress $compressed} err opt
+    list [string length [zlib compress $spdyHeaders]] \
+	[string length $compressed] \
+	$err [dict get $opt -errorcode] [zlib adler32 $spdyDict]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010}
+test zlib-8.9 {transformation and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream decompress]
+} -constraints zlib -body {
+    zlib push compress $outSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary -buffering none
+    fconfigure $inSide -blocking 0 -translation binary
+    puts -nonewline $outSide $spdyHeaders
+    set result [fconfigure $outSide -checksum]
+    chan pop $outSide
+    $strm put -dictionary $spdyDict [read $inSide]
+    lappend result [string length $spdyHeaders] [string length [$strm get]]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {3064818174 358 358}
+test zlib-8.10 {transformation and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+} -constraints {zlib recentZlib} -body {
+    zlib push deflate $outSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary -buffering none
+    fconfigure $inSide -blocking 0 -translation binary
+    puts -nonewline $outSide $spdyHeaders
+    chan pop $outSide
+    set compressed [read $inSide]
+    catch {
+	zlib inflate $compressed
+	throw UNREACHABLE "should be unreachable"
+    } err opt
+    list [string length [zlib deflate $spdyHeaders]] \
+	[string length $compressed] \
+	$err [dict get $opt -errorcode]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+} -result {254 212 {data error} {TCL ZLIB DATA}}
+test zlib-8.11 {transformation and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream inflate]
+} -constraints zlib -body {
+    zlib push deflate $outSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary -buffering none
+    fconfigure $inSide -blocking 0 -translation binary
+    puts -nonewline $outSide $spdyHeaders
+    chan pop $outSide
+    $strm put -dictionary $spdyDict [read $inSide]
+    list [string length $spdyHeaders] [string length [$strm get]]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358}
+test zlib-8.12 {transformation and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream compress]
+} -constraints zlib -body {
+    $strm put -dictionary $spdyDict -finalize $spdyHeaders
+    zlib push decompress $inSide
+    fconfigure $outSide -blocking 0 -translation binary
+    fconfigure $inSide -translation binary -dictionary $spdyDict
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]] \
+	[fconfigure $inSide -checksum]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358 3064818174}
+test zlib-8.13 {transformation and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream compress]
+} -constraints zlib -body {
+    $strm put -dictionary $spdyDict -finalize $spdyHeaders
+    zlib push decompress $inSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -translation binary
+    fconfigure $inSide -translation binary
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]] \
+	[fconfigure $inSide -checksum]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358 3064818174}
+test zlib-8.14 {transformation and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream deflate]
+} -constraints zlib -body {
+    $strm put -finalize -dictionary $spdyDict $spdyHeaders
+    zlib push inflate $inSide
+    fconfigure $outSide -blocking 0 -buffering none -translation binary
+    fconfigure $inSide -translation binary -dictionary $spdyDict
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358}
+test zlib-8.15 {transformation and fconfigure} -setup {
+    lassign [chan pipe] inSide outSide
+    set strm [zlib stream deflate]
+} -constraints zlib -body {
+    $strm put -finalize -dictionary $spdyDict $spdyHeaders
+    zlib push inflate $inSide -dictionary $spdyDict
+    fconfigure $outSide -blocking 0 -buffering none -translation binary
+    fconfigure $inSide -translation binary
+    puts -nonewline $outSide [$strm get]
+    close $outSide
+    list [string length $spdyHeaders] [string length [read $inSide]]
+} -cleanup {
+    catch {close $outSide}
+    catch {close $inSide}
+    catch {$strm close}
+} -result {358 358}
+test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup {
+    # Actual data isn't very important; needs to be substantially larger than
+    # the internal buffer (32kB) and incompressible.
+    set largeData {}
+    for {set i 0;expr srand(1)} {$i < 100000} {incr i} {
+	append largeData [lindex "a b c d e f g h i j k l m n o p" \
+		[expr {int(16*rand())}]]
+    }
+    set file [makeFile {} test.gz]
+} -constraints zlib -body {
+    set f [open $file wb]
+    fconfigure $f -buffering none
+    zlib push gzip $f
+    puts -nonewline $f $largeData
+    close $f
+    file size $file
+} -cleanup {
+    removeFile $file
+} -result 57647
+
+test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
+    set sfile [makeFile {} testsrc.gz]
+    set file [makeFile {} test.gz]
+    set f [open $sfile wb]
+    puts -nonewline $f [zlib gzip [string repeat a 81920]]
+    close $f
+} -body {
+    set fin [zlib push gunzip [open $sfile rb]]
+    set fout [open $file wb]
+    set total [fcopy $fin $fout]
+    close $fin ; close $fout
+    list copied $total size [file size $file]
+} -cleanup {
+    removeFile $file
+    removeFile $sfile
+} -result {copied 81920 size 81920}
+test zlib-9.2 "socket fcopy with push" -constraints zlib -setup {
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary -buffering none -blocking 0
+        puts -nonewline $c [zlib gzip [string repeat a 81920]]
+        close $c
+    }}} 0]
+    set file [makeFile {} test.gz]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    set sin [socket $addr $port]
+    chan configure $sin -translation binary
+    zlib push gunzip $sin
+    update
+    set total [fcopy $sin [set fout [open $file wb]]]
+    close $sin
+    close $fout
+    list read $total size [file size $file]
+} -cleanup {
+    close $srv
+    removeFile $file
+} -result {read 81920 size 81920}
+test zlib-9.3 "socket fcopy bg (identity)" -constraints {tempNotWin zlib} -setup {
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        #puts "connection from $a:$p on $c"
+        chan configure $c -translation binary -buffering none -blocking 0
+        puts -nonewline $c [string repeat a 81920]
+        close $c
+    }}} 0]
+    set file [makeFile {} test.gz]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    #puts "listening for connections on $addr $port"
+    set sin [socket localhost $port]
+    chan configure $sin -translation binary
+    update
+    set fout [open $file wb]
+    after 1000 {set ::total timeout}
+    fcopy $sin $fout -command {apply {{c {e {}}} {
+        set ::total [expr {$e eq {} ? $c : $e}]
+    }}}
+    vwait ::total
+    after cancel {set ::total timeout}
+    close $sin; close $fout
+    list read $::total size [file size $file]
+} -cleanup {
+    close $srv
+    removeFile $file
+} -returnCodes {ok error} -result {read 81920 size 81920}
+test zlib-9.4 "socket fcopy bg (gzip)" -constraints zlib -setup {
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary -buffering none -blocking 0
+        puts -nonewline $c [zlib gzip [string repeat a 81920]]
+        close $c
+    }}} 0]
+    set file [makeFile {} test.gz]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    set sin [socket $addr $port]
+    chan configure $sin -translation binary
+    zlib push gunzip $sin
+    update
+    set fout [open $file wb]
+    after 1000 {set ::total timeout}
+    fcopy $sin $fout -command {apply {{c {e {}}} {
+        set ::total [expr {$e eq {} ? $c : $e}]
+    }}}
+    vwait ::total
+    after cancel {set ::total timeout}
+    close $sin; close $fout
+    list read $::total size [file size $file]
+} -cleanup {
+    close $srv
+    removeFile $file
+} -result {read 81920 size 81920}
+test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup {
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary -buffering none -blocking 0
+        puts -nonewline $c [zlib gzip [string repeat a 81920]]
+        close $c
+    }}} 0]
+    proc zlib95copy {i o t c {e {}}} {
+        incr t $c
+        if {$e ne {}} {
+            set ::total [list error $e]
+        } elseif {[eof $i]} {
+            set ::total [list eof $t]
+        } else {
+            fcopy $i $o -size 8192 -command [list zlib95copy $i $o $t]
+        }
+    }
+    set file [makeFile {} test.gz]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    set sin [socket $addr $port]
+    chan configure $sin -translation binary
+    zlib push gunzip $sin
+    update
+    set fout [open $file wb]
+    after 1000 {set ::total timeout}
+    fcopy $sin $fout -size 8192 -command [list zlib95copy $sin $fout 0]
+    vwait ::total
+    after cancel {set ::total timeout}
+    close $sin; close $fout
+    list $::total size [file size $file]
+} -cleanup {
+    close $srv
+    rename zlib95copy {}
+    removeFile $file
+} -result {{eof 81920} size 81920}
+test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup {
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary -buffering none -blocking 0
+        zlib push gzip $c
+        puts -nonewline $c [string repeat hello 100]
+        close $c
+    }}} 0]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    after 1000 {set ::total timeout}
+    set s [socket $addr $port]
+    chan configure $s -translation binary
+    zlib push gunzip $s
+    chan event $s readable [list apply {{s} {
+        set d [read $s]
+        if {[eof $s]} {
+            chan event $s readable {}
+            set ::total [list eof [string length $d]]
+        }
+    }} $s]
+    vwait ::total
+    after cancel {set ::total timeout}
+    close $s
+    set ::total
+} -cleanup {
+    close $srv
+    unset -nocomplain total
+} -result {eof 500}
+test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary -buffering none -blocking 0
+        zlib push compress $c
+        puts -nonewline $c [string repeat hello 100]
+        close $c
+    }}} 0]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    after 1000 {set ::total timeout}
+    set s [socket $addr $port]
+    chan configure $s -translation binary
+    zlib push decompress $s
+    chan event $s readable [list apply {{s} {
+        set d [read $s]
+        if {[eof $s]} {
+            chan event $s readable {}
+            set ::total [list eof [string length $d]]
+        }
+    }} $s]
+    vwait ::total
+    after cancel {set ::total timeout}
+    close $s
+    set ::total
+} -cleanup {
+    close $srv
+    unset -nocomplain total
+} -result {eof 500}
+test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary -buffering none -blocking 0
+        zlib push deflate $c
+        puts -nonewline $c [string repeat hello 100]
+        close $c
+    }}} 0]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    after 1000 {set ::total timeout}
+    set s [socket $addr $port]
+    chan configure $s -translation binary
+    zlib push inflate $s
+    chan event $s readable [list apply {{s} {
+        set d [read $s]
+        if {[eof $s]} {
+            chan event $s readable {}
+            set ::total [list eof [string length $d]]
+        }
+    }} $s]
+    vwait ::total
+    after cancel {set ::total timeout}
+    close $s
+    set ::total
+} -cleanup {
+    unset -nocomplain total
+    close $srv
+} -result {eof 500}
+test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup {
+    proc bgerror {s} {set ::total [list error $s]}
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary -buffering none -blocking 0
+        zlib push gzip $c
+        puts -nonewline $c [string repeat hello 100]
+        close $c
+    }}} 0]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    after 1000 {set ::total timeout}
+    set s [socket $addr $port]
+    try {
+        chan configure $s -translation binary
+        zlib push inflate $s
+        chan event $s readable [list apply {{s} {
+            set d [read $s]
+            if {[eof $s]} {
+                chan event $s readable {}
+                set ::total [list eof [string length $d]]
+            }
+        }} $s]
+        vwait ::total
+    } finally {
+	after cancel {set ::total timeout}
+        close $s
+    }
+    set ::total
+} -cleanup {
+    unset -nocomplain total
+    close $srv
+    rename bgerror {}
+} -result {error {invalid block type}}
+test zlib-9.10 "bug #2818131 (compress mismatch)" -constraints zlib -setup {
+    proc bgerror {s} {set ::total [list error $s]}
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary -buffering none -blocking 0
+        zlib push compress $c
+        puts -nonewline $c [string repeat hello 100]
+        close $c
+    }}} 0]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    after 1000 {set ::total timeout}
+    set s [socket $addr $port]
+    try {
+        chan configure $s -translation binary
+        zlib push inflate $s
+        chan event $s readable [list apply {{s} {
+            set d [read $s]
+            if {[eof $s]} {
+                chan event $s readable {}
+                set ::total [list eof [string length $d]]
+            }
+        }} $s]
+        vwait ::total
+    } finally {
+	after cancel {set ::total timeout}
+        close $s
+    }
+    set ::total
+} -cleanup {
+    unset -nocomplain total
+    close $srv
+    rename bgerror {}
+} -result {error {invalid stored block lengths}}
+test zlib-9.11 "bug #2818131 (deflate mismatch)" -constraints zlib -setup {
+    proc bgerror {s} {set ::total [list error $s]}
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary -buffering none -blocking 0
+        zlib push deflate $c
+        puts -nonewline $c [string repeat hello 100]
+        close $c
+    }}} 0]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    after 1000 {set ::total timeout}
+    set s [socket $addr $port]
+    try {
+        chan configure $s -translation binary
+        zlib push gunzip $s
+        chan event $s readable [list apply {{s} {
+            set d [read $s]
+            if {[eof $s]} {
+                chan event $s readable {}
+                set ::total [list eof [string length $d]]
+            }
+        }} $s]
+        vwait ::total
+    } finally {
+	after cancel {set ::total timeout}
+        close $s
+    }
+    set ::total
+} -cleanup {
+    unset -nocomplain total
+    close $srv
+    rename bgerror {}
+} -result {error {incorrect header check}}
+
+test zlib-10.0 "bug #2818131 (close with null interp)" -constraints {
+    zlib
+} -setup {
+    proc bgerror {s} {set ::total [list error $s]}
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary
+        zlib push inflate $c
+        chan event $c readable [list apply {{c} {
+            set d [read $c]
+            if {[eof $c]} {
+                chan event $c readable {}
+                close $c
+                set ::total [list eof [string length $d]]
+            }
+        }} $c]
+    }}} 0]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    after 1000 {set ::total timeout}
+    set s [socket $addr $port]
+    chan configure $s -translation binary -buffering none -blocking 0
+    zlib push gzip $s
+    chan event $s xyzzy [list apply {{s} {
+        if {[gets $s line] < 0} {
+            chan close $s
+        }
+    }} $s]
+    after idle [list apply {{s} {
+        puts $s test
+        chan close $s
+        after 100 {set ::total done}
+    }} $s]
+    vwait ::total
+    after cancel {set ::total timeout}
+    after cancel {set ::total done}
+    set ::total
+} -cleanup {
+    close $srv
+    rename bgerror {}
+} -returnCodes error \
+  -result {bad event name "xyzzy": must be readable or writable}
+test zlib-10.1 "bug #2818131 (mismatch read)" -constraints {
+    zlib
+} -setup {
+    proc bgerror {s} {set ::total [list error $s]}
+    proc zlibRead {c} {
+        set d [read $c]
+        if {[eof $c]} {
+            chan event $c readable {}
+            close $c
+            set ::total [list eof [string length $d]]
+        }
+    }
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary
+        zlib push inflate $c
+        chan event $c readable [list zlibRead $c]
+    }}} 0]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    after 1000 {set ::total timeout}
+    set s [socket $addr $port]
+    chan configure $s -translation binary -buffering none -blocking 0
+    zlib push gzip $s
+    chan event $s readable [list zlibRead $s]
+    after idle [list apply {{s} {
+        puts $s test
+        chan close $s
+        after 100 {set ::total done}
+    }} $s]
+    vwait ::total
+    after cancel {set ::total timeout}
+    after cancel {set ::total done}
+    set ::total
+} -cleanup {
+    close $srv
+    rename bgerror {}
+    rename zlibRead {}
+} -result {error {invalid block type}}
+test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {
+    zlib
+} -setup {
+    proc bgerror {s} {set ::total [list error $s]}
+    proc zlibRead {c} {
+        if {[gets $c line] < 0} {
+            close $c
+            set ::total [list error -1]
+        } elseif {[eof $c]} {
+            chan event $c readable {}
+            close $c
+            set ::total [list eof 0]
+        }
+    }
+    set srv [socket -myaddr localhost -server {apply {{c a p} {
+        chan configure $c -translation binary
+        zlib push inflate $c
+        chan event $c readable [list zlibRead $c]
+    }}} 0]
+} -body {
+    lassign [chan configure $srv -sockname] addr name port
+    after 1000 {set ::total timeout}
+    set s [socket $addr $port]
+    chan configure $s -translation binary -buffering none -blocking 0
+    zlib push gzip $s
+    chan event $s readable [list zlibRead $s]
+    after idle [list apply {{s} {
+        puts $s test
+        chan close $s
+        after 100 {set ::total done}
+    }} $s]
+    vwait ::total
+    after cancel {set ::total timeout}
+    after cancel {set ::total done}
+    set ::total
+} -cleanup {
+    close $srv
+    rename bgerror {}
+    rename zlibRead {}
+} -result {error {invalid block type}}
+
+test zlib-11.1 "Bug #3390073: mis-appled gzip filtering" -setup {
+    set file [makeFile {} test.input]
+} -constraints zlib -body {
+    set f [open $file wb]
+    puts -nonewline [zlib push gzip $f] [string repeat "hello" 1000]
+    close $f
+    set f [open $file rb]
+    set d [read $f]
+    close $f
+    set d [zlib gunzip $d]
+    list [regexp -all "hello" $d] [string length [regsub -all "hello" $d {}]]
+} -cleanup {
+    removeFile $file
+} -result {1000 0}
+test zlib-11.2 "Bug #3390073: mis-appled gzip filtering" -setup {
+    set file [makeFile {} test.input]
+} -constraints zlib -body {
+    set f [open $file wb]
+    puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
+	[string repeat "hello" 1000]
+    close $f
+    set f [open $file rb]
+    set d [read $f]
+    close $f
+    set d [zlib gunzip $d -header h]
+    list [regexp -all "hello" $d] [dict get $h filename] \
+	[string length [regsub -all "hello" $d {}]]
+} -cleanup {
+    removeFile $file
+} -result {1000 /foo/bar 0}
+test zlib-11.3 {Bug 3595576 variant} -setup {
+    set file [makeFile {} test.input]
+} -constraints zlib -body {
+    set f [open $file wb]
+    puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
+	[string repeat "hello" 1000]
+    close $f
+    set f [open $file rb]
+    set d [read $f]
+    close $f
+    zlib gunzip $d -header noSuchNs::foo
+} -cleanup {
+    removeFile $file
+} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist}
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End: