diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | tests/thread.test | 155 |
2 files changed, 76 insertions, 88 deletions
@@ -1,5 +1,14 @@ 2011-11-17 Joe Mistachkin <joe@mistachkin.com> + * tests/thread.test: Refactor all the remaining thread-7.x tests that + were using [testthread]. Note that this test file now requires the + very latest version of the Thread package to pass all tests. In + addition, the thread-7.18 and thread-7.19 tests have been flagged as + knownBug because they cannot pass without modifications to the [expr] + command, persuant to TIP #392. + +2011-11-17 Joe Mistachkin <joe@mistachkin.com> + * generic/tclThreadTest.c: For [testthread cancel], avoid creating a new Tcl_Obj when the default script cancellation result is desired. diff --git a/tests/thread.test b/tests/thread.test index af4e4b6..936f725 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -19,6 +19,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # Some tests require the testthread command testConstraint testthread [expr {[info commands testthread] != {}}] + +# Some tests require the Thread package + testConstraint thread [expr {0 == [catch {package require Thread 2.7}]}] testConstraint notValgrind [expr {![testConstraint valgrind]}] @@ -611,33 +614,30 @@ test thread-7.17 {cancel: expr -unwind} -constraints thread -setup { } -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} -test thread-7.18 {cancel: expr bignum} {testthread} { - threadReap +test thread-7.18 {cancel: expr bignum} {thread knownBug} { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { set i [interp create] - interp alias $i testthread {} testthread + $i eval "package require -exact Thread [package present Thread]" $i eval { 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 %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } # - # TODO: This will not cancel because libtommath - # does not check Tcl_Canceled. - # + # BUGBUG: This will not cancel because libtommath + # does not check Tcl_Canceled. + # expr {2**99999} } - }] + }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 - set res [testthread cancel $serverthread] - testthread join $serverthread - while {[testthread event]} {}; # force events to service - threadReap + set res [thread::cancel $serverthread] + thread::join $serverthread; # WARNING: Never returns due to bug (see above). list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ @@ -645,33 +645,30 @@ test thread-7.18 {cancel: expr bignum} {testthread} { [expr {[info exists ::threadError] ? \ [lindex [split $::threadError \n] 0] : "" }] } {{} 1 0 {}} -test thread-7.19 {cancel: expr bignum -unwind} {testthread} { - threadReap +test thread-7.19 {cancel: expr bignum -unwind} {thread knownBug} { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { set i [interp create] - interp alias $i testthread {} testthread + $i eval "package require -exact Thread [package present Thread]" $i eval { 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 %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } # - # TODO: This will not cancel because libtommath - # does not check Tcl_Canceled. - # + # BUGBUG: This will not cancel because libtommath + # does not check Tcl_Canceled. + # expr {2**99999} } - }] + }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 - set res [testthread cancel -unwind $serverthread] - testthread join $serverthread - while {[testthread event]} {}; # force events to service - threadReap + set res [thread::cancel -unwind $serverthread] + thread::join $serverthread; # WARNING: Never returns due to bug (see above). list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ @@ -791,17 +788,16 @@ test thread-7.23 {cancel: slave interp -unwind} -constraints {thread} -setup { } -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval unwound}} -test thread-7.24 {cancel: nested catch inside pure bytecode loop} {notValgrind testthread} { - threadReap +test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread} { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { + set serverthread [thread::create -joinable \ + [string map [list %ID% [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 %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } catch { @@ -818,14 +814,12 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {notValgrind t } } foobar - }] + }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 - set res [testthread cancel $serverthread] + set res [thread::cancel $serverthread] after 1000; # wait for ThreadErrorProc to be called. - while {[testthread event]} {}; # force events to service - catch {testthread send $serverthread {testthread exit}} - threadReap + catch {thread::release $serverthread} list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ @@ -833,10 +827,10 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {notValgrind t [expr {[info exists ::threadError] ? \ [lindex [split $::threadError \n] 0] : "" }] } {{} 1 0 {}} -test thread-7.25 {cancel: nested catch inside pure inside-command loop} {notValgrind testthread} { - threadReap +test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread} { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while @@ -844,8 +838,7 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {notValg 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 %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } $catch { @@ -862,14 +855,12 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {notValg } } foobar - }] + }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 - set res [testthread cancel $serverthread] + set res [thread::cancel $serverthread] after 1000; # wait for ThreadErrorProc to be called. - while {[testthread event]} {}; # force events to service - catch {testthread send $serverthread {testthread exit}} - threadReap + catch {thread::release $serverthread} list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ @@ -934,17 +925,16 @@ test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread} -se } -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted } -result {{} 1 1 {eval canceled}} -test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {notValgrind testthread} { - threadReap +test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {thread} { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { + set serverthread [thread::create -joinable \ + [string map [list %ID% [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 %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } catch { @@ -961,14 +951,12 @@ test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode lo } } foobar - }] + }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 - set res [testthread send -async $serverthread {interp cancel}] + set res [thread::send -async $serverthread {interp cancel}] after 1000; # wait for ThreadErrorProc to be called. - while {[testthread event]} {}; # force events to service - catch {testthread send $serverthread {testthread exit}} - threadReap + catch {thread::release $serverthread} list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ @@ -976,10 +964,10 @@ 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} {notValgrind testthread} { - threadReap +test thread-7.29 {cancel: send async cancel nested catch pure inside-command loop} {thread} { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while @@ -987,8 +975,7 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo 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 %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } $catch { @@ -1005,14 +992,12 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo } } foobar - }] + }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 - set res [testthread send -async $serverthread {interp cancel}] + set res [thread::send -async $serverthread {interp cancel}] after 1000; # wait for ThreadErrorProc to be called. - while {[testthread event]} {}; # force events to service - catch {testthread send $serverthread {testthread exit}} - threadReap + catch {thread::release $serverthread} list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ @@ -1020,17 +1005,16 @@ 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} {notValgrind testthread} { - threadReap +test thread-7.30 {cancel: send async thread cancel nested catch inside pure bytecode loop} {thread} { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { + set serverthread [thread::create -joinable \ + [string map [list %ID% [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 %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } catch { @@ -1047,14 +1031,12 @@ test thread-7.30 {cancel: send async testthread cancel nested catch inside pure } } foobar - }] + }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 - set res [testthread send -async $serverthread {testthread cancel [testthread id]}] + set res [thread::send -async $serverthread {thread::cancel [thread::id]}] after 1000; # wait for ThreadErrorProc to be called. - while {[testthread event]} {}; # force events to service - catch {testthread send $serverthread {testthread exit}} - threadReap + catch {thread::release $serverthread} list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ @@ -1062,10 +1044,10 @@ 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} {notValgrind testthread} { - threadReap +test thread-7.31 {cancel: send async thread cancel nested catch pure inside-command loop} {thread} { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while @@ -1073,8 +1055,7 @@ test thread-7.31 {cancel: send async testthread cancel nested catch pure inside- 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 %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } $catch { @@ -1091,14 +1072,12 @@ test thread-7.31 {cancel: send async testthread cancel nested catch pure inside- } } foobar - }] + }]] # wait for other thread to signal "ready to cancel" vwait ::threadIdStarted; after 1000 - set res [testthread send -async $serverthread {testthread cancel [testthread id]}] + set res [thread::send -async $serverthread {thread::cancel [thread::id]}] after 1000; # wait for ThreadErrorProc to be called. - while {[testthread event]} {}; # force events to service - catch {testthread send $serverthread {testthread exit}} - threadReap + catch {thread::release $serverthread} list $res [expr {[info exists ::threadIdStarted] ? \ $::threadIdStarted == $serverthread : 0}] \ [expr {[info exists ::threadId] ? \ |