From 2806530fd57fcf8fdf0f65ef7b2778bcadfaa8ed Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Wed, 23 Apr 2008 15:44:37 +0000
Subject: Assorted improvements to make better use of tcltest2

---
 tests/chanio.test |  95 +++++++++--------
 tests/cmdAH.test  | 252 ++++++++++++++++++++++----------------------
 tests/result.test |   8 +-
 tests/subst.test  |  95 +++++++++--------
 tests/timer.test  | 308 +++++++++++++++++++++++++++++-------------------------
 tests/unload.test |  44 ++++----
 6 files changed, 417 insertions(+), 385 deletions(-)

diff --git a/tests/chanio.test b/tests/chanio.test
index e79cb97..6e8fb44 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -13,7 +13,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: chanio.test,v 1.11 2008/04/15 18:34:48 andreas_kupries Exp $
+# RCS: @(#) $Id: chanio.test,v 1.12 2008/04/23 15:44:37 dkf Exp $
 
 if {[catch {package require tcltest 2}]} {
     chan puts stderr "Skipping tests in [info script].  tcltest 2 required."
@@ -182,8 +182,6 @@ test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
     chan puts -nonewline $f $data
     chan close           $f
     lappend sizes [file size $path(test2)]
-
-    set sizes
 } {19 19 19 19 19}
 
 test chan-io-2.1 {WriteBytes} {
@@ -1700,40 +1698,44 @@ file1
 } {file2
 }}
 catch {interp delete z}
-test chan-io-14.5 {Tcl_GetChannel: stdio name translation} {
+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
-    set result [list $msg1 $msg2 $msg3]
+    list $msg1 $msg2 $msg3
+} -cleanup {
     interp delete z
-    set result
-} {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
-test chan-io-14.6 {Tcl_GetChannel: stdio name translation} {
+} -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
-    set result [list $msg1 $msg2 $msg3]
+    list $msg1 $msg2 $msg3
+} -cleanup {
     interp delete z
-    set result
-} {{} {} {can not find channel named "stdout"}}
-test chan-io-14.7 {Tcl_GetChannel: stdio name translation} {
+} -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
-    set result [list $msg1 $msg2 $msg3]
+    list $msg1 $msg2 $msg3
+} -cleanup {
     interp delete z
-    set result
-} {{} {} {can not find channel named "stderr"}}
+} -result {{} {} {can not find channel named "stderr"}}
 set path(script) [makeFile {} script]
-test chan-io-14.8 {reuse of stdio special channels} {stdio openpipe} {
+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
@@ -1752,10 +1754,11 @@ test chan-io-14.8 {reuse of stdio special channels} {stdio openpipe} {
     set c [chan gets $f]
     chan close $f
     set c
-} hello
-test chan-io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
+} -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]
@@ -1770,14 +1773,15 @@ test chan-io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
     set f [open "|[list [interpreter] $path(script) [array get path]]" r]
     set c [chan gets $f]
     chan close $f
+    set c
+} -cleanup {
     # 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 10000
     file delete $path(script)
     file delete $path(test1)
-    set c
-} hello
+} -result hello
 
 test chan-io-15.1 {Tcl_CreateChan CloseHandler} emptyTest {
 } {}
@@ -1802,7 +1806,6 @@ test chan-io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchan
     lappend l [expr [testchannel refcount stdin] - $l1]
     interp delete x
     lappend l [expr [testchannel refcount stdin] - $l1]
-    set l
 } {0 1 0}
 test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
     set l1 [testchannel refcount stdout]
@@ -1814,7 +1817,6 @@ test chan-io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchan
     lappend l [expr [testchannel refcount stdout] - $l1]
     interp delete x
     lappend l [expr [testchannel refcount stdout] - $l1]
-    set l
 } {0 1 0}
 test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
     set l1 [testchannel refcount stderr]
@@ -1826,12 +1828,12 @@ test chan-io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchan
     lappend l [expr [testchannel refcount stderr] - $l1]
     interp delete x
     lappend l [expr [testchannel refcount stderr] - $l1]
-    set l
 } {0 1 0}
 
-test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
+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
@@ -1840,12 +1842,13 @@ test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
     } else {
 	lappend l "very broken: $f found after being chan closed"
     }
-    string compare [string tolower $l] \
-	[list 1 [format "can not find channel named \"%s\"" $f]]
-} 0
-test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
+    string equal [string tolower $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
@@ -1861,12 +1864,13 @@ test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
     } else {
 	lappend l "very broken: $f found after being chan closed"
     }
-    string compare [string tolower $l] \
-	[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
-} 0
-test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
+    string equal [string tolower $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
@@ -1880,9 +1884,9 @@ test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
     } else {
 	lappend l "very broken: $f found after being chan closed"
     }
-    string compare [string tolower $l] \
-	[list 1 2 1 [format "can not find channel named \"%s\"" $f]]
-} 0
+    string equal [string tolower $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
@@ -1894,13 +1898,14 @@ test chan-io-19.2 {testing Tcl_GetChannel, user opened handle} {
     chan close $f
     set x
 } 0
-test chan-io-19.3 {Tcl_GetChannel, channel not found} {
-    list [catch {chan eof file34} msg] $msg
-} {1 {can not find channel named "file34"}}
-test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel} {
+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 f [open $path(test1) w]
     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]} {
@@ -1908,19 +1913,19 @@ test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel
     } else {
 	lappend l "very broken: $f found after being chan closed"
     }
-    string compare [string tolower $l] \
-	[list 0 [format "can not find channel named \"%s\"" $f]]
-} 0
+    string equal [string tolower $l] \
+	[list 0 "can not find channel named \"$f\""]
+} -result 1
 
 test chan-io-20.1 {Tcl_CreateChannel: initial settings} {
-	set a [open $path(test2) w]
+    set a [open $path(test2) w]
     set old [encoding system]
     encoding system ascii
     set f [open $path(test1) w]
     set x [chan configure $f -encoding]
     chan close $f
     encoding system $old
-	chan close $a
+    chan close $a
     set x
 } {ascii}    
 test chan-io-20.2 {Tcl_CreateChannel: initial settings} {win} {
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 44316c5..79d7b4f 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: cmdAH.test,v 1.57 2007/12/13 15:26:06 dgp Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.58 2008/04/23 15:44:37 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -30,75 +30,89 @@ 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"}}
+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-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.7 {cd} -constraints {unix nonPortable} -setup {
+    set dir [pwd]
+} -body {
+    cd /
+    pwd
+} -cleanup {
+    cd $dir
+} -result {/}
 
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
     concat
@@ -110,99 +124,98 @@ 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, dirs, 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 option ?arg ...?"}
+test cmdAH-5.2 {Tcl_FileObjCmd} -returnCodes error -body {
+    file x
+} -result {bad option "x": must be atime, attributes, channels, copy, delete, dirname, executable, exists, extension, isdirectory, isfile, join, link, lstat, mtime, mkdir, nativename, normalize, owned, pathtype, readable, readlink, rename, rootname, separator, size, split, stat, system, tail, 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
-
-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}
+    file exists ""
+} 0
+
+# 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} {unix} {
     set volumeList [file volumes]
     catch [list glob -nocomplain [lindex $volumeList 0]*]
@@ -212,28 +225,19 @@ test cmdAH-6.4 {Tcl_FileObjCmd: volumes} win {
     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
-} {/}
-
 # 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}]
+    catch {file attributes $foofile}
+} -cleanup {
     # We used [makeFile] so we undo with [removeFile]
     removeFile $foofile
-    set res
-} {0}
+} -result {0}
 
 # dirname
-
 test cmdAH-8.1 {Tcl_FileObjCmd: dirname} testsetplatform {
     testsetplatform unix
     list [catch {file dirname a b} msg] $msg
diff --git a/tests/result.test b/tests/result.test
index cefcaed..95407b9 100644
--- a/tests/result.test
+++ b/tests/result.test
@@ -49,7 +49,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
 
@@ -60,9 +59,9 @@ 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}
@@ -133,7 +132,6 @@ test result-6.2 {Bug 1649062} -setup {
     rename foo {}
 } -result {foo {} {}}
 
-
 # cleanup
 cleanupTests
 return
diff --git a/tests/subst.test b/tests/subst.test
index a336c1b..a7d6feb 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -11,19 +11,19 @@
 # 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 $
+# RCS: @(#) $Id: subst.test,v 1.19 2008/04/23 15:44:38 dkf 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 +56,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 +71,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 +114,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 +160,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 +228,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,24 +243,24 @@ 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}
 
 # cleanup
 ::tcltest::cleanupTests
diff --git a/tests/timer.test b/tests/timer.test
index 6eecb7c..16eff33 100644
--- a/tests/timer.test
+++ b/tests/timer.test
@@ -13,30 +13,36 @@
 # 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.12 2005/11/09 21:28:36 kennykb Exp $
+# RCS: @(#) $Id: timer.test,v 1.13 2008/04/23 15:44:38 dkf 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 +51,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 +66,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 +85,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 +135,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 +153,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 +168,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 +184,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 {bad argument "2x": must be cancel, idle, info, or an integer}}
-test timer-6.3 {Tcl_AfterCmd procedure, basics} {
-    list [catch {after gorp} msg] $msg
-} {1 {bad argument "gorp": must be cancel, idle, info, or an integer}}
+test timer-6.1 {Tcl_AfterCmd procedure, basics} -returnCodes error -body {
+    after
+} -result {wrong # args: should be "after option ?arg 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 +215,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 +264,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 +277,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 +291,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 +305,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 +322,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 +342,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 +350,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 +501,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 +517,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 +535,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 +544,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 +566,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,29 +581,22 @@ 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
-	set 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
-	set l
-    } \
-    -result {-1 100}
-
+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
diff --git a/tests/unload.test b/tests/unload.test
index d26f012..761f05c 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -11,7 +11,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: unload.test,v 1.6 2006/12/17 03:47:08 das Exp $
+# RCS: @(#) $Id: unload.test,v 1.7 2008/04/23 15:44:38 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
@@ -41,27 +41,27 @@ set alreadyTotalLoaded [info loaded]
 testConstraint teststaticpkg [llength [info commands teststaticpkg]]
 
 # 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 ?switches? fileName ?packageName? ?interp?"}
+test unload-1.2 {basic errors} -returnCodes error -body {
+    unload a b c d
+} -result {wrong # args: should be "unload ?switches? 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 {}
-- 
cgit v0.12