From b1b7242607411370b9765327872a81c2e8c88513 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Fri, 23 Sep 2011 16:00:09 +0000
Subject: Stop using the deprecated thread management commands of the tcltest
 package. The test suite ought to provide these tools for itself.  They do not
 belong in a testing harness.

---
 ChangeLog         |  6 ++++++
 tests/thread.test | 40 +++++++++++++++++++++++++++++-----------
 2 files changed, 35 insertions(+), 11 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index e2a5b21..7df4cc1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,9 @@
+2011-09-23  Don Porter  <dgp@users.sourceforge.net>
+
+	* tests/thread.test:	Stop using the deprecated thread management
+	commands of the tcltest package.  The test suite ought to provide
+	these tools for itself.  They do not belong in a testing harness.
+
 2011-09-22  Don Porter  <dgp@users.sourceforge.net>
 
 	* generic/tclCmdIL.c:	Revise [info frame] so that it stops creating
diff --git a/tests/thread.test b/tests/thread.test
index 732f5fd..74f7043 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -23,23 +23,41 @@ testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}]
 
 testConstraint notValgrind [expr {![testConstraint valgrind]}]
 
-if {[testConstraint testthread]} {
-    testthread errorproc ThreadError
+proc ThreadError {id info} {
+    global threadId threadError
+    set threadId $id
+    set threadError $info
 }
+
 if {[testConstraint thread]} {
     thread::errorproc ThreadError
 }
 
-    proc ThreadError {id info} {
-	global threadId threadError
-	set threadId $id
-	set threadError $info
-    }
+if {[testConstraint testthread]} {
+    testthread errorproc ThreadError
+
+    set mainThread [testthread id]
 
     proc ThreadNullError {id info} {
 	# ignore
     }
 
+    proc threadReap {} {
+	testthread errorproc ThreadNullError
+	while {[llength [testthread names]] > 1} {
+	    foreach tid [testthread names] {
+		if {$tid != [testthread id]} {
+		    catch {
+			testthread send -async $tid {testthread exit}
+		    }
+		}
+	    }
+	    after 1
+	}
+	testthread errorproc ThreadError
+	return [llength [testthread names]]
+    }
+}
 
 test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
     list [catch {testthread} msg] $msg
@@ -80,14 +98,14 @@ test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {testthread} {
     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
+    string compare [testthread id] $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
+    string compare [testthread names] $mainThread
 } {0}
 test thread-1.11 {Tcl_ThreadObjCmd: send args} {testthread} {
     set x [catch {testthread send} msg]
@@ -104,7 +122,7 @@ test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} {
     set five
 } 5
 test thread-1.14 {Tcl_ThreadObjCmd: send bad id} {testthread} {
-    set tid [expr $::tcltest::mainThread + 10]
+    set tid [expr $mainThread + 10]
     set x [catch {testthread send $tid {set x 5}} msg]
     list $x $msg
 } {1 {invalid thread id}}
@@ -248,7 +266,7 @@ test thread-7.2 {cancel: nonint} {testthread} {
     list $x $msg
 } {1 {expected integer but got "abc"}}
 test thread-7.3 {cancel: bad id} {testthread} {
-    set tid [expr $::tcltest::mainThread + 10]
+    set tid [expr $mainThread + 10]
     set x [catch {testthread cancel $tid} msg]
     list $x $msg
 } {1 {invalid thread id}}
-- 
cgit v0.12