diff options
Diffstat (limited to 'tests/thread.test')
| -rw-r--r-- | tests/thread.test | 497 |
1 files changed, 235 insertions, 262 deletions
diff --git a/tests/thread.test b/tests/thread.test index dbfaec3..af4e4b6 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -611,7 +611,75 @@ 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} -constraints thread -setup { +test thread-7.18 {cancel: expr bignum} {testthread} { + threadReap + unset -nocomplain ::threadError ::threadId ::threadIdStarted + set serverthread [testthread create -joinable { + set i [interp create] + interp alias $i testthread {} testthread + $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]] + set foo 1 + } + # + # TODO: 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 + 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] : "" }] +} {{} 1 0 {}} +test thread-7.19 {cancel: expr bignum -unwind} {testthread} { + threadReap + unset -nocomplain ::threadError ::threadId ::threadIdStarted + set serverthread [testthread create -joinable { + set i [interp create] + interp alias $i testthread {} testthread + $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]] + set foo 1 + } + # + # TODO: 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 + 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] : "" }] +} {{} 1 0 {}} +test thread-7.20 {cancel: subst} -constraints {thread} -setup { unset -nocomplain ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ @@ -625,28 +693,21 @@ test thread-7.18 {cancel: expr bignum} -constraints thread -setup { thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } - # - # TODO: This will not cancel because libtommath - # does not check Tcl_Canceled. - # - expr {2**99999} + subst {[while {1} {incr x}]} } }]] # wait for other thread to signal "ready to cancel" - vwait threadIdStarted + vwait ::threadIdStarted set res [thread::cancel $serverthread] - after 1000 {set ::threadId timeout} - vwait threadId + vwait ::threadId thread::join $serverthread list $res [expr {$::threadIdStarted == $serverthread}] \ - [expr {[info exists ::threadId] ? \ - $::threadId == $serverthread : 0}] \ - [expr {[info exists ::threadError] ? \ - [lindex [split $::threadError \n] 0] : "" }] + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] } -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted -} -result {{} 1 0 {}} -test thread-7.19 {cancel: expr bignum -unwind} -constraints thread -setup { +} -result {{} 1 1 {eval canceled}} +test thread-7.21 {cancel: subst -unwind} -constraints {thread} -setup { unset -nocomplain ::threadError ::threadId ::threadIdStarted } -body { set serverthread [thread::create -joinable \ @@ -660,147 +721,76 @@ test thread-7.19 {cancel: expr bignum -unwind} -constraints thread -setup { thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } - # - # TODO: This will not cancel because libtommath - # does not check Tcl_Canceled. - # - expr {2**99999} + subst {[while {1} {incr x}]} } }]] # wait for other thread to signal "ready to cancel" - vwait threadIdStarted + vwait ::threadIdStarted set res [thread::cancel -unwind $serverthread] - after 1000 {set ::threadId timeout} - vwait threadId + vwait ::threadId thread::join $serverthread list $res [expr {$::threadIdStarted == $serverthread}] \ - [expr {[info exists ::threadId] ? \ - $::threadId == $serverthread : 0}] \ - [expr {[info exists ::threadError] ? \ - [lindex [split $::threadError \n] 0] : "" }] + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] } -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted -} -result {{} 1 0 {}} -test thread-7.20 {cancel: subst} {testthread} { - threadReap - unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { - set i [interp create] - interp alias $i testthread {} testthread - $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]] - set foo 1 - } - subst {[while {1} {incr x}]} - } - }] - # 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 - 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] : "" }] -} {{} 1 1 {eval canceled}} -test thread-7.21 {cancel: subst -unwind} {testthread} { - threadReap - unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { - set i [interp create] - interp alias $i testthread {} testthread - $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]] - set foo 1 - } - subst {[while {1} {incr x}]} - } - }] - # 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 - 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] : "" }] -} {{} 1 1 {eval unwound}} -test thread-7.22 {cancel: slave interp} {testthread} { - threadReap +} -result {{} 1 1 {eval unwound}} +test thread-7.22 {cancel: slave interp} -constraints {thread} -setup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -body { + 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 } while {1} {} } - }] + }]] # 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 - 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] : "" }] -} {{} 1 1 {eval canceled}} -test thread-7.23 {cancel: slave interp -unwind} {testthread} { - threadReap + vwait ::threadIdStarted + set res [thread::cancel $serverthread] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval canceled}} +test thread-7.23 {cancel: slave interp -unwind} -constraints {thread} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + 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 } set while while; $while {1} {} } - }] + }]] # 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 - 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] : "" }] -} {{} 1 1 {eval unwound}} + vwait ::threadIdStarted + set res [thread::cancel -unwind $serverthread] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -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 unset -nocomplain ::threadError ::threadId ::threadIdStarted @@ -890,14 +880,13 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {notValg 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]] { + [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). - thread::send MAIN \ - [list set ::threadIdStarted [thread::id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } update @@ -906,28 +895,26 @@ test thread-7.26 {cancel: send async cancel bad interp path} {thread} { foobar }]] # wait for other thread to signal "ready to cancel" - vwait ::threadIdStarted; after 1000 + vwait ::threadIdStarted 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 + list [expr {$::threadIdStarted == $serverthread}] $msg } {1 {could not find interpreter "bad"}} -test thread-7.27 {cancel: send async cancel -- switch} {testthread} { - threadReap +test thread-7.27 {cancel: send async cancel -- switch} -constraints {thread} -setup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { - interp create -- -unwind - interp alias -unwind testthread {} testthread - interp eval -unwind { +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { + set i [interp create -- -unwind] + $i eval "package require -exact Thread [package present Thread]" + $i eval { 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 } update @@ -935,20 +922,18 @@ test thread-7.27 {cancel: send async cancel -- switch} {testthread} { } foobar } - }] + }]] # wait for other thread to signal "ready to cancel" - vwait ::threadIdStarted; after 1000 - set res [testthread send -async $serverthread {interp cancel -- -unwind}] - after 1000; # wait for ThreadErrorProc to be called. - while {[testthread event]} {}; # force events to service - threadReap - 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] : "" }] -} {{} 1 1 {eval canceled}} + vwait ::threadIdStarted + set res [thread::send -async $serverthread {interp cancel -- -unwind}] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -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 unset -nocomplain ::threadError ::threadId ::threadIdStarted @@ -1121,17 +1106,17 @@ test thread-7.31 {cancel: send async testthread cancel nested catch pure inside- [expr {[info exists ::threadError] ? \ [lindex [split $::threadError \n] 0] : "" }] } {{} 1 0 {}} -test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} {testthread} { - threadReap +test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} -constraints {thread} -setup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -body { + 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 { @@ -1146,24 +1131,23 @@ test thread-7.32 {cancel: nested catch inside pure bytecode loop -unwind} {testt } } foobar - }] + }]] # 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 - 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] : "" }] -} {{} 1 1 {eval unwound}} -test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} {testthread} { - threadReap + vwait ::threadIdStarted + set res [thread::cancel -unwind $serverthread] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval unwound}} +test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} -constraints {thread} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while @@ -1171,8 +1155,7 @@ test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} 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 { @@ -1187,31 +1170,29 @@ test thread-7.33 {cancel: nested catch inside pure inside-command loop -unwind} } } foobar - }] + }]] # 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 - 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] : "" }] -} {{} 1 1 {eval unwound}} -test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode loop -unwind} {testthread} { - threadReap + vwait ::threadIdStarted + set res [thread::cancel -unwind $serverthread] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval unwound}} +test thread-7.34 {cancel: send async cancel nested catch inside pure bytecode loop -unwind} -constraints {thread} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + 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 { @@ -1228,24 +1209,23 @@ test thread-7.34 {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 -unwind}] - testthread join $serverthread - while {[testthread event]} {}; # force events to service - threadReap - 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] : "" }] -} {{} 1 1 {eval unwound}} -test thread-7.35 {cancel: send async cancel nested catch inside pure inside-command loop -unwind} {testthread} { - threadReap + vwait ::threadIdStarted + set res [thread::send -async $serverthread {interp cancel -unwind}] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval unwound}} +test thread-7.35 {cancel: send async cancel nested catch inside pure inside-command loop -unwind} -constraints {thread} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { proc foobar {} { set catch catch set while while @@ -1253,8 +1233,7 @@ test thread-7.35 {cancel: send async cancel nested catch inside pure inside-comm 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 { @@ -1271,31 +1250,29 @@ test thread-7.35 {cancel: send async cancel nested catch inside pure inside-comm } } foobar - }] + }]] # wait for other thread to signal "ready to cancel" - vwait ::threadIdStarted; after 1000 - set res [testthread send -async $serverthread {interp cancel -unwind}] - testthread join $serverthread - while {[testthread event]} {}; # force events to service - threadReap - 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] : "" }] -} {{} 1 1 {eval unwound}} -test thread-7.36 {cancel: send async testthread cancel nested catch inside pure bytecode loop -unwind} {testthread} { - threadReap + vwait ::threadIdStarted + set res [thread::send -async $serverthread {interp cancel -unwind}] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval unwound}} +test thread-7.36 {cancel: send async thread cancel nested catch inside pure bytecode loop -unwind} -constraints {thread} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + 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 { @@ -1312,24 +1289,23 @@ test thread-7.36 {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 -unwind [testthread id]}] - testthread join $serverthread - while {[testthread event]} {}; # force events to service - threadReap - 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] : "" }] -} {{} 1 1 {eval unwound}} -test thread-7.37 {cancel: send async testthread cancel nested catch inside pure inside-command loop -unwind} {testthread} { - threadReap + vwait ::threadIdStarted + set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval unwound}} +test thread-7.37 {cancel: send async thread cancel nested catch inside pure inside-command loop -unwind} -constraints {thread} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID [thread::id]] { proc foobar {} { set catch catch set while while @@ -1337,8 +1313,7 @@ test thread-7.37 {cancel: send async testthread cancel nested catch inside pure 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 { @@ -1355,20 +1330,18 @@ test thread-7.37 {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 -unwind [testthread id]}] - testthread join $serverthread - while {[testthread event]} {}; # force events to service - threadReap - 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] : "" }] -} {{} 1 1 {eval unwound}} + vwait ::threadIdStarted + set res [thread::send -async $serverthread {thread::cancel -unwind [thread::id]}] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -result {{} 1 1 {eval unwound}} # cleanup ::tcltest::cleanupTests |