summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorJoe Mistachkin <joe@mistachkin.com>2008-06-13 05:45:01 (GMT)
committerJoe Mistachkin <joe@mistachkin.com>2008-06-13 05:45:01 (GMT)
commitf7c3c0f0809266035acb3cdeaa624f903a3b0cf0 (patch)
tree32ea63055bc449e3ffe1e3b813bb8c48326ac84c /tests
parent9c5b16baabde8f28eb258e1b9be4727afa812830 (diff)
downloadtcl-f7c3c0f0809266035acb3cdeaa624f903a3b0cf0.zip
tcl-f7c3c0f0809266035acb3cdeaa624f903a3b0cf0.tar.gz
tcl-f7c3c0f0809266035acb3cdeaa624f903a3b0cf0.tar.bz2
TIP 285 Implementation
Diffstat (limited to 'tests')
-rw-r--r--tests/cmdAH.test4
-rw-r--r--tests/interp.test10
-rw-r--r--tests/thread.test1194
3 files changed, 1198 insertions, 10 deletions
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 79d7b4f..98b09e9 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: cmdAH.test,v 1.58 2008/04/23 15:44:37 dkf Exp $
+# RCS: @(#) $Id: cmdAH.test,v 1.59 2008/06/13 05:45:14 mistachkin Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -1472,7 +1472,7 @@ test cmdAH-30.8 {Tcl_FileObjCmd: error conditions} {
interp create simpleInterp
interp create -safe safeInterp
-interp c
+interp create
safeInterp expose file file
test cmdAH-31.1 {Tcl_FileObjCmd: channels, too many args} {
diff --git a/tests/interp.test b/tests/interp.test
index 2bbd7a3..57a2020 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: interp.test,v 1.55 2008/05/31 11:42:20 dkf Exp $
+# RCS: @(#) $Id: interp.test,v 1.56 2008/06/13 05:45:15 mistachkin Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -31,7 +31,7 @@ test interp-1.1 {options for interp command} {
} {1 {wrong # args: should be "interp cmd ?arg ...?"}}
test interp-1.2 {options for interp command} {
list [catch {interp frobox} msg] $msg
-} {1 {bad option "frobox": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "frobox": must be alias, aliases, bgerror, cancel, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.3 {options for interp command} {
interp delete
} ""
@@ -49,13 +49,13 @@ test interp-1.6 {options for interp command} {
} {1 {wrong # args: should be "interp slaves ?path?"}}
test interp-1.7 {options for interp command} {
list [catch {interp hello} msg] $msg
-} {1 {bad option "hello": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "hello": must be alias, aliases, bgerror, cancel, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.8 {options for interp command} {
list [catch {interp -froboz} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.9 {options for interp command} {
list [catch {interp -froboz -safe} msg] $msg
-} {1 {bad option "-froboz": must be alias, aliases, bgerror, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
+} {1 {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}}
test interp-1.10 {options for interp command} {
list [catch {interp target} msg] $msg
} {1 {wrong # args: should be "interp target path alias"}}
diff --git a/tests/thread.test b/tests/thread.test
index 9f5562e..97de497 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -6,11 +6,12 @@
#
# Copyright (c) 1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: thread.test,v 1.18 2007/12/13 15:26:07 dgp Exp $
+# RCS: @(#) $Id: thread.test,v 1.19 2008/06/13 05:45:15 mistachkin Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
@@ -25,7 +26,8 @@ if {[testConstraint testthread]} {
testthread errorproc ThreadError
proc ThreadError {id info} {
- global threadError
+ global threadId threadError
+ set threadId $id
set threadError $info
}
@@ -40,7 +42,7 @@ test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} {
} {1 {wrong # args: should be "testthread option ?args?"}}
test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} {
list [catch {testthread foo} msg] $msg
-} {1 {bad option "foo": must be create, exit, id, join, names, send, wait, or errorproc}}
+} {1 {bad option "foo": must be cancel, create, event, exit, id, join, names, send, wait, or errorproc}}
test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {testthread} {
list [threadReap] [llength [testthread names]]
} {1 1}
@@ -253,6 +255,1192 @@ test thread-6.1 {freeing very large object trees in a thread} testthread {
set res
} {0}
+# TIP #285: Script cancellation support
+test thread-7.1 {cancel: args} {testthread} {
+ set x [catch {testthread cancel} msg]
+ list $x $msg
+} {1 {wrong # args: should be "testthread cancel ?-unwind? id ?result?"}}
+test thread-7.2 {cancel: nonint} {testthread} {
+ set x [catch {testthread cancel abc} msg]
+ list $x $msg
+} {1 {expected integer but got "abc"}}
+test thread-7.3 {cancel: bad id} {testthread} {
+ set tid [expr $::tcltest::mainThread + 10]
+ set x [catch {testthread cancel $tid} msg]
+ list $x $msg
+} {1 {invalid thread id}}
+test thread-7.4 {cancel: pure bytecode loop} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ 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
+ }
+ while {1} {
+ # No bytecode at all here...
+ }
+ }
+ foobar
+ }]
+ # 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.5 {cancel: pure inside-command loop} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ 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
+ }
+ set while while
+ $while {1} {
+ # No bytecode at all here...
+ }
+ }
+ foobar
+ }]
+ # 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.6 {cancel: pure bytecode loop -unwind} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ 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
+ }
+ while {1} {
+ # No bytecode at all here...
+ }
+ }
+ 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.7 {cancel: pure inside-command loop -unwind} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ 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
+ }
+ set while while
+ $while {1} {
+ # No bytecode at all here...
+ }
+ }
+ 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.8 {cancel: pure bytecode loop custom result} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ 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
+ }
+ while {1} {
+ # No bytecode at all here...
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread cancel $serverthread "the eval was canceled"]
+ 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 {the eval was canceled}}
+test thread-7.9 {cancel: pure inside-command loop custom result} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ 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
+ }
+ set while while
+ $while {1} {
+ # No bytecode at all here...
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread cancel $serverthread "the eval was canceled"]
+ 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 {the eval was canceled}}
+test thread-7.10 {cancel: pure bytecode loop custom result -unwind} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ 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
+ }
+ while {1} {
+ # No bytecode at all here...
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread cancel -unwind $serverthread "the eval was unwound"]
+ 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 {the eval was unwound}}
+test thread-7.11 {cancel: pure inside-command loop custom result -unwind} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ 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
+ }
+ set while while
+ $while {1} {
+ # No bytecode at all here...
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread cancel -unwind $serverthread "the eval was unwound"]
+ 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 {the eval was unwound}}
+test thread-7.12 {cancel: after} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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
+ }
+ after 30000
+ }]
+ # 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.13 {cancel: after -unwind} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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
+ }
+ after 30000
+ }]
+ # 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.14 {cancel: vwait} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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
+ }
+ vwait forever
+ }]
+ # 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.15 {cancel: vwait -unwind} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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
+ }
+ vwait forever
+ }]
+ # 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.16 {cancel: expr} {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
+ }
+ expr {[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.17 {cancel: expr -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
+ }
+ expr {[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.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} {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
+ 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
+ }
+ 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
+ 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
+ }
+ 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}}
+test thread-7.24 {cancel: nested catch inside pure bytecode loop} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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]]
+ set foo 1
+ }
+ catch {
+ while {1} {
+ catch {
+ while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread cancel $serverthread]
+ after 1000; # wait for ThreadErrorProc to be called.
+ while {[testthread event]} {}; # force events to service
+ catch {testthread send $serverthread {testthread exit}}
+ 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.25 {cancel: nested catch inside pure inside-command loop} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ set catch catch
+ set while while
+ $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]]
+ set foo 1
+ }
+ $catch {
+ $while {1} {
+ $catch {
+ $while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread cancel $serverthread]
+ after 1000; # wait for ThreadErrorProc to be called.
+ while {[testthread event]} {}; # force events to service
+ catch {testthread send $serverthread {testthread exit}}
+ 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.26 {cancel: send async cancel bad interp path} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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]]
+ set foo 1
+ }
+ update
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ catch {testthread send $serverthread {interp cancel -- bad}} msg
+ threadReap
+ list [expr {[info exists ::threadIdStarted] ? \
+ $::threadIdStarted == $serverthread : 0}] \
+ $msg
+} {1 {could not find interpreter "bad"}}
+test thread-7.27 {cancel: send async cancel -- switch} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ interp create -- -unwind
+ interp alias -unwind testthread {} testthread
+ interp eval -unwind {
+ 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]]
+ set foo 1
+ }
+ update
+ }
+ }
+ 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}}
+test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode loop} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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]]
+ set foo 1
+ }
+ catch {
+ while {1} {
+ catch {
+ while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread 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
+ 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.29 {cancel: send async cancel nested catch pure inside-command loop} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ set catch catch
+ set while while
+ $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]]
+ set foo 1
+ }
+ $catch {
+ $while {1} {
+ $catch {
+ $while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread 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
+ 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.30 {cancel: send async testthread cancel nested catch inside pure bytecode loop} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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]]
+ set foo 1
+ }
+ catch {
+ while {1} {
+ catch {
+ while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread send -async $serverthread {testthread cancel [testthread id]}]
+ after 1000; # wait for ThreadErrorProc to be called.
+ while {[testthread event]} {}; # force events to service
+ catch {testthread send $serverthread {testthread exit}}
+ 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.31 {cancel: send async testthread cancel nested catch pure inside-command loop} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ set catch catch
+ set while while
+ $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]]
+ set foo 1
+ }
+ $catch {
+ $while {1} {
+ $catch {
+ $while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ foobar
+ }]
+ # wait for other thread to signal "ready to cancel"
+ vwait ::threadIdStarted; after 1000
+ set res [testthread send -async $serverthread {testthread cancel [testthread id]}]
+ after 1000; # wait for ThreadErrorProc to be called.
+ while {[testthread event]} {}; # force events to service
+ catch {testthread send $serverthread {testthread exit}}
+ 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.32 {cancel: nested catch inside pure bytecode loop -unwind} {testthread} {
+ threadReap
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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]]
+ set foo 1
+ }
+ catch {
+ while {1} {
+ catch {
+ while {1} {
+ # No bytecode at all here...
+ }
+ }
+ }
+ }
+ }
+ }
+ 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
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ set catch catch
+ set while while
+ $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]]
+ set foo 1
+ }
+ $catch {
+ $while {1} {
+ $catch {
+ $while {1} {
+ # No bytecode at all here...
+ }
+ }
+ }
+ }
+ }
+ }
+ 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
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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]]
+ set foo 1
+ }
+ catch {
+ while {1} {
+ catch {
+ while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ 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
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ set catch catch
+ set while while
+ $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]]
+ set foo 1
+ }
+ $catch {
+ $while {1} {
+ $catch {
+ $while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ 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
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ 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]]
+ set foo 1
+ }
+ catch {
+ while {1} {
+ catch {
+ while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ 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
+ unset -nocomplain ::threadError ::threadId ::threadIdStarted
+ set serverthread [testthread create -joinable {
+ proc foobar {} {
+ set catch catch
+ set while while
+ $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]]
+ set foo 1
+ }
+ $catch {
+ $while {1} {
+ $catch {
+ $while {1} {
+ # we must call update here because otherwise
+ # the thread cannot even be forced to exit.
+ update
+ }
+ }
+ }
+ }
+ }
+ }
+ 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}}
+
# cleanup
::tcltest::cleanupTests
return