diff options
Diffstat (limited to 'tests/ioCmd.test')
| -rw-r--r-- | tests/ioCmd.test | 583 |
1 files changed, 388 insertions, 195 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test index e2a6d84..f66480a 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -18,10 +18,13 @@ if {[lsearch [namespace children] ::tcltest] == -1} { namespace import -force ::tcltest::* } +::tcltest::loadTestedCommands +catch [list package require -exact Tcltest [info patchlevel]] + # Custom constraints used in this file testConstraint fcopy [llength [info commands fcopy]] testConstraint testchannel [llength [info commands testchannel]] -testConstraint testthread [llength [info commands testthread]] +testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}] #---------------------------------------------------------------------- @@ -133,10 +136,10 @@ test iocmd-4.8 {read command with incorrect combination of arguments} { set x [list [catch {read -nonewline $f 20 z} msg] $msg $::errorCode] close $f set x -} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE} +} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} {TCL WRONGARGS}} test iocmd-4.9 {read command} { list [catch {read stdin foo} msg] $msg $::errorCode -} {1 {expected integer but got "foo"} {TCL VALUE NUMBER}} +} {1 {expected non-negative integer but got "foo"} {TCL VALUE NUMBER}} test iocmd-4.10 {read command} { list [catch {read file107} msg] $msg $::errorCode } {1 {can not find channel named "file107"} {TCL LOOKUP CHANNEL file107}} @@ -148,25 +151,26 @@ test iocmd-4.11 {read command} { string compare [string tolower $x] \ [list 1 [format "channel \"%s\" wasn't opened for reading" $f] none] } 0 -test iocmd-4.12 {read command} { +test iocmd-4.12 {read command} -setup { set f [open $path(test1)] - set x [list [catch {read $f 12z} msg] $msg $::errorCode] +} -body { + list [catch {read $f 12z} msg] $msg $::errorCode +} -cleanup { close $f - set x -} {1 {expected integer but got "12z"} {TCL VALUE NUMBER}} - -test iocmd-5.1 {seek command} { - list [catch {seek} msg] $msg -} {1 {wrong # args: should be "seek channelId offset ?origin?"}} -test iocmd-5.2 {seek command} { - list [catch {seek a b c d e f g} msg] $msg -} {1 {wrong # args: should be "seek channelId offset ?origin?"}} -test iocmd-5.3 {seek command} { - list [catch {seek stdin gugu} msg] $msg -} {1 {expected integer but got "gugu"}} -test iocmd-5.4 {seek command} { - list [catch {seek stdin 100 gugu} msg] $msg -} {1 {bad origin "gugu": must be start, current, or end}} +} -result {1 {expected non-negative integer but got "12z"} {TCL VALUE NUMBER}} + +test iocmd-5.1 {seek command} -returnCodes error -body { + seek +} -result {wrong # args: should be "seek channelId offset ?origin?"} +test iocmd-5.2 {seek command} -returnCodes error -body { + seek a b c d e f g +} -result {wrong # args: should be "seek channelId offset ?origin?"} +test iocmd-5.3 {seek command} -returnCodes error -body { + seek stdin gugu +} -result {expected integer but got "gugu"} +test iocmd-5.4 {seek command} -returnCodes error -body { + seek stdin 100 gugu +} -result {bad origin "gugu": must be start, current, or end} test iocmd-6.1 {tell command} { list [catch {tell} msg] $msg @@ -180,20 +184,34 @@ test iocmd-6.3 {tell command} { test iocmd-7.1 {close command} { list [catch {close} msg] $msg -} {1 {wrong # args: should be "close channelId"}} +} {1 {wrong # args: should be "close channelId ?direction?"}} test iocmd-7.2 {close command} { list [catch {close a b c d e} msg] $msg -} {1 {wrong # args: should be "close channelId"}} +} {1 {wrong # args: should be "close channelId ?direction?"}} test iocmd-7.3 {close command} { list [catch {close aaa} msg] $msg } {1 {can not find channel named "aaa"}} +test iocmd-7.4 {close command} -setup { + set chan [open [info script] r] +} -body { + chan close $chan bar +} -cleanup { + close $chan +} -returnCodes error -result "bad direction \"bar\": must be read or write" +test iocmd-7.5 {close command} -setup { + set chan [open [info script] r] +} -body { + chan close $chan write +} -cleanup { + close $chan +} -returnCodes error -result "Half-close of write-side not possible, side not opened or already closed" test iocmd-8.1 {fconfigure command} { list [catch {fconfigure} msg] $msg -} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}} +} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}} test iocmd-8.2 {fconfigure command} { list [catch {fconfigure a b c d e f} msg] $msg -} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}} +} {1 {wrong # args: should be "fconfigure channelId ?-option value ...?"}} test iocmd-8.3 {fconfigure command} { list [catch {fconfigure a b} msg] $msg } {1 {can not find channel named "a"}} @@ -276,7 +294,7 @@ test iocmd-8.15.1 {fconfigure command / tcp channel} -constraints {socket unixOr close $srv unset cli srv port rename iocmdSRV {} -} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname} +} -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -connecting, -peername, or -sockname} test iocmd-8.16 {fconfigure command / tcp channel} -constraints socket -setup { set srv [socket -server iocmdSRV -myaddr 127.0.0.1 0] set port [lindex [fconfigure $srv -sockname] 2] @@ -331,15 +349,15 @@ test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable close $tty } } -returnCodes error -result {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, -handshake, -pollinterval, -sysbuffer, -timeout, -ttycontrol, or -xchar} -# TODO: Test parsing of serial channel options (nonportable, since requires an +# TODO: Test parsing of serial channel options (nonPortable, since requires an # open channel to work with). test iocmd-9.1 {eof command} { list [catch {eof} msg] $msg $::errorCode -} {1 {wrong # args: should be "eof channelId"} NONE} +} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}} test iocmd-9.2 {eof command} { list [catch {eof a b} msg] $msg $::errorCode -} {1 {wrong # args: should be "eof channelId"} NONE} +} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}} test iocmd-9.3 {eof command} { catch {close file100} list [catch {eof file100} msg] $msg $::errorCode @@ -371,13 +389,13 @@ test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} { set f [open $path(test4) w] close $f list [catch {open "| cat < \"$path(test4)\" > \"$path(test5)\"" w} msg] $msg $::errorCode -} {1 {can't write input to command: standard input was redirected} NONE} +} {1 {can't write input to command: standard input was redirected} {TCL OPERATION EXEC BADREDIRECT}} test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r} msg] $msg $::errorCode -} {1 {can't read output from command: standard output was redirected} NONE} +} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}} test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} { list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode -} {1 {can't read output from command: standard output was redirected} NONE} +} {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}} test iocmd-11.4 {I/O to command pipelines} unixOrPc { list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode } {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}} @@ -527,6 +545,27 @@ test iocmd-13.10.2 {open for append, O_APPEND} -setup { # Ensure that channels are gone, even if body failed to do so foreach ch $chans {catch {close $ch}} } -result {0 1 2 3 4 5 6 7 8 9} +test ioCmd-13.11 {open ... a+ must not use O_APPEND: Bug 1773127} -setup { + set f [makeFile {} ioutil41.tmp] + set fid [open $f wb] + puts -nonewline $fid 123 + close $fid +} -body { + set fid [open $f ab+] + puts -nonewline $fid 456 + seek $fid 2 + set d [read $fid 2] + seek $fid 4 + puts -nonewline $fid x + close $fid + set fid [open $f rb] + append d [read $fid] + close $fid + return $d +} -cleanup { + removeFile $f +} -result 341234x6 + test iocmd-14.1 {file id parsing errors} { list [catch {eof gorp} msg] $msg $::errorCode @@ -600,7 +639,7 @@ test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} { } "1 {channel \"$rfile\" wasn't opened for writing}" test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $wfile foo bar} msg] $msg -} {1 {bad switch "foo": must be -size or -command}} +} {1 {bad option "foo": must be -size or -command}} test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} { list [catch {fcopy $rfile $wfile -size foo} msg] $msg } {1 {expected integer but got "foo"}} @@ -617,11 +656,10 @@ close $wfile test iocmd-20.0 {chan, wrong#args} { catch {chan} msg set msg -} {wrong # args: should be "chan subcommand ?argument ...?"} -test iocmd-20.1 {chan, unknown method} { - catch {chan foo} msg - set msg -} {unknown or ambiguous subcommand "foo": must be blocked, close, configure, copy, create, eof, event, flush, gets, names, pending, postevent, puts, read, seek, tell, or truncate} +} {wrong # args: should be "chan subcommand ?arg ...?"} +test iocmd-20.1 {chan, unknown method} -body { + chan foo +} -returnCodes error -match glob -result {unknown or ambiguous subcommand "foo": must be *} # --- --- --- --------- --------- --------- # chan create, and method "initalize" @@ -2054,7 +2092,6 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m # response. interp eval $idb [list set chan $chan] - interp eval $idb [list set mid $tcltest::mainThread] set res [interp eval $idb { # wait a bit, give the main thread the time to start its event # loop to wait for the response from B @@ -2071,9 +2108,9 @@ test iocmd-32.2 {delete interp of reflected chan} { # on the double free interp create slave slave eval { - proc no-op args {} - proc driver {sub args} {return {initialize finalize watch read}} - chan event [chan create read driver] readable no-op + proc no-op args {} + proc driver {sub args} {return {initialize finalize watch read}} + chan event [chan create read driver] readable no-op } interp delete slave } {} @@ -2090,23 +2127,6 @@ test iocmd-32.2 {delete interp of reflected chan} { ## forwarding, and gaps due to tests not applicable to forwarding are ## left to keep this asociation. -# Duplicate of code in "thread.test". Find a better way of doing this -# without duplication. Maybe placement into a proc which transforms to -# nop after the first call, and placement of its defintion in a -# central location. - -if {[testConstraint testthread]} { - testthread errorproc ThreadError - - proc ThreadError {id info} { - global threadError - set threadError $info - } - proc ThreadNullError {id info} { - # ignore - } -} - # ### ### ### ######### ######### ######### ## Helper command. Runs a script in a separate thread and returns the ## result. A channel is transfered into the thread as well, and list of @@ -2115,7 +2135,8 @@ if {[testConstraint testthread]} { proc inthread {chan script args} { # Test thread. - set tid [testthread create] + set tid [thread::create -preserved] + thread::send $tid {load {} Tcltest} # Init thread configuration. # - Listed variables @@ -2124,22 +2145,23 @@ proc inthread {chan script args} { foreach v $args { upvar 1 $v x - testthread send $tid [list set $v $x] + thread::send $tid [list set $v $x] + } - testthread send $tid [list set mid $tcltest::mainThread] - testthread send $tid { + thread::send $tid [list set mid [thread::id]] + thread::send $tid { proc note {item} {global notes; lappend notes $item} proc notes {} {global notes; return $notes} proc noteOpts opts {global notes; lappend notes [dict merge { -code !?! -level !?! -errorcode !?! -errorline !?! -errorinfo !?! } $opts]} } - testthread send $tid [list proc s {} [list uplevel 1 $script]]; # (*) + thread::send $tid [list proc s {} [list uplevel 1 $script]]; # (*) # Transfer channel (cut/splice aka detach/attach) testchannel cut $chan - testthread send $tid [list testchannel splice $chan] + thread::send $tid [list testchannel splice $chan] # Run test script, also run local event loop! # The local event loop waits for the result to come back. @@ -2147,15 +2169,15 @@ proc inthread {chan script args} { # operations. set ::tres "" - testthread send -async $tid { + thread::send -async $tid { after 500 catch {s} res; # This runs the script, 's' was defined at (*) - testthread send -async $mid [list set ::tres $res] + thread::send -async $mid [list set ::tres $res] } vwait ::tres # Remove test thread, and return the captured result. - tcltest::threadReap + thread::release $tid return $::tres } @@ -2176,7 +2198,7 @@ test iocmd.tf-22.2 {chan finalize, for close} -match glob -body { note [info command foo] rename foo {} set res -} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo} +} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} {} foo} test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code error 5} @@ -2189,7 +2211,7 @@ test iocmd.tf-22.3 {chan finalize, for close, error, close error} -match glob -b } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}} +} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 5 {}} test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob -body { set res {} proc foo {args} {track; oninit; error FOO} @@ -2200,7 +2222,7 @@ test iocmd.tf-22.4 {chan finalize, for close, error, close errror} -match glob - } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO} +} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 1 FOO} test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -body { set res {} proc foo {args} {track; oninit; return SOMETHING} @@ -2211,7 +2233,7 @@ test iocmd.tf-22.5 {chan finalize, for close, arbitrary result} -match glob -bod } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}} +} -constraints {testchannel thread} -result {{initialize rc* {read write}} rc* {finalize rc*} 0 {}} test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code 3} @@ -2223,7 +2245,7 @@ test iocmd.tf-22.6 {chan finalize, for close, break, close error} -match glob -b rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code 4} @@ -2235,7 +2257,7 @@ test iocmd.tf-22.7 {chan finalize, for close, continue, close error} -match glob rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -code 777 BANG} @@ -2247,7 +2269,7 @@ test iocmd.tf-22.8 {chan finalize, for close, custom code, close error} -match g rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match glob -body { set res {} proc foo {args} {track; oninit; return -level 5 -code 777 BANG} @@ -2259,7 +2281,7 @@ test iocmd.tf-22.9 {chan finalize, for close, ignore level, close error} -match rename foo {} set res } -result {{initialize rc* {read write}} rc* {finalize rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "finalize"*}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} # --- === *** ########################### # method read @@ -2278,7 +2300,7 @@ test iocmd.tf-23.1 {chan read, regular data return} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{read rc* 4096} {read rc* 4096} snarfsnarf} +} -constraints {testchannel thread} -result {{read rc* 4096} {read rc* 4096} {watch rc* {}} snarfsnarf} test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body { set res {} proc foo {args} { @@ -2293,7 +2315,7 @@ test iocmd.tf-23.2 {chan read, bad data return, to much} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{read rc* 4096} 1 {read delivered more than requested}} +} -constraints {testchannel thread} -result {{read rc* 4096} {watch rc* {}} 1 {read delivered more than requested}} test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body { set res {} proc foo {args} { @@ -2307,7 +2329,7 @@ test iocmd.tf-23.3 {chan read, for non-readable channel} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for reading}} +} -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for reading}} test iocmd.tf-23.4 {chan read, error return} -match glob -body { set res {} proc foo {args} { @@ -2322,8 +2344,8 @@ test iocmd.tf-23.4 {chan read, error return} -match glob -body { } c] rename foo {} set res -} -result {{read rc* 4096} 1 BOOM!} \ - -constraints {testchannel testthread} +} -result {{read rc* 4096} {watch rc* {}} 1 BOOM!} \ + -constraints {testchannel thread} test iocmd.tf-23.5 {chan read, break return is error} -match glob -body { set res {} proc foo {args} { @@ -2338,8 +2360,8 @@ test iocmd.tf-23.5 {chan read, break return is error} -match glob -body { } c] rename foo {} set res -} -result {{read rc* 4096} 1 *bad code*} \ - -constraints {testchannel testthread} +} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*} \ + -constraints {testchannel thread} test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body { set res {} proc foo {args} { @@ -2354,8 +2376,8 @@ test iocmd.tf-23.6 {chan read, continue return is error} -match glob -body { } c] rename foo {} set res -} -result {{read rc* 4096} 1 *bad code*} \ - -constraints {testchannel testthread} +} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*} \ + -constraints {testchannel thread} test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body { set res {} proc foo {args} { @@ -2370,8 +2392,8 @@ test iocmd.tf-23.7 {chan read, custom return is error} -match glob -body { } c] rename foo {} set res -} -result {{read rc* 4096} 1 *bad code*} \ - -constraints {testchannel testthread} +} -result {{read rc* 4096} {watch rc* {}} 1 *bad code*} \ + -constraints {testchannel thread} test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body { set res {} proc foo {args} { @@ -2386,8 +2408,8 @@ test iocmd.tf-23.8 {chan read, level is squashed} -match glob -body { } c] rename foo {} set res -} -result {{read rc* 4096} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \ - -constraints {testchannel testthread} +} -result {{read rc* 4096} {watch rc* {}} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "read"*}} \ + -constraints {testchannel thread} test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup { set res {} proc foo {args} { @@ -2406,8 +2428,8 @@ test iocmd.tf-23.9 {chan read, no data means eof} -match glob -setup { } -cleanup { rename foo {} unset res -} -result {{read rc* 4096} {} 1} \ - -constraints {testchannel testthread} +} -result {{read rc* 4096} {watch rc* {}} {} 1} \ + -constraints {testchannel thread} test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glob -setup { set res {} proc foo {args} { @@ -2426,8 +2448,8 @@ test iocmd.tf-23.10 {chan read, EAGAIN means no data, yet no eof either} -match } -cleanup { rename foo {} unset res -} -result {{read rc* 4096} {} 0} \ - -constraints {testchannel testthread} +} -result {{read rc* 4096} {watch rc* {}} {} 0} \ + -constraints {testchannel thread} # --- === *** ########################### # method write @@ -2447,7 +2469,7 @@ test iocmd.tf-24.1 {chan write, regular write} -match glob -body { } c rename foo {} set res -} -constraints {testchannel testthread} -result {{write rc* snarf} 5} +} -constraints {testchannel thread} -result {{write rc* snarf} 5} test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body { set res {} proc foo {args} { @@ -2464,7 +2486,7 @@ test iocmd.tf-24.2 {chan write, ack partial writes} -match glob -body { } c rename foo {} set res -} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8} +} -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} 7 {write rc* arfsnarf} 8} test iocmd.tf-24.3 {chan write, failed write} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note -1; return -1} @@ -2475,7 +2497,7 @@ test iocmd.tf-24.3 {chan write, failed write} -match glob -body { } c rename foo {} set res -} -constraints {testchannel testthread} -result {{write rc* snarfsnarfsnarf} -1} +} -constraints {testchannel thread} -result {{write rc* snarfsnarfsnarf} -1} test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} @@ -2488,7 +2510,7 @@ test iocmd.tf-24.4 {chan write, non-writable channel} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {1 {channel "rc*" wasn't opened for writing}} +} -constraints {testchannel thread} -result {1 {channel "rc*" wasn't opened for writing}} test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return 10000} @@ -2501,7 +2523,7 @@ test iocmd.tf-24.5 {chan write, bad result, more written than data} -match glob } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}} +} -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}} test iocmd.tf-24.6 {chan write, zero writes} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return 0} @@ -2514,7 +2536,7 @@ test iocmd.tf-24.6 {chan write, zero writes} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{write rc* snarf} 1 {write wrote more than requested}} +} -constraints {testchannel thread} -result {{write rc* snarf} 1 {write wrote more than requested}} test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code error BOOM!} @@ -2528,7 +2550,7 @@ test iocmd.tf-24.7 {chan write, failed write, error return} -match glob -body { rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; error BOOM!} @@ -2542,7 +2564,7 @@ test iocmd.tf-24.8 {chan write, failed write, error return} -match glob -body { rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 BOOM!} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code break BOOM!} @@ -2556,7 +2578,7 @@ test iocmd.tf-24.9 {chan write, failed write, break return is error} -match glob rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code continue BOOM!} @@ -2570,7 +2592,7 @@ test iocmd.tf-24.10 {chan write, failed write, continue return is error} -match rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code 777 BOOM!} @@ -2584,7 +2606,7 @@ test iocmd.tf-24.11 {chan write, failed write, custom return is error} -match gl rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return BANG} @@ -2598,7 +2620,7 @@ test iocmd.tf-24.12 {chan write, failed write, non-numeric return is error} -mat rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 {expected integer but got "BANG"}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -level 55 -code 777 BOOM!} @@ -2613,7 +2635,7 @@ test iocmd.tf-24.13 {chan write, failed write, level is ignored} -match glob -bo rename foo {} set res } -result {{write rc* snarfsnarfsnarf} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "write"*}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-24.14 {chan write, no EAGAIN means that writing is allowed at this time, bug 2936225} -match glob -setup { set res {} proc foo {args} { @@ -2632,7 +2654,7 @@ test iocmd.tf-24.14 {chan write, no EAGAIN means that writing is allowed at this rename foo {} unset res } -result {{write rc* ABC} {}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at this time, bug 2936225} -match glob -setup { set res {} proc foo {args} { @@ -2652,10 +2674,163 @@ test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at thi } c] set res } -cleanup { + proc foo {args} {onfinal; set ::done-24.15 1; return 3} + after 1000 {set ::done-24.15 2} + vwait done-24.15 rename foo {} unset res } -result {{write rc* ABC} {watch rc* write} {}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} + +test iocmd.tf-24.16 {chan write, note the background flush setup by close due to the EAGAIN leaving data in buffers.} -match glob -setup { + set res {} + proc foo {args} { + oninit; onfinal; track + # Note: The EAGAIN signals that the channel cannot accept + # write requests right now, this in turn causes the IO core to + # request the generation of writable events (see expected + # result below, and compare to case 24.14 above). + error EAGAIN + } + set c [chan create {r w} foo] +} -body { + notes [inthread $c { + note [puts -nonewline $c ABC ; flush $c] + close $c + notes + } c] + # Replace handler with all-tracking one which doesn't error. + # This will tell us if a write-due-flush is there. + proc foo {args} { onfinal; note BG ; track ; set ::endbody-24.16 1} + # Flush (sic!) the event-queue to capture the write from a + # BG-flush. + after 1000 {set ::endbody-24.16 2} + vwait endbody-24.16 + set res +} -cleanup { + proc foo {args} {onfinal; set ::done-24.16 1; return 3} + after 1000 {set ::done-24.16 2} + vwait done-24.16 + rename foo {} + unset res +} -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \ + -constraints {testchannel thread} + +test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \ + -constraints {testchannel thread} -setup { + # This test exposes how the execution of postevent in the handler thread causes + # a crash if we are not properly injecting the events into the owning thread instead. + # With the injection the test will simply complete without crash. + + set beat 10000 + set drive 999 + set data ...---... + + proc LOG {text} { + #puts stderr "[thread::id]: $text" + return + } + + proc POST {hi} { + LOG "-> [info level 0]" + chan postevent $hi read + LOG "<- [info level 0]" + + set ::timer [after $::drive [info level 0]] + return + } + + proc HANDLER {op ch args} { + lappend ::res [lrange [info level 0] 1 end] + LOG "-> [info level 0]" + set ret {} + switch -glob -- $op { + init* {set ret {initialize finalize watch read}} + watch { + set l [lindex $args 0] + catch {after cancel $::timer} + if {[llength $l]} { + set ::timer [after $::drive [list POST $ch]] + } + } + finalize { + catch { after cancel $::timer } + after 500 {set ::forever now} + } + read { + set ret $::data + set ::data {} ; # Next is EOF. + } + } + LOG "<- [info level 0] : $ret" + return $ret + } +} -body { + LOG BEGIN + set ch [chan create {read} HANDLER] + + set tid [thread::create { + proc LOG {text} { + #puts stderr "\t\t\t\t\t\t[thread::id]: $text" + return + } + LOG THREAD-STARTED + load {} Tcltest + proc bgerror s { + LOG BGERROR:$s + } + vwait forever + LOG THREAD-DONE + }] + + testchannel cut $ch + thread::send $tid [list set thech $ch] + thread::send $tid [list set beat $beat] + thread::send -async $tid { + LOG SPLICE-BEG + testchannel splice $thech + LOG SPLICE-END + proc PROCESS {ch} { + LOG "-> [info level 0]" + if {[eof $ch]} { + close $ch + set ::done 1 + set c <<EOF>> + } else { + set c [read $ch 1] + } + LOG "GOTCHAR: $c" + LOG "<- [info level 0]" + } + LOG THREAD-FILEEVENT + fconfigure $thech -translation binary -blocking 0 + fileevent $thech readable [list PROCESS $thech] + LOG THREAD-NOEVENT-LOOP + set done 0 + while {!$done} { + after $beat + LOG THREAD-HEARTBEAT + update + } + LOG THREAD-LOOP-DONE + #thread::exit + # Thread exits cause leaks; Use clean thread shutdown + set forever yourGirl + } + + LOG MAIN_WAITING + vwait forever + LOG MAIN_DONE + + set res +} -cleanup { + after cancel $::timer + rename LOG {} + rename POST {} + rename HANDLER {} + unset beat drive data forever res tid ch timer +} -match glob \ + -result {{initialize rc* read} {watch rc* read} {read rc* 4096} {watch rc* {}} {watch rc* read} {read rc* 4096} {watch rc* {}} {finalize rc*}} # --- === *** ########################### # method cgetall @@ -2671,7 +2846,7 @@ test iocmd.tf-25.1 {chan configure, cgetall, standard options} -match glob -body } c] rename foo {} set res -} -constraints {testchannel testthread} \ +} -constraints {testchannel thread} \ -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { set res {} @@ -2684,7 +2859,7 @@ test iocmd.tf-25.2 {chan configure, cgetall, no options} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} \ +} -constraints {testchannel thread} \ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *}}} test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { set res {} @@ -2700,7 +2875,7 @@ test iocmd.tf-25.3 {chan configure, cgetall, regular result} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} \ +} -constraints {testchannel thread} \ -result {{cgetall rc*} {-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {{} {}} -translation {auto *} -bar foo -snarf x}} test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} -match glob -body { set res {} @@ -2717,7 +2892,7 @@ test iocmd.tf-25.4 {chan configure, cgetall, bad result, list of uneven length} } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}} +} -constraints {testchannel thread} -result {{cgetall rc*} 1 {Expected list with even number of elements, got 1 element instead}} test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob -body { set res {} proc foo {args} { @@ -2733,7 +2908,7 @@ test iocmd.tf-25.5 {chan configure, cgetall, bad result, not a list} -match glob } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{cgetall rc*} 1 {unmatched open brace in list}} +} -constraints {testchannel thread} -result {{cgetall rc*} 1 {unmatched open brace in list}} test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body { set res {} proc foo {args} { @@ -2749,7 +2924,7 @@ test iocmd.tf-25.6 {chan configure, cgetall, error return} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{cgetall rc*} 1 BOOM!} +} -constraints {testchannel thread} -result {{cgetall rc*} 1 BOOM!} test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob -body { set res {} proc foo {args} { @@ -2766,7 +2941,7 @@ test iocmd.tf-25.7 {chan configure, cgetall, break return is error} -match glob rename foo {} set res } -result {{cgetall rc*} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match glob -body { set res {} proc foo {args} { @@ -2783,7 +2958,7 @@ test iocmd.tf-25.8 {chan configure, cgetall, continue return is error} -match gl rename foo {} set res } -result {{cgetall rc*} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob -body { set res {} proc foo {args} { @@ -2800,7 +2975,7 @@ test iocmd.tf-25.9 {chan configure, cgetall, custom return is error} -match glob rename foo {} set res } -result {{cgetall rc*} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -body { set res {} proc foo {args} { @@ -2818,7 +2993,7 @@ test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -bod rename foo {} set res } -result {{cgetall rc*} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cgetall"*}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} # --- === *** ########################### # method configure @@ -2826,7 +3001,7 @@ test iocmd.tf-25.10 {chan configure, cgetall, level is ignored} -match glob -bod test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body { set res {} proc foo {args} { - oninit configure; onfinal; track; note MUST_NOT_HAPPEN; return + oninit configure; onfinal; track; return } set c [chan create {r w} foo] notes [inthread $c { @@ -2836,7 +3011,7 @@ test iocmd.tf-26.1 {chan configure, set standard option} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{}} +} -constraints {testchannel thread} -result {{watch rc* {}} {}} test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body { set res {} proc foo {args} { @@ -2852,7 +3027,7 @@ test iocmd.tf-26.2 {chan configure, set option, error return} -match glob -body } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} 1 BOOM!} +} -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} 1 BOOM!} test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body { set res {} proc foo {args} {oninit configure; onfinal; track; return} @@ -2864,7 +3039,7 @@ test iocmd.tf-26.3 {chan configure, set option, ok return} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{configure rc* -rc-foo bar} {}} +} -constraints {testchannel thread} -result {{configure rc* -rc-foo bar} {}} test iocmd.tf-26.4 {chan configure, set option, break return is error} -match glob -body { set res {} proc foo {args} { @@ -2881,7 +3056,7 @@ test iocmd.tf-26.4 {chan configure, set option, break return is error} -match gl rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match glob -body { set res {} proc foo {args} { @@ -2898,7 +3073,7 @@ test iocmd.tf-26.5 {chan configure, set option, continue return is error} -match rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match glob -body { set res {} proc foo {args} { @@ -2915,7 +3090,7 @@ test iocmd.tf-26.6 {chan configure, set option, custom return is error} -match g rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -body { set res {} proc foo {args} { @@ -2933,7 +3108,7 @@ test iocmd.tf-26.7 {chan configure, set option, level is ignored} -match glob -b rename foo {} set res } -result {{configure rc* -rc-foo bar} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "configure"*}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} # --- === *** ########################### # method cget @@ -2949,7 +3124,7 @@ test iocmd.tf-27.1 {chan configure, get option, ok return} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} foo} +} -constraints {testchannel thread} -result {{cget rc* -rc-foo} foo} test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body { set res {} proc foo {args} { @@ -2965,7 +3140,7 @@ test iocmd.tf-27.2 {chan configure, get option, error return} -match glob -body } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{cget rc* -rc-foo} 1 BOOM!} +} -constraints {testchannel thread} -result {{cget rc* -rc-foo} 1 BOOM!} test iocmd.tf-27.3 {chan configure, get option, break return is error} -match glob -body { set res {} proc foo {args} { @@ -2982,7 +3157,7 @@ test iocmd.tf-27.3 {chan configure, get option, break return is error} -match gl rename foo {} set res } -result {{cget rc* -rc-foo} 1 BOOM!} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match glob -body { set res {} proc foo {args} { @@ -2999,7 +3174,7 @@ test iocmd.tf-27.4 {chan configure, get option, continue return is error} -match rename foo {} set res } -result {{cget rc* -rc-foo} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match glob -body { set res {} proc foo {args} { @@ -3016,7 +3191,7 @@ test iocmd.tf-27.5 {chan configure, get option, custom return is error} -match g rename foo {} set res } -result {{cget rc* -rc-foo} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -body { set res {} proc foo {args} { @@ -3034,7 +3209,7 @@ test iocmd.tf-27.6 {chan configure, get option, level is ignored} -match glob -b rename foo {} set res } -result {{cget rc* -rc-foo} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "cget"*}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} # --- === *** ########################### # method seek @@ -3051,7 +3226,7 @@ test iocmd.tf-28.1 {chan tell, not supported by handler} -match glob -body { rename foo {} set res } -result {-1} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.2 {chan tell, error return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} @@ -3065,7 +3240,7 @@ test iocmd.tf-28.2 {chan tell, error return} -match glob -body { rename foo {} set res } -result {{seek rc* 0 current} 1 BOOM!} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} @@ -3079,7 +3254,7 @@ test iocmd.tf-28.3 {chan tell, break return is error} -match glob -body { rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} @@ -3093,7 +3268,7 @@ test iocmd.tf-28.4 {chan tell, continue return is error} -match glob -body { rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code 222 BOOM!} @@ -3107,7 +3282,7 @@ test iocmd.tf-28.5 {chan tell, custom return is error} -match glob -body { rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -level 11 -code 222 BANG} @@ -3122,7 +3297,7 @@ test iocmd.tf-28.6 {chan tell, level is ignored} -match glob -body { rename foo {} set res } -result {{seek rc* 0 current} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.7 {chan tell, regular return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return 88} @@ -3135,7 +3310,7 @@ test iocmd.tf-28.7 {chan tell, regular return} -match glob -body { rename foo {} set res } -result {{seek rc* 0 current} 88} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.8 {chan tell, negative return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -1} @@ -3149,7 +3324,7 @@ test iocmd.tf-28.8 {chan tell, negative return} -match glob -body { rename foo {} set res } -result {{seek rc* 0 current} 1 {Tried to seek before origin}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.9 {chan tell, string return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return BOGUS} @@ -3163,7 +3338,7 @@ test iocmd.tf-28.9 {chan tell, string return} -match glob -body { rename foo {} set res } -result {{seek rc* 0 current} 1 {expected integer but got "BOGUS"}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} @@ -3177,7 +3352,7 @@ test iocmd.tf-28.10 {chan seek, not supported by handler} -match glob -body { rename foo {} set res } -result {1 {error during seek on "rc*": invalid argument}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.11 {chan seek, error return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code error BOOM!} @@ -3191,7 +3366,7 @@ test iocmd.tf-28.11 {chan seek, error return} -match glob -body { rename foo {} set res } -result {{seek rc* 0 start} 1 BOOM!} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code break BOOM!} @@ -3205,7 +3380,7 @@ test iocmd.tf-28.12 {chan seek, break return is error} -match glob -body { rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code continue BOOM!} @@ -3219,7 +3394,7 @@ test iocmd.tf-28.13 {chan seek, continue return is error} -match glob -body { rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -code 99 BOOM!} @@ -3233,7 +3408,7 @@ test iocmd.tf-28.14 {chan seek, custom return is error} -match glob -body { rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -level 33 -code 99 BANG} @@ -3248,7 +3423,7 @@ test iocmd.tf-28.15 {chan seek, level is ignored} -match glob -body { rename foo {} set res } -result {{seek rc* 0 start} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "seek"*}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return -45} @@ -3262,7 +3437,7 @@ test iocmd.tf-28.16 {chan seek, bogus return, negative location} -match glob -bo rename foo {} set res } -result {{seek rc* 0 start} 1 {Tried to seek before origin}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return BOGUS} @@ -3276,7 +3451,7 @@ test iocmd.tf-28.17 {chan seek, bogus return, string return} -match glob -body { rename foo {} set res } -result {{seek rc* 0 start} 1 {expected integer but got "BOGUS"}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-28.18 {chan seek, ok result} -match glob -body { set res {} proc foo {args} {oninit seek; onfinal; track; return 23} @@ -3289,7 +3464,7 @@ test iocmd.tf-28.18 {chan seek, ok result} -match glob -body { rename foo {} set res } -result {{seek rc* 0 current} {}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} foreach {testname code} { iocmd.tf-28.19.0 start iocmd.tf-28.19.1 current @@ -3307,7 +3482,7 @@ foreach {testname code} { rename foo {} set res } -result [list [list seek rc* 0 $code] {}] \ - -constraints {testchannel testthread} + -constraints {testchannel thread} } # --- === *** ########################### @@ -3325,7 +3500,7 @@ test iocmd.tf-29.1 {chan blocking, no handler support} -match glob -body { rename foo {} set res } -result {1} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; note MUST_NOT_HAPPEN; return} @@ -3339,7 +3514,7 @@ test iocmd.tf-29.2 {chan blocking, no handler support} -match glob -body { rename foo {} set res } -result {{} 0} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; note MUST_NOT_HAPPEN; return} @@ -3352,7 +3527,7 @@ test iocmd.tf-29.3 {chan blocking, retrieval, handler support} -match glob -body rename foo {} set res } -result {1} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return} @@ -3366,7 +3541,7 @@ test iocmd.tf-29.4 {chan blocking, resetting, handler support} -match glob -body rename foo {} set res } -result {{blocking rc* 0} {} 0} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return} @@ -3380,7 +3555,7 @@ test iocmd.tf-29.5 {chan blocking, setting, handler support} -match glob -body { rename foo {} set res } -result {{blocking rc* 1} {} 1} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.6 {chan blocking, error return} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; error BOOM!} @@ -3395,7 +3570,7 @@ test iocmd.tf-29.6 {chan blocking, error return} -match glob -body { rename foo {} set res } -result {{blocking rc* 0} 1 BOOM!} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -code break BOOM!} @@ -3409,7 +3584,7 @@ test iocmd.tf-29.7 {chan blocking, break return is error} -match glob -body { rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -code continue BOOM!} @@ -3423,7 +3598,7 @@ test iocmd.tf-29.8 {chan blocking, continue return is error} -match glob -body { rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -code 44 BOOM!} @@ -3437,7 +3612,7 @@ test iocmd.tf-29.9 {chan blocking, custom return is error} -match glob -body { rename foo {} set res } -result {{blocking rc* 0} 1 *bad code*} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return -level 99 -code 44 BANG} @@ -3452,7 +3627,7 @@ test iocmd.tf-29.10 {chan blocking, level is ignored} -match glob -body { rename foo {} set res } -result {{blocking rc* 0} 1 *bad code* {-code 1 -level 0 -errorcode NONE -errorline 1 -errorinfo *bad code*subcommand "blocking"*}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glob -body { set res {} proc foo {args} {oninit blocking; onfinal; track; return BOGUS} @@ -3466,7 +3641,7 @@ test iocmd.tf-29.11 {chan blocking, regular return ok, value ignored} -match glo rename foo {} set res } -result {{blocking rc* 0} 0 {}} \ - -constraints {testchannel testthread} + -constraints {testchannel thread} # --- === *** ########################### # method watch @@ -3482,7 +3657,7 @@ test iocmd.tf-30.1 {chan watch, read interest, some return} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{watch rc* read} {watch rc* {}} {}} +} -constraints {testchannel thread} -result {{watch rc* read} {watch rc* {}} {}} test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return -code error BOOM!_IGNORED} @@ -3495,7 +3670,7 @@ test iocmd.tf-30.2 {chan watch, write interest, error return} -match glob -body } c] rename foo {} set res -} -constraints {testchannel testthread} -result {{watch rc* write} {watch rc* {}} {} {}} +} -constraints {testchannel thread} -result {{watch rc* write} {watch rc* {}} {} {}} test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body { set res {} proc foo {args} {oninit; onfinal; track; return} @@ -3510,7 +3685,7 @@ test iocmd.tf-30.3 {chan watch, accumulated interests} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} \ +} -constraints {testchannel thread} \ -result {{watch rc* write} {watch rc* {read write}} {watch rc* read} {watch rc* {}} {} {} {} {}} test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -body { set res {} @@ -3525,7 +3700,7 @@ test iocmd.tf-30.4 {chan watch, unchanged interest not forwarded} -match glob -b } c] rename foo {} set res -} -constraints {testchannel testthread} \ +} -constraints {testchannel thread} \ -result {{watch rc* write} {watch rc* {read write}} {watch rc* write} {watch rc* {}} {} {} {}} # --- === *** ########################### @@ -3545,7 +3720,7 @@ test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body { } c] rename foo {} set res -} -constraints {testchannel testthread} \ +} -constraints {testchannel thread} \ -result {{can not find reflected channel named "rc*"}} # --- === *** ########################### @@ -3556,12 +3731,15 @@ test iocmd.tf-31.8 {chan postevent, bad input} -match glob -body { test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body { #puts <<$tcltest::mainThread>>main - set tida [testthread create];#puts <<$tida>> - set tidb [testthread create];#puts <<$tidb>> + set tida [thread::create -preserved];#puts <<$tida>> + thread::send $tida {load {} Tcltest} + + set tidb [thread::create -preserved];#puts <<$tidb>> + thread::send $tidb {load {} Tcltest} # Set up channel in thread - testthread send $tida $helperscript - set chan [testthread send $tida { + thread::send $tida $helperscript + set chan [thread::send $tida { proc foo {args} {oninit seek; onfinal; track; return} set chan [chan create {r w} foo] fconfigure $chan -buffering none @@ -3569,67 +3747,82 @@ test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body { }] # Move channel to 2nd thread. - testthread send $tida [list testchannel cut $chan] - testthread send $tidb [list testchannel splice $chan] + thread::send $tida [list testchannel cut $chan] + thread::send $tidb [list testchannel splice $chan] # Kill origin thread, then access channel from 2nd thread. - testthread send -async $tida {testthread exit} - after 100 + thread::release $tida set res {} - lappend res [catch {testthread send $tidb [list puts $chan shoo]} msg] $msg + lappend res [catch {thread::send $tidb [list puts $chan shoo]} msg] $msg - lappend res [catch {testthread send $tidb [list tell $chan]} msg] $msg - lappend res [catch {testthread send $tidb [list seek $chan 1]} msg] $msg - lappend res [catch {testthread send $tidb [list gets $chan]} msg] $msg - lappend res [catch {testthread send $tidb [list close $chan]} msg] $msg - tcltest::threadReap + lappend res [catch {thread::send $tidb [list tell $chan]} msg] $msg + lappend res [catch {thread::send $tidb [list seek $chan 1]} msg] $msg + lappend res [catch {thread::send $tidb [list gets $chan]} msg] $msg + lappend res [catch {thread::send $tidb [list close $chan]} msg] $msg + thread::release $tidb set res -} -constraints {testchannel testthread} \ +} -constraints {testchannel thread} \ -result {1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}} + +# The test iocmd.tf-32.1 unavoidably exhibits a memory leak. We are testing +# the ability of the reflected channel system to react to the situation where +# the thread in which the driver routines runs exits during driver operations. +# In this case, thread exit handlers signal back to the owner thread so that the +# channel operation does not hang. There's no way to test this without actually +# exiting a thread in mid-operation, and that action is unavoidably leaky (which +# is why [thread::exit] is advised against). +# +# Use constraints to skip this test while valgrinding so this expected leak +# doesn't prevent a finding of "leak-free". +# +testConstraint notValgrind [expr {![testConstraint valgrind]}] test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body { #puts <<$tcltest::mainThread>>main - set tida [testthread create];#puts <<$tida>> - set tidb [testthread create];#puts <<$tidb>> + set tida [thread::create -preserved];#puts <<$tida>> + thread::send $tida {load {} Tcltest} + set tidb [thread::create -preserved];#puts <<$tidb>> + thread::send $tidb {load {} Tcltest} # Set up channel in thread - set chan [testthread send $tida $helperscript] - set chan [testthread send $tida { + thread::send $tida $helperscript + set chan [thread::send $tida { proc foo {args} { oninit; onfinal; track; # destroy thread during channel access - testthread exit - return} + thread::exit + } set chan [chan create {r w} foo] fconfigure $chan -buffering none set chan }] # Move channel to 2nd thread. - testthread send $tida [list testchannel cut $chan] - testthread send $tidb [list testchannel splice $chan] + thread::send $tida [list testchannel cut $chan] + thread::send $tidb [list testchannel splice $chan] # Run access from thread B, wait for response from A (A is not # using event loop at this point, so the event pile up in the # queue. - testthread send $tidb [list set chan $chan] - testthread send $tidb [list set mid $tcltest::mainThread] - testthread send -async $tidb { + thread::send $tidb [list set chan $chan] + thread::send $tidb [list set mid [thread::id]] + thread::send -async $tidb { # wait a bit, give the main thread the time to start its event # loop to wait for the response from B after 2000 catch { puts $chan shoo } res - testthread send -async $mid [list set ::res $res] + thread::send -async $mid [list set ::res $res] } vwait ::res - tcltest::threadReap + catch {thread::release $tida} + thread::release $tidb set res -} -constraints {testchannel testthread} \ +} -constraints {testchannel thread notValgrind} \ -result {Owner lost} # ### ### ### ######### ######### ######### |