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).

1 files changed, 88 insertions, 82 deletions

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