moved the ThreadReap command to ::tcltest::threadReap. Now each thread test calls

threadReap at the beginning and end of the test, inside the test body.  This fixes
the problem where the test suite was exiting on a call to threadReap (reap was
killing the main thread by accident because other tests were leaving threads
running and setting mainthread to be the list of running threads).

4 files changed, 192 insertions, 109 deletions

diff --git a/tests/README b/tests/README
index fe4bb30..3b22393 100644
--- a/tests/README
+++ b/tests/README
@@ -1,6 +1,6 @@
 README -- Tcl test suite design document.
 
-RCS: @(#) $Id: README,v 1.3 1999/04/16 00:47:22 stanton Exp $
+RCS: @(#) $Id: README,v 1.4 1999/04/20 18:12:18 hershey Exp $
 
 Contents:
 ---------
@@ -117,6 +117,8 @@ namespace and automatically imported:
 
     restoreState      Restore the procedure and global variable names.
 
+    threadReap	      Kill all threads except for the main thread.
+
 Please refer to the defs.tcl file for more documentation on these
 procedures.
 
diff --git a/tests/defs.tcl b/tests/defs.tcl
index 1e7d8fc..727c787 100644
--- a/tests/defs.tcl
+++ b/tests/defs.tcl
@@ -11,23 +11,27 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 # 
-# RCS: @(#) $Id: defs.tcl,v 1.2 1999/04/16 00:47:26 stanton Exp $
+# RCS: @(#) $Id: defs.tcl,v 1.3 1999/04/20 18:12:18 hershey Exp $
 
 # Initialize wish shell
+
 if {[info exists tk_version]} {
     tk appname tktest
     wm title . tktest
 } else {
+
     # Ensure that we have a minimal auto_path so we don't pick up extra junk.
+
     set auto_path [list [info library]]
 }
 
 # create the "tcltest" namespace for all testing variables and procedures
+
 namespace eval tcltest {
     set procList [list test cleanupTests dotests saveState restoreState \
 	    normalizeMsg makeFile removeFile makeDirectory removeDirectory \
 	    viewFile bytestring set_iso8859_1_locale restore_locale \
-	    safeFetch]
+	    safeFetch threadReap]
     if {[info exists tk_version]} {
 	lappend procList setupbg dobg bgReady cleanupbg fixfocus
     }
@@ -36,12 +40,15 @@ namespace eval tcltest {
     }
 
     # ::tcltest::verbose defaults to "b"
+
     variable verbose "b"
 
     # match defaults to the empty list
+
     variable match {}
 
     # skip defaults to the empty list
+
     variable skip {}
 
     # Tests should not rely on the current working directory.
@@ -77,15 +84,22 @@ namespace eval tcltest {
 
     # ::tcltest::numTests will store test files as indices and the list
     # of files (that should not have been) left behind by the test files.
+
     array set ::tcltest::createdNewFiles {}
 
     # initialize ::tcltest::numTests array to keep track fo the number of
     # tests that pass, fial, and are skipped.
+
     array set numTests [list Total 0 Passed 0 Skipped 0 Failed 0]
 
     # initialize ::tcltest::skippedBecause array to keep track of
     # constraints that kept tests from running
+
     array set ::tcltest::skippedBecause {}
+
+    # tests that use thread need to know which is the main thread
+
+    set ::tcltest::mainThread [testthread names]
 }
 
 # If there is no "memory" command (because memory debugging isn't
@@ -169,6 +183,7 @@ proc ::tcltest::initConfig {} {
     set ::tcltest::testConfig(unixCrash) [expr {!$::tcltest::testConfig(unix)}]
 
     # Set the "fonts" constraint for wish apps
+
     if {[info exists tk_version]} {
 	set ::tcltest::testConfig(fonts) 1
 	catch {destroy .e}
@@ -191,22 +206,28 @@ proc ::tcltest::initConfig {} {
     }
 
     # Skip empty tests
+
     set ::tcltest::testConfig(emptyTest) 0
 
     # By default, tests that expost known bugs are skipped.
+
     set ::tcltest::testConfig(knownBug) 0
 
     # By default, non-portable tests are skipped.
+
     set ::tcltest::testConfig(nonPortable) 0
 
     # Some tests require user interaction.
+
     set ::tcltest::testConfig(userInteraction) 0
 
     # Some tests must be skipped if the interpreter is not in interactive mode
+
     set ::tcltest::testConfig(interactive) $tcl_interactive
 
     # Some tests must be skipped if you are running as root on Unix.
     # Other tests can only be run if you are running as root on Unix.
+
     set ::tcltest::testConfig(root) 0
     set ::tcltest::testConfig(notRoot) 1
     set user {}
@@ -223,6 +244,7 @@ proc ::tcltest::initConfig {} {
 
     # Set nonBlockFiles constraint: 1 means this platform supports
     # setting files into nonblocking mode.
+
     if {[catch {set f [open defs r]}]} {
 	set ::tcltest::testConfig(nonBlockFiles) 1
     } else {
@@ -240,6 +262,7 @@ proc ::tcltest::initConfig {} {
     # Test for SCO Unix - cannot run async flushing tests because a
     # potential problem with select is apparently interfering.
     # (Mark Diekhans).
+
     if {$tcl_platform(platform) == "unix"} {
 	if {[catch {exec uname -X | fgrep {Release = 3.2v}}] == 0} {
 	    set ::tcltest::testConfig(asyncPipeClose) 0
@@ -252,6 +275,7 @@ proc ::tcltest::initConfig {} {
 
     # Test to see if we have a broken version of sprintf with respect
     # to the "e" format of floating-point numbers.
+
     set ::tcltest::testConfig(eformat) 1
     if {[string compare "[format %g 5e-5]" "5e-05"] != 0} {
 	set ::tcltest::testConfig(eformat) 0
@@ -259,6 +283,7 @@ proc ::tcltest::initConfig {} {
 
     # Test to see if execed commands such as cat, echo, rm and so forth are
     # present on this machine.
+
     set ::tcltest::testConfig(unixExecs) 1
     if {$tcl_platform(platform) == "macintosh"} {
 	set ::tcltest::testConfig(unixExecs) 0
@@ -336,6 +361,7 @@ proc ::tcltest::processCmdLineArgs {} {
 
     # The "argv" var doesn't exist in some cases, so use {}
     # The "argv" var doesn't exist in some cases.
+
     if {(![info exists argv]) || ([llength $argv] < 2)} {
 	set flagArray {}
     } else {
@@ -351,6 +377,7 @@ proc ::tcltest::processCmdLineArgs {} {
     # Allow for 1-char abbreviations, where applicable (e.g., -match == -m).
     # Note that -verbose cannot be abbreviated to -v in wish because it
     # conflicts with the wish option -visual.
+
     foreach arg {-verbose -match -skip -constraints} {
 	set abbrev [string range $arg 0 1]
 	if {([info exists flag($abbrev)]) && \
@@ -362,22 +389,26 @@ proc ::tcltest::processCmdLineArgs {} {
 
     # Set ::tcltest::workingDir to [pwd].
     # Save the names of files that already exist in ::tcltest::workingDir.
+
     set ::tcltest::workingDir [pwd]
     foreach file [glob -nocomplain [file join $::tcltest::workingDir *]] {
 	lappend ::tcltest::filesExisted [file tail $file]
     }
 
     # Set ::tcltest::verbose to the arg of the -verbose flag, if given
+
     if {[info exists flag(-verbose)]} {
 	set ::tcltest::verbose $flag(-verbose)
     }
 
     # Set ::tcltest::match to the arg of the -match flag, if given
+
     if {[info exists flag(-match)]} {
 	set ::tcltest::match $flag(-match)
     }
 
     # Set ::tcltest::skip to the arg of the -skip flag, if given
+
     if {[info exists flag(-skip)]} {
 	set ::tcltest::skip $flag(-skip)
     }
@@ -385,6 +416,7 @@ proc ::tcltest::processCmdLineArgs {} {
     # Use the -constraints flag, if given, to turn on constraints that are
     # turned off by default: userInteractive knownBug nonPortable.  This
     # code fragment must be run after constraints are initialized.
+
     if {[info exists flag(-constraints)]} {
 	foreach elt $flag(-constraints) {
 	    set ::tcltest::testConfig($elt) 1
@@ -414,6 +446,7 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
     # ::tcltest::makeDirectory procedures.
     # Record the names of files in ::tcltest::workingDir that were not
     # pre-existing, and associate them with the test file that created them.
+
     if {!$calledFromAllFile} {
 
 	foreach file $::tcltest::filesMade {
@@ -438,7 +471,9 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
     }
 
     if {$calledFromAllFile || $::tcltest::testSingleFile} {
+
 	# print stats
+
 	puts -nonewline stdout "$tail:"
 	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
 	    puts -nonewline stdout "\t$index\t$::tcltest::numTests($index)"
@@ -447,6 +482,7 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 
 	# print number test files sourced
 	# print names of files that ran tests which failed
+
 	if {$calledFromAllFile} {
 	    puts stdout "Sourced $::tcltest::numTestFiles Test Files."
 	    set ::tcltest::numTestFiles 0
@@ -458,6 +494,7 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 
 	# if any tests were skipped, print the constraints that kept them
 	# from running.
+
 	set constraintList [array names ::tcltest::skippedBecause]
 	if {[llength $constraintList] > 0} {
 	    puts stdout "Number of tests skipped for each constraint:"
@@ -470,6 +507,7 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 
 	# report the names of test files in ::tcltest::createdNewFiles, and
 	# reset the array to be empty.
+
 	set testFilesThatTurded [lsort [array names ::tcltest::createdNewFiles]]
 	if {[llength $testFilesThatTurded] > 0} {
 	    puts stdout "Warning: test files left files behind:"
@@ -480,20 +518,24 @@ proc ::tcltest::cleanupTests {{calledFromAllFile 0}} {
 	}
 
 	# reset filesMade, filesExisted, and numTests
+
 	set ::tcltest::filesMade {}
 	foreach index [list "Total" "Passed" "Skipped" "Failed"] {
 	    set ::tcltest::numTests($index) 0
 	}
 
 	# exit only if running Tk in non-interactive mode
+
 	global tk_version tcl_interactive
 	if {[info exists tk_version] && !$tcl_interactive} {
 	    exit
 	}
     } else {
+
 	# if we're deferring stat-reporting until all files are sourced,
 	# then add current file to failFile list if any tests in this file
 	# failed
+
 	incr ::tcltest::numTestFiles
 	if {($::tcltest::currentFailure) && \
 		([lsearch -exact $::tcltest::failFiles $tail] == -1)} {
@@ -531,6 +573,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
     incr ::tcltest::numTests(Total)
 
     # skip the test if it's name matches an element of skip
+
     foreach pattern $::tcltest::skip {
 	if {[string match $pattern $name]} {
 	    incr ::tcltest::numTests(Skipped)
@@ -538,6 +581,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 	}
     }
     # skip the test if it's name doesn't match any element of match
+
     if {[llength $::tcltest::match] > 0} {
 	set ok 0
 	foreach pattern $::tcltest::match {
@@ -555,6 +599,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
     if {$i == 0} {
 	set constraints {}
     } elseif {$i == 1} {
+
 	# "constraints" argument exists;  shuffle arguments down, then
 	# make sure that the constraints are satisfied.
 
@@ -563,10 +608,13 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 	set expectedAnswer [lindex $args 0]
 	set doTest 0
 	if {[string match {*[$\[]*} $constraints] != 0} {
+
 	    # full expression, e.g. {$foo > [info tclversion]}
 
 	    catch {set doTest [uplevel #0 expr $constraints]}
+
 	} elseif {[regexp {[^.a-zA-Z0-9 ]+} $constraints] != 0} {
+
 	    # something like {a || b} should be turned into 
 	    # $::tcltest::testConfig(a) || $::tcltest::testConfig(b).
 
@@ -574,6 +622,7 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 		    {$::tcltest::testConfig(&)} c
 	    catch {set doTest [eval expr $c]}
 	} else {
+
 	    # just simple constraints such as {unixOnly fonts}.
 
 	    set doTest 1
@@ -581,7 +630,9 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 		if {![info exists ::tcltest::testConfig($constraint)]
 			|| !$::tcltest::testConfig($constraint)} {
 		    set doTest 0
+
 		    # store the constraint that kept the test from running
+
 		    set constraints $constraint
 		    break
 		}
@@ -592,8 +643,10 @@ proc ::tcltest::test {name description script expectedAnswer args} {
 	    if {[string first s $::tcltest::verbose] != -1} {
 		puts stdout "++++ $name SKIPPED: $constraints"
 	    }
+
 	    # add the constraint to the list of constraints the kept tests
 	    # from running
+
 	    if {[info exists ::tcltest::skippedBecause($constraints)]} {
 		incr ::tcltest::skippedBecause($constraints)
 	    } else {
@@ -821,6 +874,7 @@ catch {file delete -force tmp}
 
 # Deliberately call the socket with the wrong number of arguments.  The error
 # message you get will indicate whether sockets are available on this system.
+
 catch {socket} msg
 set ::tcltest::testConfig(socket) \
 	[expr {$msg != "sockets are not available on this system"}]
@@ -828,11 +882,14 @@ set ::tcltest::testConfig(socket) \
 #
 # Internationalization / ISO support procs     -- dl
 #
+
 if {[info commands testlocale]==""} {
+
     # No testlocale command, no tests...
     # (it could be that we are a sub interp and we could just load
     # the Tcltest package but that would interfere with tests
     # that tests packages/loading in slaves...)
+
     set ::tcltest::testConfig(hasIsoLocale) 0
 } else {
     proc ::tcltest::set_iso8859_1_locale {} {
@@ -848,7 +905,9 @@ if {[info commands testlocale]==""} {
 	set ::tcltest::isoLocale fr
         switch $tcl_platform(platform) {
 	    "unix" {
+
 		# Try some 'known' values for some platforms:
+
 		switch -exact -- $tcl_platform(os) {
 		    "FreeBSD" {
 			set ::tcltest::isoLocale fr_FR.ISO_8859-1
@@ -861,9 +920,11 @@ if {[info commands testlocale]==""} {
 			set ::tcltest::isoLocale fr
 		    }
 		    default {
+
 			# Works on SunOS 4 and Solaris, and maybe others...
 			# define it to something else on your system
 			#if you want to test those.
+
 			set ::tcltest::isoLocale iso_8859_1
 		    }
 		}
@@ -882,7 +943,9 @@ if {[info commands testlocale]==""} {
 #
 # procedures that are Tk specific
 #
+
 if {[info exists tk_version]} {
+
     # If the main window isn't already mapped (e.g. because the tests are
     # being run automatically) , specify a precise size for it so that the
     # user won't have to position it manually.
@@ -934,6 +997,7 @@ if {[info exists tk_version]} {
     
     # Send a command to the background process, catching errors and
     # flushing I/O channels
+
     proc ::tcltest::dobg {command} {
 	puts $::tcltest::fd "catch [list $command] msg; update; puts \$msg; puts **DONE**; flush stdout"
 	flush $::tcltest::fd
@@ -946,6 +1010,7 @@ if {[info exists tk_version]} {
     # Data arrived from background process.  Check for special marker
     # indicating end of data for this command, and make data available
     # to dobg procedure.
+
     proc ::tcltest::bgReady {} {
 	set x [gets $::tcltest::fd]
 	if {[eof $::tcltest::fd]} {
@@ -959,6 +1024,7 @@ if {[info exists tk_version]} {
     }
 
     # Exit the background process, and close the pipes
+
     proc ::tcltest::cleanupbg {} {
 	catch {
 	    puts $::tcltest::fd "exit"
@@ -984,7 +1050,32 @@ if {[info exists tk_version]} {
     }
 }
 
+# threadReap --
+#
+#	Kill all thread except for the main thread.
+#
+# Arguments:
+#	none.
+#
+# Results:
+#	Returns the number of existing threads.
+
+proc ::tcltest::threadReap {} {
+    testthread errorproc ThreadNullError
+    while {[llength [testthread names]] > 1} {
+	foreach tid [testthread names] {
+	    if {$tid != $::tcltest::mainThread} {
+		catch {testthread send -async $tid {testthread exit}}
+		update
+	    }
+	}
+    }
+    testthread errorproc ThreadError
+    return [llength [testthread names]]
+}
+
 # Need to catch the import because it fails if defs.tcl is sourced
 # more than once.
+
 catch {namespace import ::tcltest::*}
 return
diff --git a/tests/socket.test b/tests/socket.test
index 249dc5e..8ca46ff 100644
--- a/tests/socket.test
+++ b/tests/socket.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: socket.test,v 1.7 1999/04/16 00:47:34 stanton Exp $
+# RCS: @(#) $Id: socket.test,v 1.8 1999/04/20 18:12:18 hershey Exp $
 
 # Running socket tests with a remote server:
 # ------------------------------------------
@@ -1579,26 +1579,10 @@ test socket-12.3 {testing inheritance of accepted sockets} \
 test socket-13.1 {Testing use of shared socket between two threads} \
 	{socket testthread} {
 
-    set mainthread [testthread names]
-    proc ThreadReap {} {
-	global mainthread
-	testthread errorproc ThreadNullError
-	while {[llength [testthread names]] > 1} {
-	    foreach tid [testthread names] {
-		if {$tid != $mainthread} {
-		    catch {testthread send -async $tid {testthread exit}}
-		    update
-		}
-	    }
-	}
-	testthread errorproc ThreadError
-	return [llength [testthread names]]
-    }
-
     removeFile script
+    threadReap
 
-    set f [open script w]
-    puts $f {
+    makeFile {
 	set f [socket -server accept 2828]
 	proc accept {s a p} {
             fileevent $s readable [list echo $s]
@@ -1622,16 +1606,16 @@ test socket-13.1 {Testing use of shared socket between two threads} \
 
 	# thread cleans itself up.
 	testthread exit
-    }
-    close $f
+    } script
     
     # create a thread
     set serverthread [testthread create { source script } ]
     update
     
-
+    after 1000
     set s [socket 127.0.0.1 2828]
     fconfigure $s -buffering line
+
     catch {
 	puts $s "hello"
 	gets $s result
@@ -1640,11 +1624,11 @@ test socket-13.1 {Testing use of shared socket between two threads} \
     update
 
     after 2000
-    ThreadReap
+    lappend result [threadReap]
     
     set result
 
-} hello
+} {hello 1}
 
 # cleanup
 if {[string match sock* $commandSocket] == 1} {
diff --git a/tests/thread.test b/tests/thread.test
index b3051ed..0780e7a 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -10,62 +10,55 @@
 # 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.2 1999/04/16 00:47:35 stanton Exp $
+# RCS: @(#) $Id: thread.test,v 1.3 1999/04/20 18:12:19 hershey Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
 }
 
-if {[info command testthread] == ""} {
-    puts "skipping: tests require the testthread command"
-    ::tcltest::cleanupTests
-    return
-}
+# Some tests require the testthread command
+
+set ::tcltest::testConfig(testthread) \
+	[expr {[info commands testthread] != {}}]
+
+if {$::tcltest::testConfig(testthread)} {
 
-set mainthread [testthread names]
-proc ThreadReap {} {
-    global mainthread
-    testthread errorproc ThreadNullError
-    while {[llength [testthread names]] > 1} {
-	foreach tid [testthread names] {
-	    if {$tid != $mainthread} {
-		catch {testthread send -async $tid {testthread exit}}
-		update
-	    }
-	}
-    }
     testthread errorproc ThreadError
-    return [llength [testthread names]]
-}
-testthread errorproc ThreadError
-proc ThreadError {id info} {
-    global threadError
-    set threadError $info
-}
-proc ThreadNullError {id info} {
-    # ignore
+
+    proc ThreadError {id info} {
+	global threadError
+	set threadError $info
+    }
+
+    proc ThreadNullError {id info} {
+	# ignore
+    }
 }
 
-test thread-1.1 {Tcl_ThreadObjCmd: no args} {
+
+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} {
+test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
     list [catch {testthread foo} msg] $msg
 } {1 {bad option "foo": must be create, exit, id, names, send, wait, or errorproc}}
 
-test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {
-    list [catch {testthread names} mainthread] [llength $mainthread]
-} {0 1}
+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 } {
+test thread-1.4 {Tcl_ThreadObjCmd: thread create } {testthread} {
+    threadReap
     set serverthread [testthread create]
     update
     set numthreads [llength [testthread names]]
+    threadReap
+    set numthreads
 } {2}
-ThreadReap
 
-test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {
+test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {testthread} {
+    threadReap
     testthread create {set x 5}
     foreach try {0 1 2 4 5 6} {
 	# Try various ways to yeild
@@ -76,72 +69,76 @@ test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {
 	    break
 	}
     }
+    threadReap
     set l
 } {1}
-ThreadReap
 
-test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {
+test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {testthread} {
+    threadReap
     testthread create {testthread exit}
     update
     after 10
-    llength [testthread names]
+    set result [llength [testthread names]]
+    threadReap
+    set result
 } {1}
-ThreadReap
 
-test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {
+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} {
-    string compare [testthread id] $mainthread
+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} {
+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} {
-    string compare [testthread names] $mainthread
+test thread-1.10 {Tcl_ThreadObjCmd: thread id} {testthread} {
+    string compare [testthread names] $::tcltest::mainThread
 } {0}
 
-test thread-1.11 {Tcl_ThreadObjCmd: send args} {
+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} {
+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} {
+test thread-1.13 {Tcl_ThreadObjCmd: send args} {testthread} {
+    threadReap
     set serverthread [testthread create]
     set five [testthread send $serverthread {set x 5}]
-    ThreadReap
+    threadReap
     set five
 } 5
 
-test thread-1.14 {Tcl_ThreadObjCmd: send bad id} {
-    set tid [expr $mainthread + 10]
+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} {
+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
+    threadReap
     set five
 } 5
 
-test thread-1.16 {Tcl_ThreadObjCmd: errorproc args} {
+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} {
+test thread-1.17 {Tcl_ThreadObjCmd: errorproc change} {testthread} {
     testthread errorproc foo
     testthread errorproc ThreadError
 } {}
@@ -151,30 +148,34 @@ test thread-1.17 {Tcl_ThreadObjCmd: errorproc change} {
 # NewThread, safe and regular
 # ThreadErrorProc, except for printing to standard error
 
-test thread-2.1 {ListUpdateInner and ListRemove} {
+test thread-2.1 {ListUpdateInner and ListRemove} {testthread} {
+    threadReap
     catch {unset tid}
     foreach t {0 1 2} {
 	upvar #0 t$t tid
 	set tid [testthread create]
     }
-    ThreadReap
+    threadReap
 } 1
 
-test thread-3.1 {TclThreadList} {
+test thread-3.1 {TclThreadList} {testthread} {
+    threadReap
     catch {unset tid}
-    set mainthread [testthread names]
+    set len [llength [testthread names]]
     set l1  {}
     foreach t {0 1 2} {
 	lappend l1 [testthread create]
     }
     set l2 [testthread names]
     list $l1 $l2
-    set c [string compare [lsort -integer [concat $mainthread $l1]] [lsort -integer $l2]]
-    ThreadReap
-    set c
-} 0
-
-test thread-4.1 {TclThreadSend to self} {
+    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} {
     catch {unset x}
     testthread send [testthread id] {
 	set x 4
@@ -182,8 +183,9 @@ test thread-4.1 {TclThreadSend to self} {
     set x
 } {4}
 
-test thread-4.1 {TclThreadSend -async} {
-    set mainthread [testthread names]
+test thread-4.2 {TclThreadSend -async} {testthread} {
+    threadReap
+    set len [llength [testthread names]]
     set serverthread [testthread create]
     testthread send -async $serverthread {
 	after 1000
@@ -192,36 +194,40 @@ test thread-4.1 {TclThreadSend -async} {
     set two [llength [testthread names]]
     after 1500 {set done 1}
     vwait done
-    list [llength [testthread names]] $two
-} {1 2}
+    threadReap
+    list $len [llength [testthread names]] $two
+} {1 1 2}
 
-test thread-4.2 {TclThreadSend preserve errorInfo} {
-    set mainthread [testthread names]
+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]
-    list $x $msg $errorInfo
-} {1 {can't read "undef": no such variable} {can't read "undef": no such variable
+    threadReap
+    list $len $x $msg $errorInfo
+} {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}"}}
-ThreadReap
 
-test thread-4.3 {TclThreadSend preserve code} {
-    set mainthread [testthread names]
+test thread-4.4 {TclThreadSend preserve code} {testthread} {
+    threadReap
+    set len [llength [testthread names]]
     set serverthread [testthread create]
     set x [catch {testthread send $serverthread {break}} msg]
-    list $x $msg $errorInfo
-} {3 {} {}}
-ThreadReap
+    threadReap
+    list $len $x $msg $errorInfo
+} {1 3 {} {}}
 
-test thread-4.4 {TclThreadSend preserve errorCode} {
-    set mainthread [testthread names]
+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
 } {1 ERR CODE}
-ThreadReap
 
 # cleanup
 ::tcltest::cleanupTests