# 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} {
    set cmds [info commands thread::*]
    set idx [lsearch -exact $cmds ::thread::cancel]
    lsort [lreplace $cmds $idx $idx]
} {::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-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 <mutexHandle>? 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 <mutexHandle>? 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 <mutexHandle>? 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