diff options
Diffstat (limited to 'tests/ioCmd.test')
| -rw-r--r-- | tests/ioCmd.test | 245 |
1 files changed, 138 insertions, 107 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test index 6536072..5a76d48 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -133,10 +133,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"} {TCL WRONGARGS}} +} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE} test iocmd-4.9 {read command} { list [catch {read stdin foo} msg] $msg $::errorCode -} {1 {expected non-negative integer but got "foo"} {TCL VALUE NUMBER}} +} {1 {expected 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,26 +148,25 @@ 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} -setup { +test iocmd-4.12 {read command} { set f [open $path(test1)] -} -body { - list [catch {read $f 12z} msg] $msg $::errorCode -} -cleanup { + set x [list [catch {read $f 12z} msg] $msg $::errorCode] close $f -} -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} + 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}} test iocmd-6.1 {tell command} { list [catch {tell} msg] $msg @@ -181,34 +180,20 @@ test iocmd-6.3 {tell command} { test iocmd-7.1 {close command} { list [catch {close} msg] $msg -} {1 {wrong # args: should be "close channelId ?direction?"}} +} {1 {wrong # args: should be "close channelId"}} test iocmd-7.2 {close command} { list [catch {close a b c d e} msg] $msg -} {1 {wrong # args: should be "close channelId ?direction?"}} +} {1 {wrong # args: should be "close channelId"}} 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 ?-option value ...?"}} +} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName 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 ?-option value ...?"}} +} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}} test iocmd-8.3 {fconfigure command} { list [catch {fconfigure a b} msg] $msg } {1 {can not find channel named "a"}} @@ -351,10 +336,10 @@ test iocmd-8.19 {fconfigure command / win tty channel} -constraints {nonPortable test iocmd-9.1 {eof command} { list [catch {eof} msg] $msg $::errorCode -} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}} +} {1 {wrong # args: should be "eof channelId"} NONE} test iocmd-9.2 {eof command} { list [catch {eof a b} msg] $msg $::errorCode -} {1 {wrong # args: should be "eof channelId"} {TCL WRONGARGS}} +} {1 {wrong # args: should be "eof channelId"} NONE} test iocmd-9.3 {eof command} { catch {close file100} list [catch {eof file100} msg] $msg $::errorCode @@ -386,13 +371,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} {TCL OPERATION EXEC BADREDIRECT}} +} {1 {can't write input to command: standard input was redirected} NONE} 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} {TCL OPERATION EXEC BADREDIRECT}} +} {1 {can't read output from command: standard output was redirected} NONE} 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} {TCL OPERATION EXEC BADREDIRECT}} +} {1 {can't read output from command: standard output was redirected} NONE} 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}}} @@ -542,27 +527,6 @@ 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 @@ -653,10 +617,11 @@ close $wfile test iocmd-20.0 {chan, wrong#args} { catch {chan} msg set msg -} {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 *} +} {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} # --- --- --- --------- --------- --------- # chan create, and method "initalize" @@ -790,6 +755,90 @@ test iocmd-21.19 {chan create, init failure -> no channel, no finalize} -match g rename foo {} set res } -result {{} {initialize rc* {read write}} 1 {*all required methods*} {}} +test iocmd-21.20 {Bug 88aef05cda} -setup { + proc foo {method chan args} { + switch -- $method blocking { + chan configure $chan -blocking [lindex $args 0] + return + } initialize { + return {initialize finalize watch blocking read write + configure cget cgetall} + } finalize { + return + } + } + set ch [chan create {read write} foo] +} -body { + list [catch {chan configure $ch -blocking 0} m] $m +} -cleanup { + close $ch + rename foo {} +} -match glob -result {1 {*nested eval*}} +test iocmd-21.21 {[close] in [read] segfaults} -setup { + proc foo {method chan args} { + switch -- $method initialize { + return {initialize finalize watch read} + } finalize {} watch {} read { + close $chan + return a + } + } + set ch [chan create read foo] +} -body { + read $ch 0 +} -cleanup { + close $ch + rename foo {} +} -result {} +test iocmd-21.22 {[close] in [read] segfaults} -setup { + proc foo {method chan args} { + switch -- $method initialize { + return {initialize finalize watch read} + } finalize {} watch {} read { + catch {close $chan} + return a + } + } + set ch [chan create read foo] +} -body { + read $ch 1 +} -returnCodes error -cleanup { + catch {close $ch} + rename foo {} +} -match glob -result {*invalid argument*} +test iocmd-21.23 {[close] in [gets] segfaults} -setup { + proc foo {method chan args} { + switch -- $method initialize { + return {initialize finalize watch read} + } finalize {} watch {} read { + catch {close $chan} + return \n + } + } + set ch [chan create read foo] +} -body { + gets $ch +} -cleanup { + catch {close $ch} + rename foo {} +} -result {} +test iocmd-21.24 {[close] in binary [gets] segfaults} -setup { + proc foo {method chan args} { + switch -- $method initialize { + return {initialize finalize watch read} + } finalize {} watch {} read { + catch {close $chan} + return \n + } + } + set ch [chan create read foo] +} -body { + chan configure $ch -translation binary + gets $ch +} -cleanup { + catch {close $ch} + rename foo {} +} -result {} # --- --- --- --------- --------- --------- # Helper commands to record the arguments to handler methods. @@ -1048,6 +1097,20 @@ test iocmd-23.10 {chan read, EAGAIN means no data, yet no eof either} -match glo rename foo {} unset res } -result {{read rc* 4096} {} 0} +test iocmd-23.11 {chan read, close pulls the rug out} -match glob -body { + set res {} + proc foo {args} { + oninit; onfinal; track + set args [lassign $args sub id] + if {$sub ne "read"} {return} + close $id + return {} + } + set c [chan create {r} foo] + note [read $c] + rename foo {} + set res +} -result {{read rc* 4096} {}} # --- === *** ########################### # method write @@ -1975,13 +2038,13 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m proc foo {args} { oninit; onfinal; track; # destroy interpreter during channel access - # Actually not possible for an interp to destroy itself. - interp delete {} - return} + suicide + } set chan [chan create {r w} foo] fconfigure $chan -buffering none set chan }] + interp alias $ida suicide {} interp delete $ida # Move channel to 2nd thread. interp eval $ida [list testchannel cut $chan] @@ -2000,8 +2063,7 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m set res }] set res -} -constraints {testchannel impossible} \ - -result {Owner lost} +} -constraints {testchannel} -result {Owner lost} test iocmd-32.2 {delete interp of reflected chan} { # Bug 3034840 @@ -2009,9 +2071,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 } {} @@ -2592,40 +2654,9 @@ test iocmd.tf-24.15 {chan write, EAGAIN means that writing is not allowed at thi } -cleanup { rename foo {} unset res - update } -result {{write rc* ABC} {watch rc* write} {}} \ -constraints {testchannel testthread} -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} { note BG ; track } - # Flush (sic!) the event-queue to capture the write from a - # BG-flush. - update - set res -} -cleanup { - rename foo {} - unset res -} -result {{write rc* ABC} {watch rc* write} {} BG {write rc* ABC}} \ - -constraints {testchannel testthread} - # --- === *** ########################### # method cgetall |