# Commands covered: (test)thread # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # 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. if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest namespace import -force ::tcltest::* } # Some tests require the testthread command testConstraint testthread [expr {[info commands testthread] != {}}] testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}] if {[testConstraint testthread]} { testthread errorproc ThreadError proc ThreadError {id info} { global threadId threadError set threadId $id set threadError $info } proc ThreadNullError {id info} { # ignore } } test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} { list [catch {testthread} msg] $msg } {1 {wrong # args: should be "testthread option ?arg ...?"}} test thread-1.2 {Tcl_ThreadObjCmd: bad option} {testthread} { list [catch {testthread foo} msg] $msg } {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} {thread} { llength [thread::names] } 1 test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} { set serverthread [thread::create -preserved] set numthreads [llength [thread::names]] thread::release $serverthread set numthreads } {2} test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} { thread::create {set x 5} foreach try {0 1 2 4 5 6} { # Try various ways to yield update after 10 set l [llength [thread::names]] if {$l == 1} { break } } set l } {1} test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} { threadReap thread::create {{*}{}} update after 10 llength [thread::names] } {1} test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {testthread} { set x [catch {testthread id x} msg] list $x $msg } {1 {wrong # args: should be "testthread id"}} test thread-1.8 {Tcl_ThreadObjCmd: thread id} {testthread} { string compare [testthread id] $::tcltest::mainThread } {0} test thread-1.9 {Tcl_ThreadObjCmd: thread names args} {testthread} { set x [catch {testthread names x} msg] list $x $msg } {1 {wrong # args: should be "testthread names"}} test thread-1.10 {Tcl_ThreadObjCmd: thread id} {testthread} { string compare [testthread names] $::tcltest::mainThread } {0} test thread-1.11 {Tcl_ThreadObjCmd: send args} {testthread} { set x [catch {testthread send} msg] list $x $msg } {1 {wrong # args: should be "testthread send ?-async? id script"}} test thread-1.12 {Tcl_ThreadObjCmd: send nonint} {testthread} { set x [catch {testthread send abc command} msg] list $x $msg } {1 {expected integer but got "abc"}} test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} { set serverthread [thread::create -preserved] set five [thread::send $serverthread {set x 5}] thread::release $serverthread set five } 5 test thread-1.14 {Tcl_ThreadObjCmd: send bad id} {testthread} { set tid [expr $::tcltest::mainThread + 10] set x [catch {testthread send $tid {set x 5}} msg] list $x $msg } {1 {invalid thread id}} test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} { set serverthread [thread::create -preserved {set z 5 ; thread::wait}] set five [thread::send $serverthread {set z}] thread::release $serverthread set five } 5 test thread-1.16 {Tcl_ThreadObjCmd: errorproc args} {testthread} { set x [catch {testthread errorproc foo bar} msg] list $x $msg } {1 {wrong # args: should be "testthread errorproc proc"}} test thread-1.17 {Tcl_ThreadObjCmd: errorproc change} {testthread} { testthread errorproc foo testthread errorproc ThreadError } {} # The tests above also cover: # TclCreateThread, except when pthread_create fails # NewThread, safe and regular # ThreadErrorProc, except for printing to standard error test thread-2.1 {ListUpdateInner and ListRemove} {thread} { catch {unset tid} foreach t {0 1 2} { upvar #0 t$t tid set tid [thread::create -preserved] } foreach t {0 1 2} { upvar #0 t$t tid thread::release $tid } llength [thread::names] } 1 test thread-3.1 {TclThreadList} {thread} { catch {unset tid} set len [llength [thread::names]] set l1 {} foreach t {0 1 2} { lappend l1 [thread::create -preserved] } set l2 [thread::names] set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]] foreach t $l1 { thread::release $t } list $len $c } {1 0} test thread-4.1 {TclThreadSend to self} {thread} { catch {unset x} thread::send [thread::id] { set x 4 } set x } {4} test thread-4.2 {TclThreadSend -async} {thread} { set len [llength [thread::names]] set serverthread [thread::create -preserved] thread::send -async $serverthread { after 1 {thread::release} } set two [llength [thread::names]] after 100 {set done 1} vwait done list $len [llength [thread::names]] $two } {1 1 2} test thread-4.3 {TclThreadSend preserve errorInfo} {thread} { set len [llength [thread::names]] set serverthread [thread::create -preserved] set x [catch {thread::send $serverthread {set undef}} msg] set savedErrorInfo $::errorInfo thread::release $serverthread list $len $x $msg $savedErrorInfo } {1 1 {can't read "undef": no such variable} {can't read "undef": no such variable while executing "set undef" invoked from within "thread::send $serverthread {set undef}"}} test thread-4.4 {TclThreadSend preserve code} {thread} { set len [llength [thread::names]] set serverthread [thread::create -preserved] set ::errorInfo {} set x [catch {thread::send $serverthread {set ::errorInfo {}; break}} msg] set savedErrorInfo $::errorInfo thread::release $serverthread list $len $x $msg $savedErrorInfo } {1 3 {} {}} test thread-4.5 {TclThreadSend preserve errorCode} {thread} { set serverthread [thread::create] set x [catch {thread::send $serverthread {error ERR INFO CODE}} msg] set savedErrorCode $::errorCode thread::release $serverthread list $x $msg $savedErrorCode } {1 ERR CODE} test thread-5.0 {Joining threads} {thread} { set serverthread [thread::create -joinable -preserved] thread::send -async $serverthread {after 1000 ; thread::release} thread::join $serverthread } {0} test thread-5.1 {Joining threads after the fact} {thread} { set serverthread [thread::create -joinable -preserved] thread::send -async $serverthread {thread::release} after 2000 thread::join $serverthread } {0} test thread-5.2 {Try to join a detached thread} {thread} { set serverthread [thread::create -preserved] thread::send -async $serverthread {after 1000 ; thread::release} catch {set res [thread::join $serverthread]} msg while {[llength [thread::names]] > 1} { after 20 } lrange $msg 0 2 } {cannot join thread} test thread-6.1 {freeing very large object trees in a thread} thread { # conceptual duplicate of obj-32.1 set serverthread [thread::create -preserved] thread::send -async $serverthread { set x {} for {set i 0} {$i<100000} {incr i} { set x [list $x {}] } unset x } thread::release -wait $serverthread } 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