summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2011-11-09 20:40:46 (GMT)
committerdgp <dgp@users.sourceforge.net>2011-11-09 20:40:46 (GMT)
commitf9b9ca68f809e9a60a4f1c27c8ea43ef0167c26b (patch)
tree6301471254816eee6adcc4fc21cfa07871b27f47 /tests
parentff1a9f1762b2a15086eb6422ca160377a1a4d783 (diff)
downloadtcl-f9b9ca68f809e9a60a4f1c27c8ea43ef0167c26b.zip
tcl-f9b9ca68f809e9a60a4f1c27c8ea43ef0167c26b.tar.gz
tcl-f9b9ca68f809e9a60a4f1c27c8ea43ef0167c26b.tar.bz2
More work in progress converting tests from [testthread] to Thread package.
Diffstat (limited to 'tests')
-rw-r--r--tests/thread.test497
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