diff options
Diffstat (limited to 'tests/thread.test')
| -rw-r--r-- | tests/thread.test | 1194 |
1 files changed, 1191 insertions, 3 deletions
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 |