diff options
| -rw-r--r-- | tests/thread.test | 136 |
1 files changed, 61 insertions, 75 deletions
diff --git a/tests/thread.test b/tests/thread.test index db28dc9..7bc7394 100644 --- a/tests/thread.test +++ b/tests/thread.test @@ -42,40 +42,34 @@ test thread-1.1 {Tcl_ThreadObjCmd: no args} {testthread} { 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} {testthread} { - list [threadReap] [llength [testthread names]] -} {1 1} -test thread-1.4 {Tcl_ThreadObjCmd: thread create } {testthread} { - threadReap - set serverthread [testthread create] - update - set numthreads [llength [testthread names]] - threadReap +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} {testthread} { - threadReap - testthread create {set x 5} +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 [testthread names]] + set l [llength [thread::names]] if {$l == 1} { break } } - threadReap set l } {1} -test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {testthread} { +test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} { threadReap - testthread create {testthread exit} + thread::create {{*}{}} update after 10 - set result [llength [testthread names]] - threadReap - set result + llength [thread::names] } {1} test thread-1.7 {Tcl_ThreadObjCmd: thread id args} {testthread} { set x [catch {testthread id x} msg] @@ -99,11 +93,10 @@ 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} {testthread} { - threadReap - set serverthread [testthread create] - set five [testthread send $serverthread {set x 5}] - threadReap +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} { @@ -111,11 +104,10 @@ test thread-1.14 {Tcl_ThreadObjCmd: send bad id} {testthread} { set x [catch {testthread send $tid {set x 5}} msg] list $x $msg } {1 {invalid thread id}} -test thread-1.15 {Tcl_ThreadObjCmd: wait} {testthread} { - threadReap - set serverthread [testthread create {set z 5 ; testthread wait}] - set five [testthread send $serverthread {set z}] - threadReap +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} { @@ -132,84 +124,78 @@ test thread-1.17 {Tcl_ThreadObjCmd: errorproc change} {testthread} { # NewThread, safe and regular # ThreadErrorProc, except for printing to standard error -test thread-2.1 {ListUpdateInner and ListRemove} {testthread} { - threadReap +test thread-2.1 {ListUpdateInner and ListRemove} {thread} { catch {unset tid} foreach t {0 1 2} { upvar #0 t$t tid - set tid [testthread create] + set tid [thread::create -preserved] } - threadReap + foreach t {0 1 2} { + upvar #0 t$t tid + thread::release $tid + } + llength [thread::names] } 1 -test thread-3.1 {TclThreadList} {testthread} { - threadReap +test thread-3.1 {TclThreadList} {thread} { catch {unset tid} - set len [llength [testthread names]] + set len [llength [thread::names]] set l1 {} foreach t {0 1 2} { - lappend l1 [testthread create] + 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 } - set l2 [testthread names] - list $l1 $l2 - set c [string compare \ - [lsort -integer [concat $::tcltest::mainThread $l1]] \ - [lsort -integer $l2]] - threadReap list $len $c } {1 0} -test thread-4.1 {TclThreadSend to self} {testthread} { +test thread-4.1 {TclThreadSend to self} {thread} { catch {unset x} - testthread send [testthread id] { + thread::send [thread::id] { set x 4 } set x } {4} -test thread-4.2 {TclThreadSend -async} {testthread} { - threadReap - set len [llength [testthread names]] - set serverthread [testthread create] - testthread send -async $serverthread { - after 1000 - testthread exit +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 [testthread names]] - after 1500 {set done 1} + set two [llength [thread::names]] + after 100 {set done 1} vwait done - threadReap - list $len [llength [testthread names]] $two + list $len [llength [thread::names]] $two } {1 1 2} -test thread-4.3 {TclThreadSend preserve errorInfo} {testthread} { - threadReap - set len [llength [testthread names]] - set serverthread [testthread create] - set x [catch {testthread send $serverthread {set undef}} msg] +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 - threadReap + 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 -"testthread send $serverthread {set undef}"}} -test thread-4.4 {TclThreadSend preserve code} {testthread} { - threadReap - set len [llength [testthread names]] - set serverthread [testthread create] +"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 {testthread send $serverthread {set ::errorInfo {}; break}} msg] + set x [catch {thread::send $serverthread {set ::errorInfo {}; break}} msg] set savedErrorInfo $::errorInfo - threadReap + thread::release $serverthread list $len $x $msg $savedErrorInfo } {1 3 {} {}} -test thread-4.5 {TclThreadSend preserve errorCode} {testthread} { - threadReap - set ::tcltest::mainThread [testthread names] - set serverthread [testthread create] - set x [catch {testthread send $serverthread {error ERR INFO CODE}} msg] +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 - threadReap + thread::release $serverthread list $x $msg $savedErrorCode } {1 ERR CODE} |