summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog8
-rw-r--r--tests/thread.test117
2 files changed, 75 insertions, 50 deletions
diff --git a/ChangeLog b/ChangeLog
index 7a0df64..2200e7e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2011-11-18 Joe Mistachkin <joe@mistachkin.com>
+
+ * tests/thread.test: Remove all use of thread::release from the thread
+ 7.x tests, replacing it with a script that can easily cause "stuck"
+ threads to self-destruct for those test cases that require it. Also,
+ make the error message handling far more robust by keeping track of
+ every asynchronous error.
+
2011-11-17 Joe Mistachkin <joe@mistachkin.com>
* tests/thread.test: Refactor all the remaining thread-7.x tests that
diff --git a/tests/thread.test b/tests/thread.test
index 936f725..3eef85f 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -26,10 +26,21 @@ testConstraint thread [expr {0 == [catch {package require Thread 2.7}]}]
testConstraint notValgrind [expr {![testConstraint valgrind]}]
+set threadSuperKillScript {
+ rename catch ""
+ rename while ""
+ rename update ""
+ thread::release
+}
+
+proc getThreadError { info } {
+ return [lindex [split [lindex $info 0] \n] 0]
+}
+
proc ThreadError {id info} {
global threadId threadError
set threadId $id
- set threadError $info
+ lappend threadError($id) $info
}
if {[testConstraint thread]} {
@@ -244,7 +255,7 @@ test thread-7.4 {cancel: pure bytecode loop} -constraints {thread} -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
@@ -274,7 +285,7 @@ test thread-7.5 {cancel: pure inside-command loop} -constraints {thread} -setup
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
@@ -303,7 +314,7 @@ test thread-7.6 {cancel: pure bytecode loop -unwind} -constraints {thread} -setu
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -333,7 +344,7 @@ test thread-7.7 {cancel: pure inside-command loop -unwind} -constraints thread -
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -362,7 +373,7 @@ test thread-7.8 {cancel: pure bytecode loop custom result} -constraints thread -
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {the eval was canceled}}
@@ -394,7 +405,7 @@ test thread-7.9 {cancel: pure inside-command loop custom result} -constraints {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {the eval was canceled}}
@@ -425,7 +436,7 @@ test thread-7.10 {cancel: pure bytecode loop custom result -unwind} -constraints
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {the eval was unwound}}
@@ -457,7 +468,7 @@ test thread-7.11 {cancel: pure inside-command loop custom result -unwind} -const
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {the eval was unwound}}
@@ -481,7 +492,7 @@ test thread-7.12 {cancel: after} -constraints thread -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
@@ -505,7 +516,7 @@ test thread-7.13 {cancel: after -unwind} -constraints thread -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -529,7 +540,7 @@ test thread-7.14 {cancel: vwait} -constraints thread -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
@@ -553,7 +564,7 @@ test thread-7.15 {cancel: vwait -unwind} -constraints thread -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -582,7 +593,7 @@ test thread-7.16 {cancel: expr} -constraints thread -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
@@ -610,7 +621,7 @@ test thread-7.17 {cancel: expr -unwind} -constraints thread -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -642,8 +653,8 @@ test thread-7.18 {cancel: expr bignum} {thread knownBug} {
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.19 {cancel: expr bignum -unwind} {thread knownBug} {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
@@ -673,8 +684,8 @@ test thread-7.19 {cancel: expr bignum -unwind} {thread knownBug} {
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.20 {cancel: subst} -constraints {thread} -setup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
@@ -700,7 +711,7 @@ test thread-7.20 {cancel: subst} -constraints {thread} -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
@@ -728,7 +739,7 @@ test thread-7.21 {cancel: subst -unwind} -constraints {thread} -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -756,7 +767,7 @@ test thread-7.22 {cancel: slave interp} -constraints {thread} -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
@@ -784,7 +795,7 @@ test thread-7.23 {cancel: slave interp -unwind} -constraints {thread} -setup {
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -819,13 +830,14 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread} {
vwait ::threadIdStarted; after 1000
set res [thread::cancel $serverthread]
after 1000; # wait for ThreadErrorProc to be called.
- catch {thread::release $serverthread}
+ thread::send $serverthread $::threadSuperKillScript
+ thread::join $serverthread
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread} {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
@@ -860,17 +872,18 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread}
vwait ::threadIdStarted; after 1000
set res [thread::cancel $serverthread]
after 1000; # wait for ThreadErrorProc to be called.
- catch {thread::release $serverthread}
+ thread::send $serverthread $::threadSuperKillScript
+ thread::join $serverthread
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.26 {cancel: send async cancel bad interp path} {thread} {
unset -nocomplain ::threadIdStarted
- set serverthread [thread::create -preserved \
+ set serverthread [thread::create -joinable \
[string map [list %ID% [thread::id]] {
proc foobar {} {
while {1} {
@@ -889,7 +902,7 @@ test thread-7.26 {cancel: send async cancel bad interp path} {thread} {
vwait ::threadIdStarted
catch {thread::send $serverthread {interp cancel -- bad}} msg
thread::send -async $serverthread {interp cancel -unwind}
- thread::release -wait $serverthread
+ thread::join $serverthread
list [expr {$::threadIdStarted == $serverthread}] $msg
} {1 {could not find interpreter "bad"}}
test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread} -setup {
@@ -921,7 +934,7 @@ test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread} -se
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval canceled}}
@@ -956,13 +969,14 @@ test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode lo
vwait ::threadIdStarted; after 1000
set res [thread::send -async $serverthread {interp cancel}]
after 1000; # wait for ThreadErrorProc to be called.
- catch {thread::release $serverthread}
+ thread::send $serverthread $::threadSuperKillScript
+ thread::join $serverthread
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {thread} {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
@@ -997,13 +1011,14 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo
vwait ::threadIdStarted; after 1000
set res [thread::send -async $serverthread {interp cancel}]
after 1000; # wait for ThreadErrorProc to be called.
- catch {thread::release $serverthread}
+ thread::send $serverthread $::threadSuperKillScript
+ thread::join $serverthread
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.30 {cancel: send async thread cancel nested catch inside pure bytecode loop} {thread} {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
@@ -1036,13 +1051,14 @@ test thread-7.30 {cancel: send async thread cancel nested catch inside pure byte
vwait ::threadIdStarted; after 1000
set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
after 1000; # wait for ThreadErrorProc to be called.
- catch {thread::release $serverthread}
+ thread::send $serverthread $::threadSuperKillScript
+ thread::join $serverthread
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.31 {cancel: send async thread cancel nested catch pure inside-command loop} {thread} {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
@@ -1077,13 +1093,14 @@ test thread-7.31 {cancel: send async thread cancel nested catch pure inside-comm
vwait ::threadIdStarted; after 1000
set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
after 1000; # wait for ThreadErrorProc to be called.
- catch {thread::release $serverthread}
+ thread::send $serverthread $::threadSuperKillScript
+ thread::join $serverthread
list $res [expr {[info exists ::threadIdStarted] ? \
$::threadIdStarted == $serverthread : 0}] \
[expr {[info exists ::threadId] ? \
$::threadId == $serverthread : 0}] \
- [expr {[info exists ::threadError] ? \
- [lindex [split $::threadError \n] 0] : "" }]
+ [expr {[info exists ::threadError($serverthread)] ? \
+ [getThreadError $::threadError($serverthread)] : "" }]
} {{} 1 0 {}}
test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} -constraints {thread} -setup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
@@ -1118,7 +1135,7 @@ test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} -const
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -1157,7 +1174,7 @@ test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind}
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -1196,7 +1213,7 @@ test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode lo
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -1237,7 +1254,7 @@ test thread-7.35 {cancel: send async cancel nested catch inside pure inside-comm
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -1276,7 +1293,7 @@ test thread-7.36 {cancel: send async thread cancel nested catch inside pure byte
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}
@@ -1317,7 +1334,7 @@ test thread-7.37 {cancel: send async thread cancel nested catch inside pure insi
thread::join $serverthread
list $res [expr {$::threadIdStarted == $serverthread}] \
[expr {$::threadId == $serverthread}] \
- [lindex [split $::threadError \n] 0]
+ [getThreadError $::threadError($serverthread)]
} -cleanup {
unset -nocomplain ::threadError ::threadId ::threadIdStarted
} -result {{} 1 1 {eval unwound}}