diff options
Diffstat (limited to 'tests/thread.test')
| -rw-r--r-- | tests/thread.test | 1214 |
1 files changed, 26 insertions, 1188 deletions
diff --git a/tests/thread.test b/tests/thread.test index a6961ed..3c0a1e1 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -6,7 +6,6 @@ # # 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. @@ -24,8 +23,7 @@ if {[testConstraint testthread]} { testthread errorproc ThreadError proc ThreadError {id info} { - global threadId threadError - set threadId $id + global threadError set threadError $info } @@ -37,10 +35,10 @@ if {[testConstraint testthread]} { test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} { list [catch {testthread} msg] $msg -} {1 {wrong # args: should be "testthread option ?arg ...?"}} +} {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 cancel, create, event, exit, id, join, names, send, wait, or errorproc}} +} {1 {bad option "foo": must be create, 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} @@ -256,1191 +254,31 @@ 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... - } - } - } +test thread-8.1 {threaded fork stress} -constraints {thread} -setup { + unset -nocomplain ::threadCount ::execCount ::threads ::thread + set ::threadCount 10 + set ::execCount 10 +} -body { + set ::threads [list] + for {set i 0} {$i < $::threadCount} {incr i} { + lappend ::threads [thread::create -joinable [string map \ + [list %execCount% $::execCount] { + proc execLs {} { + if {$::tcl_platform(platform) eq "windows"} then { + return [exec $::env(COMSPEC) /c DIR] + } else { + return [exec /bin/ls] } } - } - 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}} + set j {%execCount%}; while {[incr j -1]} {execLs} + }]] + } + foreach ::thread $::threads { + thread::join $::thread + } +} -cleanup { + unset -nocomplain ::threadCount ::execCount ::threads ::thread +} -result {} # cleanup ::tcltest::cleanupTests |