diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/thread.test | 613 | ||||
| -rw-r--r-- | tests/unixNotfy.test | 5 |
2 files changed, 270 insertions, 348 deletions
diff --git a/tests/thread.test b/tests/thread.test index 74f7043..dbfaec3 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -12,14 +12,14 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2.2 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}]}] +testConstraint thread [expr {0 == [catch {package require Thread 2.7}]}] testConstraint notValgrind [expr {![testConstraint valgrind]}] @@ -59,12 +59,6 @@ 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 ...?"}} -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 @@ -93,53 +87,18 @@ test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} { 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] $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] $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 $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 @@ -257,29 +216,16 @@ test thread-6.1 {freeing very large object trees in a thread} thread { } 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 $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 +test thread-7.4 {cancel: pure bytecode loop} -constraints {thread} -setup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } while {1} { @@ -287,30 +233,28 @@ test thread-7.4 {cancel: pure bytecode loop} {testthread} { } } 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 + vwait ::threadIdStarted + set res [thread::cancel $serverthread] + vwait ::threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval canceled}} +test thread-7.5 {cancel: pure inside-command loop} -constraints {thread} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { 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]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } set while while @@ -319,30 +263,28 @@ test thread-7.5 {cancel: pure inside-command loop} {testthread} { } } 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 + vwait threadIdStarted + set res [thread::cancel $serverthread] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval canceled}} +test thread-7.6 {cancel: pure bytecode loop -unwind} -constraints {thread} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } while {1} { @@ -350,30 +292,28 @@ test thread-7.6 {cancel: pure bytecode loop -unwind} {testthread} { } } 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 + vwait threadIdStarted + set res [thread::cancel -unwind $serverthread] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { - proc foobar {} { +} -result {{} 1 1 {eval unwound}} +test thread-7.7 {cancel: pure inside-command loop -unwind} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { + proc foobar {} { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } set while while @@ -382,30 +322,28 @@ test thread-7.7 {cancel: pure inside-command loop -unwind} {testthread} { } } 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 + vwait threadIdStarted + set res [thread::cancel -unwind $serverthread] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval unwound}} +test thread-7.8 {cancel: pure bytecode loop custom result} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { 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]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } while {1} { @@ -413,30 +351,30 @@ test thread-7.8 {cancel: pure bytecode loop custom result} {testthread} { } } 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 + vwait threadIdStarted + set res [thread::cancel $serverthread "the eval was canceled"] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { - proc foobar {} { +} -result {{} 1 1 {the eval was canceled}} +test thread-7.9 {cancel: pure inside-command loop custom result} -constraints { + thread +} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { + 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]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } set while while @@ -445,30 +383,30 @@ test thread-7.9 {cancel: pure inside-command loop custom result} {testthread} { } } 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 + vwait threadIdStarted + set res [thread::cancel $serverthread "the eval was canceled"] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {the eval was canceled}} +test thread-7.10 {cancel: pure bytecode loop custom result -unwind} -constraints { + thread +} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { 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]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } while {1} { @@ -476,30 +414,30 @@ test thread-7.10 {cancel: pure bytecode loop custom result -unwind} {testthread} } } 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 + vwait threadIdStarted + set res [thread::cancel -unwind $serverthread "the eval was unwound"] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { - proc foobar {} { +} -result {{} 1 1 {the eval was unwound}} +test thread-7.11 {cancel: pure inside-command loop custom result -unwind} -constraints { + thread +} -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { + 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]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } set while while @@ -508,196 +446,183 @@ test thread-7.11 {cancel: pure inside-command loop custom result -unwind} {testt } } 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 + vwait threadIdStarted + set res [thread::cancel -unwind $serverthread "the eval was unwound"] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {the eval was unwound}} +test thread-7.12 {cancel: after} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } 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 + vwait threadIdStarted + set res [thread::cancel $serverthread] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval canceled}} +test thread-7.13 {cancel: after -unwind} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } 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 + vwait threadIdStarted + set res [thread::cancel -unwind $serverthread] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval unwound}} +test thread-7.14 {cancel: vwait} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID [thread::id]] { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } 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 + vwait threadIdStarted + set res [thread::cancel $serverthread] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval canceled}} +test thread-7.15 {cancel: vwait -unwind} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } 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 + vwait threadIdStarted + set res [thread::cancel -unwind $serverthread] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval unwound}} +test thread-7.16 {cancel: expr} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID [thread::id]] { set i [interp create] - interp alias $i testthread {} testthread + $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } 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 + vwait threadIdStarted + set res [thread::cancel $serverthread] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval canceled}} +test thread-7.17 {cancel: expr -unwind} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { set i [interp create] - interp alias $i testthread {} testthread + $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } 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 + vwait threadIdStarted + set res [thread::cancel -unwind $serverthread] + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ + [expr {$::threadId == $serverthread}] \ + [lindex [split $::threadError \n] 0] +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 1 {eval unwound}} +test thread-7.18 {cancel: expr bignum} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { set i [interp create] - interp alias $i testthread {} testthread + $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } # @@ -706,32 +631,33 @@ test thread-7.18 {cancel: expr bignum} {testthread} { # 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}] \ + vwait threadIdStarted + set res [thread::cancel $serverthread] + after 1000 {set ::threadId timeout} + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError] ? \ [lindex [split $::threadError \n] 0] : "" }] -} {{} 1 0 {}} -test thread-7.19 {cancel: expr bignum -unwind} {testthread} { - threadReap +} -cleanup { unset -nocomplain ::threadError ::threadId ::threadIdStarted - set serverthread [testthread create -joinable { +} -result {{} 1 0 {}} +test thread-7.19 {cancel: expr bignum -unwind} -constraints thread -setup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -body { + set serverthread [thread::create -joinable \ + [string map [list %ID% [thread::id]] { set i [interp create] - interp alias $i testthread {} testthread + $i eval "package require -exact Thread [package present Thread]" $i eval { if {![info exists foo]} then { # signal the primary thread that we are ready # to be canceled now (we are running). - testthread send [testthread id -main] \ - [list set ::threadIdStarted [testthread id]] + thread::send %ID% [list set ::threadIdStarted [thread::id]] set foo 1 } # @@ -740,20 +666,21 @@ test thread-7.19 {cancel: expr bignum -unwind} {testthread} { # 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}] \ + vwait threadIdStarted + set res [thread::cancel -unwind $serverthread] + after 1000 {set ::threadId timeout} + vwait threadId + thread::join $serverthread + list $res [expr {$::threadIdStarted == $serverthread}] \ [expr {[info exists ::threadId] ? \ $::threadId == $serverthread : 0}] \ [expr {[info exists ::threadError] ? \ [lindex [split $::threadError \n] 0] : "" }] -} {{} 1 0 {}} +} -cleanup { + unset -nocomplain ::threadError ::threadId ::threadIdStarted +} -result {{} 1 0 {}} test thread-7.20 {cancel: subst} {testthread} { threadReap unset -nocomplain ::threadError ::threadId ::threadIdStarted diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test index 2a17098..067d225 100644 --- a/tests/unixNotfy.test +++ b/tests/unixNotfy.test @@ -10,10 +10,6 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# The tests should not be run if you have a notifier which is unable to -# detect infinite vwaits, as the tests below will hang. The presence of -# the "testthread" command indicates that this is the case. - if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 namespace import -force ::tcltest::* @@ -22,7 +18,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { # When run in a Tk shell, these tests hang. testConstraint noTk [expr {0 != [catch {package present Tk}]}] testConstraint thread [expr {0 == [catch {package require Thread 2.6}]}] -testConstraint testthread [expr {[info commands testthread] != {}}] # Darwin always uses a threaded notifier testConstraint unthreaded [expr { (![info exist tcl_platform(threaded)] || !$tcl_platform(threaded)) |