From b924fb348d9b1220044506e8b77e33b34726c9dd Mon Sep 17 00:00:00 2001 From: Joe Mistachkin Date: Fri, 18 Nov 2011 12:11:33 +0000 Subject: 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. --- ChangeLog | 8 ++++ tests/thread.test | 117 +++++++++++++++++++++++++++++++----------------------- 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 + + * 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 * 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}} -- cgit v0.12