summaryrefslogtreecommitdiffstats
path: root/tests/ioCmd.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/ioCmd.test')
-rw-r--r--tests/ioCmd.test138
1 files changed, 102 insertions, 36 deletions
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 768a748..6536072 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"} 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 +148,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 +181,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"}}
@@ -336,10 +351,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"} 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 +386,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 +542,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
@@ -617,11 +653,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"
@@ -1974,9 +2009,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
} {}
@@ -2557,9 +2592,40 @@ 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