diff options
author | Joe Mistachkin <joe@mistachkin.com> | 2011-11-21 01:26:27 (GMT) |
---|---|---|
committer | Joe Mistachkin <joe@mistachkin.com> | 2011-11-21 01:26:27 (GMT) |
commit | 8df27d553c1c95b099c91414cebf46b5cdbd9912 (patch) | |
tree | c4c7ca8c3124940e622ab07aea6c7278ca9b9463 /tests/thread.test | |
parent | 2773272876df24ee7082713fb4cfcbce917ba71d (diff) | |
download | tcl-8df27d553c1c95b099c91414cebf46b5cdbd9912.zip tcl-8df27d553c1c95b099c91414cebf46b5cdbd9912.tar.gz tcl-8df27d553c1c95b099c91414cebf46b5cdbd9912.tar.bz2 |
Remove unnecessary [after] calls from the thread tests. Make error message matching more robust for tests that may have built-in race conditions. Test thread-7.26 must first unset all thread testing related variables.
Diffstat (limited to 'tests/thread.test')
-rw-r--r-- | tests/thread.test | 22 |
1 files changed, 14 insertions, 8 deletions
diff --git a/tests/thread.test b/tests/thread.test index 3eef85f..a09d457 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -29,12 +29,24 @@ testConstraint notValgrind [expr {![testConstraint valgrind]}] set threadSuperKillScript { rename catch "" rename while "" + rename unknown "" rename update "" thread::release } proc getThreadError { info } { - return [lindex [split [lindex $info 0] \n] 0] + foreach error [lreverse $info] { + set list [split $error \n] + set idx [lsearch -glob $list "*eval*unwound*"] + if {$idx != -1} then { + return [lindex $list $idx] + } + set idx [lsearch -glob $list "*eval*canceled*"] + if {$idx != -1} then { + return [lindex $list $idx] + } + } + return ""; # some other error we do not care about. } proc ThreadError {id info} { @@ -829,7 +841,6 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread} { # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::cancel $serverthread] - after 1000; # wait for ThreadErrorProc to be called. thread::send $serverthread $::threadSuperKillScript thread::join $serverthread list $res [expr {[info exists ::threadIdStarted] ? \ @@ -871,7 +882,6 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread} # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::cancel $serverthread] - after 1000; # wait for ThreadErrorProc to be called. thread::send $serverthread $::threadSuperKillScript thread::join $serverthread list $res [expr {[info exists ::threadIdStarted] ? \ @@ -882,7 +892,7 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread} [getThreadError $::threadError($serverthread)] : "" }] } {{} 1 0 {}} test thread-7.26 {cancel: send async cancel bad interp path} {thread} { - unset -nocomplain ::threadIdStarted + unset -nocomplain ::threadError ::threadId ::threadIdStarted set serverthread [thread::create -joinable \ [string map [list %ID% [thread::id]] { proc foobar {} { @@ -968,7 +978,6 @@ test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode lo # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {interp cancel}] - after 1000; # wait for ThreadErrorProc to be called. thread::send $serverthread $::threadSuperKillScript thread::join $serverthread list $res [expr {[info exists ::threadIdStarted] ? \ @@ -1010,7 +1019,6 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {interp cancel}] - after 1000; # wait for ThreadErrorProc to be called. thread::send $serverthread $::threadSuperKillScript thread::join $serverthread list $res [expr {[info exists ::threadIdStarted] ? \ @@ -1050,7 +1058,6 @@ test thread-7.30 {cancel: send async thread cancel nested catch inside pure byte # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {thread::cancel [thread::id]}] - after 1000; # wait for ThreadErrorProc to be called. thread::send $serverthread $::threadSuperKillScript thread::join $serverthread list $res [expr {[info exists ::threadIdStarted] ? \ @@ -1092,7 +1099,6 @@ test thread-7.31 {cancel: send async thread cancel nested catch pure inside-comm # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 set res [thread::send -async $serverthread {thread::cancel [thread::id]}] - after 1000; # wait for ThreadErrorProc to be called. thread::send $serverthread $::threadSuperKillScript thread::join $serverthread list $res [expr {[info exists ::threadIdStarted] ? \ |