Plug most memory leaks in thread.test.

2 files changed, 29 insertions, 16 deletions

diff --git a/ChangeLog b/ChangeLog
index d93002a..2691e4d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,12 @@
 2011-09-15  Don Porter  <dgp@users.sourceforge.net>
 
+	* tests/thread.test:	Plug most memory leaks in thread.test  Constrain
+	the rest to be skipped during `make valgrind`.  Tests using the
+	[testthread cancel] testing command are leaky.  Corrections wait for
+	either addition of [thread::cancel] to the Thread package, or improvements
+	to the [testthread] testing command to make leak-free versions of these
+	tests possible.
+
 	* generic/tclIORChan.c:	Plug all memory leaks in ioCmd.test exposed
 	* tests/ioCmd.test:	by `make valgrind`.
 	* unix/Makefile.in:
diff --git a/tests/thread.test b/tests/thread.test
index 6cd4b5d..e818388 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -21,8 +21,14 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 testConstraint testthread [expr {[info commands testthread] != {}}]
 testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}]
 
+testConstraint notValgrind [expr {![testConstraint valgrind]}]
+
 if {[testConstraint testthread]} {
     testthread errorproc ThreadError
+}
+if {[testConstraint thread]} {
+    thread::errorproc ThreadError
+}
 
     proc ThreadError {id info} {
 	global threadId threadError
@@ -33,7 +39,6 @@ if {[testConstraint testthread]} {
     proc ThreadNullError {id info} {
 	# ignore
     }
-}
 
 
 test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
@@ -852,7 +857,7 @@ test thread-7.23 {cancel: slave interp -unwind} {testthread} {
 	      [expr {[info exists ::threadError] ? \
 		  [lindex [split $::threadError \n] 0] : "" }]
 } {{} 1 1 {eval unwound}}
-test thread-7.24 {cancel: nested catch inside pure bytecode loop} {testthread} {
+test thread-7.24 {cancel: nested catch inside pure bytecode loop} {notValgrind testthread} {
     threadReap
     unset -nocomplain ::threadError ::threadId ::threadIdStarted
     set serverthread [testthread create -joinable {
@@ -894,7 +899,7 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {testthread} {
 	      [expr {[info exists ::threadError] ? \
 		  [lindex [split $::threadError \n] 0] : "" }]
 } {{} 1 0 {}}
-test thread-7.25 {cancel: nested catch inside pure inside-command loop} {testthread} {
+test thread-7.25 {cancel: nested catch inside pure inside-command loop} {notValgrind testthread} {
     threadReap
     unset -nocomplain ::threadError ::threadId ::threadIdStarted
     set serverthread [testthread create -joinable {
@@ -938,28 +943,29 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {testthr
 	      [expr {[info exists ::threadError] ? \
 		  [lindex [split $::threadError \n] 0] : "" }]
 } {{} 1 0 {}}
-test thread-7.26 {cancel: send async cancel bad interp path} {testthread} {
-    threadReap
-    unset -nocomplain ::threadError ::threadId ::threadIdStarted
-    set serverthread [testthread create -joinable {
+test thread-7.26 {cancel: send async cancel bad interp path} {thread} {
+    unset -nocomplain ::threadIdStarted
+    set serverthread [thread::create -preserved \
+	[string map [list MAIN [thread::id]] {
 	proc foobar {} {
 	    while {1} {
 		if {![info exists foo]} then {
 		    # signal the primary thread that we are ready
 		    # to be canceled now (we are running).
-		    testthread send [testthread id -main] \
-			    [list set ::threadIdStarted [testthread id]]
+		    thread::send MAIN \
+			    [list set ::threadIdStarted [thread::id]]
 		    set foo 1
 		}
 		update
 	    }
 	}
 	foobar
-    }]
+    }]]
     # wait for other thread to signal "ready to cancel"
     vwait ::threadIdStarted; after 1000
-    catch {testthread send $serverthread {interp cancel -- bad}} msg
-    threadReap
+    catch {thread::send $serverthread {interp cancel -- bad}} msg
+    thread::send -async $serverthread {interp cancel -unwind}
+    thread::release -wait $serverthread
     list [expr {[info exists ::threadIdStarted] ? \
 		  $::threadIdStarted == $serverthread : 0}] \
 		  $msg
@@ -999,7 +1005,7 @@ test thread-7.27 {cancel: send async cancel -- switch} {testthread} {
 	      [expr {[info exists ::threadError] ? \
 		  [lindex [split $::threadError \n] 0] : "" }]
 } {{} 1 1 {eval canceled}}
-test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {testthread} {
+test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {notValgrind testthread} {
     threadReap
     unset -nocomplain ::threadError ::threadId ::threadIdStarted
     set serverthread [testthread create -joinable {
@@ -1041,7 +1047,7 @@ test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode lo
 	      [expr {[info exists ::threadError] ? \
 		  [lindex [split $::threadError \n] 0] : "" }]
 } {{} 1 0 {}}
-test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {testthread} {
+test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {notValgrind testthread} {
     threadReap
     unset -nocomplain ::threadError ::threadId ::threadIdStarted
     set serverthread [testthread create -joinable {
@@ -1085,7 +1091,7 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo
 	      [expr {[info exists ::threadError] ? \
 		  [lindex [split $::threadError \n] 0] : "" }]
 } {{} 1 0 {}}
-test thread-7.30 {cancel: send async testthread cancel nested catch inside pure bytecode loop} {testthread} {
+test thread-7.30 {cancel: send async testthread cancel nested catch inside pure bytecode loop} {notValgrind testthread} {
     threadReap
     unset -nocomplain ::threadError ::threadId ::threadIdStarted
     set serverthread [testthread create -joinable {
@@ -1127,7 +1133,7 @@ test thread-7.30 {cancel: send async testthread cancel nested catch inside pure
 	      [expr {[info exists ::threadError] ? \
 		  [lindex [split $::threadError \n] 0] : "" }]
 } {{} 1 0 {}}
-test thread-7.31 {cancel: send async testthread cancel nested catch pure inside-command loop} {testthread} {
+test thread-7.31 {cancel: send async testthread cancel nested catch pure inside-command loop} {notValgrind testthread} {
     threadReap
     unset -nocomplain ::threadError ::threadId ::threadIdStarted
     set serverthread [testthread create -joinable {