# Commands covered: 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-2000 Scriptics Corporation. # Copyright (c) 2002 ActiveState Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. package require tcltest namespace import ::tcltest::* tcltest::loadTestedCommands package require Thread tcltest::testConstraint chanTransfer \ [expr { $::tcl_platform(platform) == "unix" \ || $::tcl_patchLevel > "8.4.10"}] set dummy [makeFile dummyForTransfer dummyForTransfer] set tcltest::mainThread [thread::id] proc ThreadReap {} { while {[llength [thread::names]] > 1} { foreach tid [thread::names] { if {$tid != $::tcltest::mainThread} { catch {thread::release -wait $tid} } } } llength [thread::names] } test thread-2.0 {no global thread command} { info commands thread } {} test thread-2.84 {thread subcommands} -body { lsort [info commands thread::*] } -match glob -result {::thread::attach ::thread::broadcast *::thread::cond ::thread::configure ::thread::create ::thread::detach ::thread::errorproc ::thread::eval ::thread::exists ::thread::exit ::thread::id ::thread::join ::thread::mutex ::thread::names ::thread::preserve ::thread::release ::thread::rwmutex ::thread::send ::thread::transfer ::thread::unwind ::thread::wait} test thread-3.0 {thread::names initial thread list} { list [ThreadReap] [llength [thread::names]] } {1 1} test thread-4.0 {thread::create: create server thread} { ThreadReap set tid [thread::create] update set l [llength [thread::names]] ThreadReap set l } {2} test thread-4.1 {thread::create: create one shot thread} { ThreadReap 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 } } ThreadReap set l } {1} test thread-4.2 {thread::create - create preservable thread} { ThreadReap set tid [thread::create -preserved] set c [thread::preserve $tid] thread::release -wait $tid ThreadReap set c } {2} test thread-4.3 {thread::create - release a thread} { ThreadReap set tid [thread::create {thread::release}] update after 10 set l [llength [thread::names]] ThreadReap set l } {1} test thread-4.4 {thread::create - create joinable thread} { ThreadReap set tid [thread::create -joinable {set x 5}] set c [thread::join $tid] ThreadReap set c } {0} test thread-4.5 {thread::create - join detached thread} { ThreadReap set tid [thread::create] thread::send -async $tid {after 1000 ; thread::release} catch {set res [thread::join $tid]} msg ThreadReap lrange $msg 0 2 } {cannot join thread} test thread-5.0 {thread::release} { ThreadReap set tid [thread::create {thread::release}] update after 10 set l [llength [thread::names]] ThreadReap set l } {1} test thread-6.0 {thread::unwind - simple unwind} { ThreadReap thread::create {thread::unwind} update after 10 set l [llength [thread::names]] ThreadReap set l } {1} test thread-6.1 {thread::unwind - blocked unwind} { ThreadReap thread::create {thread::unwind; vwait dummy} update after 10 set l [llength [thread::names]] ThreadReap set l } {2} test thread-7.0 {thread::exit} { ThreadReap set tid [thread::create -joinable {thread::exit}] set c [thread::join $tid] ThreadReap set c } {666} test thread-7.1 {thread::exit - # args} { set tid [thread::create] catch {thread::send $tid {thread::exit 1 0}} msg set msg } {wrong # args: should be "thread::exit ?status?"} test thread-7.2 {thread::exit - args} { set tid [thread::create] catch {thread::send $tid {thread::exit foo}} msg set msg } {expected integer but got "foo"} test thread-7.3 {thread::exit - status} { ThreadReap set tid [thread::create -joinable {thread::exit 0}] set c [thread::join $tid] ThreadReap set c } {0} test thread-8.0 {thread::exists - true} { ThreadReap set c [thread::exists [thread::create]] ThreadReap set c } {1} test thread-8.1 {thread::exists - false} { ThreadReap set tid [thread::create {set x 5}] update after 10 set c [thread::exists $tid] ThreadReap set c } {0} test thread-9.0 {thread::id} { expr {[thread::id] == $::tcltest::mainThread} } {1} test thread-9.1 {thread::id - args} { set x [catch {thread::id x} msg] list $x $msg } {1 {wrong # args: should be "thread::id"}} test thread-10.0 {thread::names args} { set x [catch {thread::names x} msg] list $x $msg } {1 {wrong # args: should be "thread::names"}} test thread-11.0 {thread::send - no args} { set x [catch {thread::send} msg] list $x $msg } {1 {wrong # args: should be "thread::send ?-async? ?-head? id script ?varName?"}} test thread-11.1 {thread::send - simple script} { ThreadReap set tid [thread::create] set five [thread::send $tid {set x 5}] ThreadReap set five } 5 test thread-11.2 {thread::send - bad thread id} { set tid dummy set x [catch {thread::send $tid {set x 5}} msg] list $x $msg } {1 {invalid thread handle "dummy"}} test thread-11.3 {thread::send - test TCL_ERROR return code} { ThreadReap set tid [thread::create] set c [thread::send $tid {dummy} msg] ThreadReap list $c $msg} {1 {invalid command name "dummy"}} test thread-11.4 {thread::send - test TCL_RETURN return code} { ThreadReap set tid [thread::create] set c [thread::send $tid {return} msg] ThreadReap list $c $msg } {2 {}} test thread-11.5 {thread::send - test TCL_BREAK return code} { ThreadReap set tid [thread::create] set c [thread::send $tid {break} msg] ThreadReap list $c $msg } {3 {}} test thread-11.6 {thread::send - asynchronous send} { ThreadReap set tid [thread::create] thread::send -async $tid {set x 5} update after 10 set five [thread::send $tid {set x}] ThreadReap set five } {5} test thread-11.7 {thread::send - async send with event-loop wait} { ThreadReap set res {} set tid [thread::create] thread::send -async $tid {set x 5} five vwait five lappend res $five; set five {} thread::send -async $tid {set x 5} [binary format cccc 0x66 0x69 0x76 0x65]; # five as byte array without str-rep. vwait five lappend res $five; set five {} ThreadReap set res } {5 5} test thread-11.7.1 {thread::send - sync send with var} { ThreadReap set res {} set tid [thread::create] thread::send $tid {set x 5} five lappend res $five; set five {} thread::send $tid {set x 5} [binary format cccc 0x66 0x69 0x76 0x65]; # five as byte array without str-rep. lappend res $five; set five {} ThreadReap set res } {5 5} test thread-11.8 {thread::send - send to self directly} { thread::send [thread::id] {set x 5} five set five } {5} test thread-11.9 {thread::send - send to self asynchronously} { set c [catch {thread::send -async [thread::id] {set x 5} five} msg] list $c $msg } {1 {can't notify self}} test thread-11.10 {thread::send - preserve errorInfo} { ThreadReap set len [llength [thread::names]] set tid [thread::create] set c [catch {thread::send $tid {set undef}} msg] ThreadReap list $c $msg $errorInfo } {1 {can't read "undef": no such variable} {can't read "undef": no such variable while executing "set undef" invoked from within "thread::send $tid {set undef}"}} test thread-11.11 {Thread_Send preserve errorCode} { ThreadReap set tid [thread::create] set c [catch {thread::send $tid {error ERR INFO CODE}} msg] ThreadReap list $c $msg $errorCode } {1 ERR CODE} test thread-11.12 {thread::send - self as target, queue order (bug [b5709ea906])} -body { # Short circuit sending to itself should consider order of already dispatched events, # so SYNC is expected after ASYNC (and possibly TMR-0) but definitely before IDLE, only # the HEAD event (synchronously sends to head of queue) is expected as first in the result, # (note the timer-generation may be retarded tcl-versions related, so TMR-0 can be delayed) ThreadReap set res {} set e [after 500 {lappend res TIMEOUT}] # after 0 {lappend res TMR-0} after idle {lappend res IDLE} thread::send -async [thread::id] {lappend res ASYNC} thread::send -async -head [thread::id] {lappend res AHEAD} thread::send -head [thread::id] {lappend res HEAD} thread::send [thread::id] {lappend res SYNC} # while {[llength $res] < 6 && "TIMEOUT" ni $res} { vwait res } after cancel $e ThreadReap set res } -match regexp -result {^HEAD(?:(?: TMR-0| AHEAD ASYNC){2} SYNC| AHEAD ASYNC SYNC TMR-0) IDLE$} test thread-12.0 {thread::wait} { ThreadReap set tid [thread::create {set x 5; thread::wait}] thread::send $tid {set x} five ThreadReap set five } {5} test thread-13.0 {thread::broadcast} { ThreadReap catch {unset tids} foreach i {1 2 3 4} { lappend tids [thread::create] } thread::broadcast {set x 5} update catch {unset r} foreach tid $tids { lappend r [thread::send $tid {if {[info exists x]} {set x}}] } ThreadReap set r } {5 5 5 5} test thread-13.1 {thread::broadcast no args} { set c [catch {thread::broadcast} msg] list $c $msg } {1 {wrong # args: should be "thread::broadcast script"}} test thread-14.0 {thread::eval - no arguments} { set c [catch {thread::eval} msg] list $c $msg } {1 {wrong # args: should be "thread::eval ?-lock ? arg ?arg...?"}} test thread-14.1 {thread::eval - bad arguments} { set c [catch {thread::eval -lock} msg] list $c $msg } {1 {wrong # args: should be "thread::eval ?-lock ? arg ?arg...?"}} test thread-14.2 {thread::eval - missing script argument} { set c [catch {thread::eval -lock dummy} msg] list $c $msg } {1 {wrong # args: should be "thread::eval ?-lock ? arg ?arg...?"}} test thread-14.3 {thread::eval - bad mutex handle} { set c [catch {thread::eval -lock dummy {set x 5}} msg] list $c $msg } {1 {no such mutex "dummy"}} test thread-14.4 {thread::eval - nested eval} { thread::eval {thread::eval {thread::eval {set x 5}}} } {5} test thread-15.0 {thread::configure - bad arguments} { set c [catch {thread::configure} msg] list $c $msg } {1 {wrong # args: should be "thread::configure threadlId ?optionName? ?value? ?optionName value?..."}} test thread-15.1 {thread::configure - bad thread id argument} { set c [catch {thread::configure dummy} msg] list $c $msg } {1 {invalid thread handle "dummy"}} test thread-15.2 {thread::configure - bad configure option} { set c [catch {thread::configure [thread::id] -dummy} msg] list $c $msg } {1 {bad option "-dummy", should be one of -eventmark, -unwindonerror or -errorstate}} test thread-15.3 {thread::configure - read all configure options} { ThreadReap set tid [thread::create] catch {unset opts} set opts [thread::configure $tid] ThreadReap expr {[llength $opts] % 2} } {0} test thread-15.4 {thread::configure - check configure option names} { ThreadReap set tid [thread::create] update after 10 catch {unset opts} array set opts [thread::configure $tid] ThreadReap array names opts } {-errorstate -unwindonerror -eventmark} test thread-15.5 {thread::configure - get one config option} { ThreadReap set tid [thread::create] update after 10 set l "" lappend l [thread::configure $tid -eventmark] lappend l [thread::configure $tid -unwindonerror] lappend l [thread::configure $tid -errorstate] ThreadReap set l } {0 0 0} test thread-15.6 {thread::configure - set -unwindonerror option} { ThreadReap set tid [thread::create] update after 10 thread::configure $tid -unwindonerror 1 set c [catch {thread::send $tid {set dummy}}] update after 10 set e [thread::exists $tid] ThreadReap list $c $e } {1 0} test thread-15.7 {thread::configure - set -errorstate option} { ThreadReap set tid [thread::create] update after 10 thread::configure $tid -errorstate 1 set c [thread::send $tid {set dummy} msg] ThreadReap list $c $msg } {1 {thread is in error}} test thread-15.8 {thread::configure - set -eventmark option} { ThreadReap set tid [thread::create] update after 10 thread::configure $tid -eventmark 1 thread::send -async $tid {after 2000} set t1 [clock seconds] thread::send -async $tid {after 2000} set t2 [clock seconds] ThreadReap expr {($t2 - $t1) >= 2} } {1} test thread-16.0 {thread::errorproc - args} { set x [catch {thread::errorproc foo bar} msg] list $x $msg } {1 {wrong # args: should be "thread::errorproc ?proc?"}} test thread-16.1 {thread::errorproc - errorproc change} { thread::errorproc foo thread::errorproc ThreadError set new [thread::errorproc] } {ThreadError} test thread-16.2 {thread::errorproc - async reporting} { set etid "" set emsg "" proc myerrproc {tid msg} { global etid emsg set etid $tid set emsg $msg } ThreadReap thread::errorproc myerrproc set tid [thread::create] update after 10 thread::send -async $tid {set x} after 10 update ThreadReap list [expr {$etid == $tid}] $emsg } {1 {can't read "x": no such variable while executing "set x"}} test thread-17.1 {thread::transfer - channel lists} {chanTransfer} { ThreadReap set tid [thread::create] set file [open $dummy r] set res [regexp $file [file channels]] thread::transfer $tid $file lappend res [regexp $file [file channels]] lappend res [regexp $file [thread::send $tid {file channels}]] thread::send $tid "close $file" ThreadReap set res } {1 0 1} test thread-17.2 {thread::transfer - target thread dying} {chanTransfer} { ThreadReap set tid [thread::create] set file [open $dummy r] thread::send -async $tid {after 3000 ; thread::release} catch {thread::transfer $tid $file} msg close $file ThreadReap set msg } {transfer failed: target thread died} test thread-17.3 {thread::transfer - clearing of fileevents} {chanTransfer} { proc _HandleIt_ {} { global gotEvents tid file if {$gotEvents == 0} { thread::transfer $tid $file # From now on no events should be delivered anymore, # restricting the end value to 1 } incr gotEvents } ThreadReap set tid [thread::create] set file [open $dummy r] set gotEvents 0 fileevent $file readable _HandleIt_ vwait gotEvents thread::send $tid "close $file" ThreadReap set gotEvents } {1} test thread-17.4 {thread::transfer - file - readable?} {chanTransfer} { ThreadReap set tid [thread::create] set file [open $dummy r] set res [regexp $file [file channels]] thread::transfer $tid $file set res [string length [thread::send $tid "read -nonewline $file"]] thread::send $tid "close $file" ThreadReap set res } [string length [::tcltest::viewFile dummyForTransfer]] test thread-17.5 {thread::transfer - file - closeable?} {chanTransfer} { set tid [thread::create] set file [open $dummy r] set res [regexp $file [file channels]] thread::transfer $tid $file set res [thread::send $tid "close $file"] ThreadReap set res } {} test thread-17.6 {thread::transfer - socket - readable?} {chanTransfer} { set tid [thread::create] set lsock "" proc accept {sock host port} {global lsock ; set lsock $sock} set listener [socket -server accept 0] set port [lindex [fconfigure $listener -sockname] 2] set socket [socket localhost $port] vwait lsock thread::transfer $tid $socket puts $lsock hello flush $lsock set res [thread::send $tid [list gets $socket]] thread::send $tid [list close $socket] ThreadReap close $listener close $lsock set res } {hello} test thread-17.7 {thread::transfer - socket - closeable?} {chanTransfer} { set tid [thread::create] set lsock "" proc accept {sock host port} {global lsock ; set lsock $sock} set listener [socket -server accept 0] set port [lindex [fconfigure $listener -sockname] 2] set socket [socket localhost $port] vwait lsock thread::transfer $tid $socket set res [thread::send $tid "regexp {$socket} \[file channels\]"] lappend res [thread::send $tid [list close $socket]] lappend res [thread::send $tid "regexp {$socket} \[file channels\]"] ThreadReap close $listener close $lsock set res } {1 {} 0} # We cannot test console channels, nor serials. Because we do not # really know if they are available, and under what names. But a pipe # channel, which uses the same type of code is something we can # do. Lucky us. test thread-17.8 {thread::transfer - pipe - readable?} {chanTransfer} { set tid [thread::create] set s [makeFile { puts hello flush stdout exit } pscript] set pipe [open "|[info nameofexecutable] $s" r] thread::transfer $tid $pipe thread::send $tid [list set pipe $pipe] set res [thread::send $tid {gets $pipe}] thread::send $tid {catch {close $pipe}} ThreadReap removeFile pscript set res } {hello} # The difference between 9 and 10 is the location of the close # operation. For 9 it is the original thread, for 10 the other # thread. 10 currently fails. It seems to be some signal stuff. test thread-17.9 {thread::transfer - pipe - closable?} {chanTransfer} { set tid [thread::create] set s [makeFile { fileevent stdin readable {if {[eof stdin]} {exit 0} ; gets stdin} vwait forever exit 0 } pscript] set pipe [open "|[info nameofexecutable] $s" r+] thread::send $tid [list set chan $pipe] thread::transfer $tid $pipe thread::send $tid {thread::detach $chan} thread::attach $pipe set res [regexp $pipe [file channels]] lappend res [close $pipe] lappend res [regexp $pipe [file channels]] ThreadReap removeFile pscript set res } {1 {} 0} test thread-17.10 {thread::transfer - pipe - closable?} {chanTransfer} { set tid [thread::create] set s [makeFile { fileevent stdin readable {if {[eof stdin]} {exit 0} ; gets stdin} vwait forever exit 0 } pscript] set pipe [open "|[info nameofexecutable] $s" r+] thread::send $tid [list set chan $pipe] thread::transfer $tid $pipe set res [thread::send $tid {regexp $chan [file channels]}] if {[catch { # This can fail on Linux, because there a thread cannot 'wait' on # the children of a different thread (in the same process). This # is for Linux < 2.4. For 2.4 it should be possible, but the # language is cautionary, so it may still fail. lappend res [thread::send $tid {close $chan}] }]} { # Fake a result lappend res {} } lappend res [thread::send $tid {regexp $chan [file channels]}] ThreadReap removeFile pscript set res } {1 {} 0} test thread-17.11a {thread::transfer - pipe - readable event - no transfer} { set tid [thread::create] set s [makeFile { after 5000 {exit 0} fileevent stdin readable { if {[eof stdin]} {exit 0} if {[gets stdin line] <0} return puts response } vwait forever exit 0 } pscript] ;# {} set pipe [open "|[info nameofexecutable] $s" r+] fconfigure $pipe -blocking 0 fileevent $pipe readable {read $pipe ; set cond ok} after 3000 {set cond timeout} puts $pipe tick ; flush $pipe vwait ::cond catch {close $pipe} removeFile pscript set cond } ok test thread-17.11b {thread::transfer - pipe - readable event - with transfer} { set tid [thread::create] set s [makeFile { after 5000 {exit 0} fileevent stdin readable { if {[eof stdin]} {exit 0} if {[gets stdin line] <0} return puts response } vwait forever exit 0 } pscript] ;# {} set pipe [open "|[info nameofexecutable] $s" r+] thread::transfer $tid $pipe thread::send $tid [list set chan $pipe] set cond [thread::send $tid { fconfigure $chan -blocking 0 fileevent $chan readable {read $chan ; set cond ok} after 3000 {set cond timeout} puts $chan tick ; flush $chan vwait ::cond catch {close $pipe} set cond }] ThreadReap removeFile pscript set cond } ok test thread-18.0 {thread::detach - args} { set x [catch {thread::detach} msg] list $x $msg } {1 {wrong # args: should be "thread::detach channel"}} test thread-18.1 {thread::detach - channel} { global fd set fd [open $dummy r] set r1 [regexp $fd [file channels]] thread::detach $fd set r2 [regexp $fd [file channels]] list $r1 $r2 } {1 0} test thread-18.2 {thread::attach - in different thread} { global fd ThreadReap set tid [thread::create] thread::send $tid "thread::attach $fd" set r1 [thread::send $tid "regexp $fd \[file channels\]"] thread::send $tid "thread::detach $fd" list $r1 } {1} test thread-18.3 {thread::attach - in same thread} { global fd thread::attach $fd set r1 [regexp $fd [file channels]] close $fd set r1 } {1} test thread-19.0 {thread::mutex - args} { set x [catch {thread::mutex} msg] list $x $msg } {1 {wrong # args: should be "thread::mutex option ?args?"}} test thread-19.1 {thread::mutex - command options} { set x [catch {thread::mutex dummy} msg] list $x $msg } {1 {bad option "dummy": must be create, destroy, lock, or unlock}} test thread-19.2 {thread::mutex - more command options} { set x [catch {thread::mutex create -dummy} msg] list $x $msg } {1 {wrong # args: should be "thread::mutex create ?-recursive?"}} test thread-19.3 {thread::mutex - create exclusive mutex} { set emutex [thread::mutex create] set c [regexp {mid[0-9]+} $emutex] thread::mutex destroy $emutex set c } {1} test thread-19.4 {thread::mutex - create recursive mutex} { set rmutex [thread::mutex create -recursive] set c [regexp {rid[0-9]+} $rmutex] thread::mutex destroy $rmutex set c } {1} test thread-19.5 {thread::mutex - lock/unlock exclusive mutex} { set emutex [thread::mutex create] thread::mutex lock $emutex thread::mutex unlock $emutex thread::mutex destroy $emutex } {} test thread-19.6 {thread::mutex - deadlock exclusive mutex} { set emutex [thread::mutex create] thread::mutex lock $emutex set x [catch {thread::mutex lock $emutex} msg] thread::mutex unlock $emutex thread::mutex destroy $emutex list $x $msg } {1 {locking the same exclusive mutex twice from the same thread}} test thread-19.7 {thread::mutex - lock invalid mutex} { set x [catch {thread::mutex lock dummy} msg] list $x $msg } {1 {no such mutex "dummy"}} test thread-19.8 {thread::mutex - lock/unlock recursive mutex} { set rmutex [thread::mutex create -recursive] thread::mutex lock $rmutex thread::mutex unlock $rmutex thread::mutex destroy $rmutex } {} test thread-19.9 {thread::mutex - deadlock exclusive mutex} { set rmutex [thread::mutex create -recursive] thread::mutex lock $rmutex set x [catch {thread::mutex lock $rmutex} msg] thread::mutex unlock $rmutex thread::mutex unlock $rmutex thread::mutex destroy $rmutex list $x $msg } {0 {}} test thread-19.10 {thread::mutex - destroy locked exclusive mutex} { set emutex [thread::mutex create] thread::mutex lock $emutex set x [catch {thread::mutex destroy $emutex} msg] thread::mutex unlock $emutex thread::mutex destroy $emutex list $x $msg } {1 {mutex is in use}} test thread-19.11 {thread::mutex - destroy locked recursive mutex} { set rmutex [thread::mutex create -recursive] thread::mutex lock $rmutex set x [catch {thread::mutex destroy $rmutex} msg] thread::mutex unlock $rmutex thread::mutex destroy $rmutex list $x $msg } {1 {mutex is in use}} test thread-19.12 {thread::mutex - lock exclusive between threads} { ThreadReap set tid [thread::create] set emutex [thread::mutex create] thread::send -async $tid [subst { thread::mutex lock $emutex after 2000 thread::mutex unlock $emutex }] update after 10 set time1 [clock seconds] thread::mutex lock $emutex set time2 [clock seconds] thread::mutex unlock $emutex ThreadReap thread::mutex destroy $emutex expr {($time2 - $time1) >= 1} } {1} test thread-19.13 {thread::mutex - lock args} { set x [catch {thread::mutex lock} msg] list $x $msg } {1 {wrong # args: should be "thread::mutex lock mutexHandle"}} test thread-19.14 {thread::mutex - unlock args} { set x [catch {thread::mutex unlock} msg] list $x $msg } {1 {wrong # args: should be "thread::mutex unlock mutexHandle"}} test thread-19.15 {thread::mutex - destroy args} { set x [catch {thread::mutex destroy} msg] list $x $msg } {1 {wrong # args: should be "thread::mutex destroy mutexHandle"}} test thread-20.0 {thread::rwmutex - args} { set x [catch {thread::rwmutex} msg] list $x $msg } {1 {wrong # args: should be "thread::rwmutex option ?args?"}} test thread-20.1 {thread::rwmutex - command options} { set x [catch {thread::rwmutex dummy} msg] list $x $msg } {1 {bad option "dummy": must be create, destroy, rlock, wlock, or unlock}} test thread-20.2 {thread::rwmutex - more command options} { set x [catch {thread::rwmutex create dummy} msg] list $x $msg } {1 {wrong # args: should be "thread::rwmutex create"}} test thread-20.3 {thread::rwmutex - more command options} { set x [catch {thread::rwmutex create dummy} msg] list $x $msg } {1 {wrong # args: should be "thread::rwmutex create"}} test thread-20.4 {thread::rwmutex - mutex handle} { set rwmutex [thread::rwmutex create] set c [regexp {wid[0-9]+} $rwmutex] thread::rwmutex destroy $rwmutex set c } {1} test thread-20.5 {thread::rwmutex - bad handle} { set x [catch {thread::rwmutex rlock dummy} msg] list $x $msg } {1 {no such mutex "dummy"}} test thread-20.6 {thread::mutex - destroy readlocked mutex} { set rwmutex [thread::rwmutex create] thread::rwmutex rlock $rwmutex set x [catch {thread::rwmutex destroy $rwmutex} msg] thread::rwmutex unlock $rwmutex thread::rwmutex destroy $rwmutex list $x $msg } {1 {mutex is in use}} test thread-20.7 {thread::mutex - destroy writelocked mutex} { set rwmutex [thread::rwmutex create] thread::rwmutex wlock $rwmutex set x [catch {thread::rwmutex destroy $rwmutex} msg] thread::rwmutex unlock $rwmutex thread::rwmutex destroy $rwmutex list $x $msg } {1 {mutex is in use}} test thread-20.8 {thread::rwmutex - readlock mutex} { ThreadReap set tid [thread::create] set rwmutex [thread::rwmutex create] thread::send -async $tid [subst { thread::rwmutex rlock $rwmutex after 1000 thread::rwmutex unlock $rwmutex }] update after 10 set time1 [clock seconds] thread::rwmutex rlock $rwmutex set time2 [clock seconds] thread::rwmutex unlock $rwmutex ThreadReap thread::rwmutex destroy $rwmutex expr {($time2 - $time1) < 1} } {1} test thread-20.9 {thread::rwmutex - writelock mutex} { ThreadReap set tid [thread::create] set rwmutex [thread::rwmutex create] thread::send -async $tid [subst { thread::rwmutex wlock $rwmutex after 2000 thread::rwmutex unlock $rwmutex }] update after 10 set time1 [clock seconds] thread::rwmutex rlock $rwmutex set time2 [clock seconds] thread::rwmutex unlock $rwmutex ThreadReap thread::rwmutex destroy $rwmutex expr {($time2 - $time1) >= 1} } {1} test thread-20.10 {thread::rwmutex - readlock args} { set x [catch {thread::rwmutex rlock} msg] list $x $msg } {1 {wrong # args: should be "thread::rwmutex rlock mutexHandle"}} test thread-20.11 {thread::rwmutex - writelock args} { set x [catch {thread::rwmutex wlock} msg] list $x $msg } {1 {wrong # args: should be "thread::rwmutex wlock mutexHandle"}} test thread-20.12 {thread::rwmutex - unlock args} { set x [catch {thread::rwmutex unlock} msg] list $x $msg } {1 {wrong # args: should be "thread::rwmutex unlock mutexHandle"}} test thread-20.13 {thread::rwmutex - destroy args} { set x [catch {thread::rwmutex destroy} msg] list $x $msg } {1 {wrong # args: should be "thread::rwmutex destroy mutexHandle"}} test thread-20.14 {thread::mutex - write-lock write-locked mutex} { set rwmutex [thread::rwmutex create] thread::rwmutex wlock $rwmutex set x [catch {thread::rwmutex wlock $rwmutex} msg] thread::rwmutex unlock $rwmutex thread::rwmutex destroy $rwmutex list $x $msg } {1 {write-locking the same read-write mutex twice from the same thread}} test thread-20.15 {thread::mutex - read-lock write-locked mutex} { set rwmutex [thread::rwmutex create] thread::rwmutex wlock $rwmutex set x [catch {thread::rwmutex rlock $rwmutex} msg] thread::rwmutex unlock $rwmutex thread::rwmutex destroy $rwmutex list $x $msg } {1 {read-locking already write-locked mutex from the same thread}} test thread-20.16 {thread::mutex - unlock not locked mutex} { set rwmutex [thread::rwmutex create] set x [catch {thread::rwmutex unlock $rwmutex} msg] thread::rwmutex destroy $rwmutex list $x $msg } {1 {mutex is not locked}} test thread-21.0 {thread::cond - args} { set x [catch {thread::cond} msg] list $x $msg } {1 {wrong # args: should be "thread::cond option ?args?"}} test thread-21.1 {thread::cond - command options} { set x [catch {thread::cond dummy} msg] list $x $msg } {1 {bad option "dummy": must be create, destroy, notify, or wait}} test thread-21.2 {thread::cond - more command options} { set x [catch {thread::cond create dummy} msg] list $x $msg } {1 {wrong # args: should be "thread::cond create"}} test thread-21.3 {thread::cond - cond handle} { set cond [thread::cond create] set c [regexp {cid[0-9]+} $cond] thread::cond destroy $cond set c } {1} test thread-21.4 {thread::cond - destroy args} { set x [catch {thread::cond destroy} msg] list $x $msg } {1 {wrong # args: should be "thread::cond destroy condHandle ?args?"}} test thread-21.5 {thread::cond - destroy bad handle} { set x [catch {thread::cond destroy dummy} msg] list $x $msg } {1 {no such condition variable "dummy"}} test thread-21.6 {thread::cond - notify args} { set x [catch {thread::cond notify} msg] list $x $msg } {1 {wrong # args: should be "thread::cond notify condHandle ?args?"}} test thread-21.7 {thread::cond - wait args} { set x [catch {thread::cond wait} msg] list $x $msg } {1 {wrong # args: should be "thread::cond wait condHandle ?args?"}} test thread-21.8 {thread::cond - wait bad handle} { set x [catch {thread::cond wait dummy} msg] list $x $msg } {1 {no such condition variable "dummy"}} test thread-21.9 {thread::cond - wait no mutex} { set cond [thread::cond create] set x [catch {thread::cond wait $cond} msg] thread::cond destroy $cond list $x $msg } {1 {wrong # args: should be "thread::cond wait condHandle mutexHandle ?timeout?"}} test thread-21.10 {thread::cond - wait bad mutex} { set cond [thread::cond create] set x [catch {thread::cond wait $cond dummy} msg] thread::cond destroy $cond list $x $msg } {1 {no such mutex "dummy"}} test thread-21.11 {thread::cond - wait unlocked mutex} { set cond [thread::cond create] set emutex [thread::mutex create] set x [catch {thread::cond wait $cond $emutex} msg] thread::cond destroy $cond thread::mutex destroy $emutex list $x $msg } {1 {mutex not locked or wrong type}} test thread-21.12 {thread::cond - wait locked mutex from wrong thread} { ThreadReap set tid [thread::create] set emutex [thread::mutex create] set cond [thread::cond create] thread::mutex lock $emutex thread::send -async $tid [subst -nocommands { set code [catch {thread::cond wait $cond $emutex 1000} result] }] update after 20 thread::cond notify $cond set c [thread::send $tid "set code"] set r [thread::send $tid "set result"] ThreadReap thread::cond destroy $cond thread::mutex unlock $emutex thread::mutex destroy $emutex list $c $r } {1 {mutex not locked or wrong type}} test thread-21.13 {thread::cond - wait recursive mutex} { set cond [thread::cond create] set rmutex [thread::mutex create -recursive] set x [catch {thread::cond wait $cond $rmutex} msg] thread::cond destroy $cond thread::mutex destroy $rmutex list $x $msg } {1 {mutex not locked or wrong type}} test thread-21.14 {thread::cond - wait readwrite mutex} { set cond [thread::cond create] set rwmutex [thread::rwmutex create] set x [catch {thread::cond wait $cond $rwmutex} msg] thread::cond destroy $cond thread::rwmutex destroy $rwmutex list $x $msg } {1 {mutex not locked or wrong type}} test thread-21.15 {thread::cond - regular timed wait} { ThreadReap set tid [thread::create] set emutex [thread::mutex create] set cond [thread::cond create] thread::send -async $tid [subst { thread::mutex lock $emutex thread::cond wait $cond $emutex 2000 thread::mutex unlock $emutex set test 1 }] update after 10 set time1 [clock seconds] thread::cond notify $cond set c [thread::send $tid "info exists test"] set time2 [clock seconds] ThreadReap thread::mutex destroy $emutex thread::cond destroy $cond list $c [expr {($time2 - $time1) < 2}] } {1 1} test thread-21.16 {thread::cond - delete waited variable} { ThreadReap set tid [thread::create] set emutex [thread::mutex create] set cond [thread::cond create] thread::send -async $tid [subst { thread::mutex lock $emutex thread::cond wait $cond $emutex 500 thread::mutex unlock $emutex }] update after 10 set c1 [catch {thread::cond destroy $cond} r1] thread::cond notify $cond after 1000 set c2 [catch {thread::cond destroy $cond} r2] ThreadReap thread::mutex destroy $emutex list $c1 $c2 $r1 $r2 } {1 0 {condition variable is in use} {}} removeFile dummyForTransfer ::tcltest::cleanupTests