os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/ioCmd.test
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/ioCmd.test Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,594 @@
1.4 +# -*- tcl -*-
1.5 +# Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
1.6 +# fblocked, fconfigure, open, channel, fcopy
1.7 +#
1.8 +# This file contains a collection of tests for one or more of the Tcl
1.9 +# built-in commands. Sourcing this file into Tcl runs the tests and
1.10 +# generates output for errors. No output means no errors were found.
1.11 +#
1.12 +# Copyright (c) 1991-1994 The Regents of the University of California.
1.13 +# Copyright (c) 1994-1996 Sun Microsystems, Inc.
1.14 +# Copyright (c) 1998-1999 by Scriptics Corporation.
1.15 +#
1.16 +# See the file "license.terms" for information on usage and redistribution
1.17 +# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
1.18 +#
1.19 +# RCS: @(#) $Id: ioCmd.test,v 1.16.2.3 2006/03/16 18:23:24 andreas_kupries Exp $
1.20 +
1.21 +if {[lsearch [namespace children] ::tcltest] == -1} {
1.22 + package require tcltest
1.23 + namespace import -force ::tcltest::*
1.24 +}
1.25 +
1.26 +testConstraint fcopy [llength [info commands fcopy]]
1.27 +
1.28 +test iocmd-1.1 {puts command} {
1.29 + list [catch {puts} msg] $msg
1.30 +} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
1.31 +test iocmd-1.2 {puts command} {
1.32 + list [catch {puts a b c d e f g} msg] $msg
1.33 +} {1 {wrong # args: should be "puts ?-nonewline? ?channelId? string"}}
1.34 +test iocmd-1.3 {puts command} {
1.35 + list [catch {puts froboz -nonewline kablooie} msg] $msg
1.36 +} {1 {bad argument "kablooie": should be "nonewline"}}
1.37 +test iocmd-1.4 {puts command} {
1.38 + list [catch {puts froboz hello} msg] $msg
1.39 +} {1 {can not find channel named "froboz"}}
1.40 +test iocmd-1.5 {puts command} {
1.41 + list [catch {puts stdin hello} msg] $msg
1.42 +} {1 {channel "stdin" wasn't opened for writing}}
1.43 +
1.44 +set path(test1) [makeFile {} test1]
1.45 +
1.46 +test iocmd-1.6 {puts command} {
1.47 + set f [open $path(test1) w]
1.48 + fconfigure $f -translation lf -eofchar {}
1.49 + puts -nonewline $f foobar
1.50 + close $f
1.51 + file size $path(test1)
1.52 +} 6
1.53 +test iocmd-1.7 {puts command} {
1.54 + set f [open $path(test1) w]
1.55 + fconfigure $f -translation lf -eofchar {}
1.56 + puts $f foobar
1.57 + close $f
1.58 + file size $path(test1)
1.59 +} 7
1.60 +test iocmd-1.8 {puts command} {
1.61 + set f [open $path(test1) w]
1.62 + fconfigure $f -translation lf -eofchar {} -encoding iso8859-1
1.63 + puts -nonewline $f [binary format a4a5 foo bar]
1.64 + close $f
1.65 + file size $path(test1)
1.66 +} 9
1.67 +
1.68 +
1.69 +test iocmd-2.1 {flush command} {
1.70 + list [catch {flush} msg] $msg
1.71 +} {1 {wrong # args: should be "flush channelId"}}
1.72 +test iocmd-2.2 {flush command} {
1.73 + list [catch {flush a b c d e} msg] $msg
1.74 +} {1 {wrong # args: should be "flush channelId"}}
1.75 +test iocmd-2.3 {flush command} {
1.76 + list [catch {flush foo} msg] $msg
1.77 +} {1 {can not find channel named "foo"}}
1.78 +test iocmd-2.4 {flush command} {
1.79 + list [catch {flush stdin} msg] $msg
1.80 +} {1 {channel "stdin" wasn't opened for writing}}
1.81 +
1.82 +test iocmd-3.1 {gets command} {
1.83 + list [catch {gets} msg] $msg
1.84 +} {1 {wrong # args: should be "gets channelId ?varName?"}}
1.85 +test iocmd-3.2 {gets command} {
1.86 + list [catch {gets a b c d e f g} msg] $msg
1.87 +} {1 {wrong # args: should be "gets channelId ?varName?"}}
1.88 +test iocmd-3.3 {gets command} {
1.89 + list [catch {gets aaa} msg] $msg
1.90 +} {1 {can not find channel named "aaa"}}
1.91 +test iocmd-3.4 {gets command} {
1.92 + list [catch {gets stdout} msg] $msg
1.93 +} {1 {channel "stdout" wasn't opened for reading}}
1.94 +test iocmd-3.5 {gets command} {
1.95 + set f [open $path(test1) w]
1.96 + puts $f [binary format a4a5 foo bar]
1.97 + close $f
1.98 + set f [open $path(test1) r]
1.99 + set result [gets $f]
1.100 + close $f
1.101 + set x foo\x00
1.102 + set x "${x}bar\x00\x00"
1.103 + string compare $x $result
1.104 +} 0
1.105 +
1.106 +test iocmd-4.1 {read command} {
1.107 + list [catch {read} msg] $msg
1.108 +} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
1.109 +test iocmd-4.2 {read command} {
1.110 + list [catch {read a b c d e f g h} msg] $msg
1.111 +} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
1.112 +test iocmd-4.3 {read command} {
1.113 + list [catch {read aaa} msg] $msg
1.114 +} {1 {can not find channel named "aaa"}}
1.115 +test iocmd-4.4 {read command} {
1.116 + list [catch {read -nonewline} msg] $msg
1.117 +} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"}}
1.118 +test iocmd-4.5 {read command} {
1.119 + list [catch {read -nonew file4} msg] $msg $errorCode
1.120 +} {1 {can not find channel named "-nonew"} NONE}
1.121 +test iocmd-4.6 {read command} {
1.122 + list [catch {read stdout} msg] $msg
1.123 +} {1 {channel "stdout" wasn't opened for reading}}
1.124 +test iocmd-4.7 {read command} {
1.125 + list [catch {read -nonewline stdout} msg] $msg
1.126 +} {1 {channel "stdout" wasn't opened for reading}}
1.127 +test iocmd-4.8 {read command with incorrect combination of arguments} {
1.128 + file delete $path(test1)
1.129 + set f [open $path(test1) w]
1.130 + puts $f "Two lines: this one"
1.131 + puts $f "and this one"
1.132 + close $f
1.133 + set f [open $path(test1)]
1.134 + set x [list [catch {read -nonewline $f 20 z} msg] $msg $errorCode]
1.135 + close $f
1.136 + set x
1.137 +} {1 {wrong # args: should be "read channelId ?numChars?" or "read ?-nonewline? channelId"} NONE}
1.138 +test iocmd-4.9 {read command} {
1.139 + list [catch {read stdin foo} msg] $msg $errorCode
1.140 +} {1 {bad argument "foo": should be "nonewline"} NONE}
1.141 +test iocmd-4.10 {read command} {
1.142 + list [catch {read file107} msg] $msg $errorCode
1.143 +} {1 {can not find channel named "file107"} NONE}
1.144 +
1.145 +set path(test3) [makeFile {} test3]
1.146 +
1.147 +test iocmd-4.11 {read command} {
1.148 + set f [open $path(test3) w]
1.149 + set x [list [catch {read $f} msg] $msg $errorCode]
1.150 + close $f
1.151 + string compare [string tolower $x] \
1.152 + [list 1 [format "channel \"%s\" wasn't opened for reading" $f] none]
1.153 +} 0
1.154 +test iocmd-4.12 {read command} {
1.155 + set f [open $path(test1)]
1.156 + set x [list [catch {read $f 12z} msg] $msg $errorCode]
1.157 + close $f
1.158 + set x
1.159 +} {1 {expected integer but got "12z"} NONE}
1.160 +
1.161 +test iocmd-5.1 {seek command} {
1.162 + list [catch {seek} msg] $msg
1.163 +} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
1.164 +test iocmd-5.2 {seek command} {
1.165 + list [catch {seek a b c d e f g} msg] $msg
1.166 +} {1 {wrong # args: should be "seek channelId offset ?origin?"}}
1.167 +test iocmd-5.3 {seek command} {
1.168 + list [catch {seek stdin gugu} msg] $msg
1.169 +} {1 {expected integer but got "gugu"}}
1.170 +test iocmd-5.4 {seek command} {
1.171 + list [catch {seek stdin 100 gugu} msg] $msg
1.172 +} {1 {bad origin "gugu": must be start, current, or end}}
1.173 +
1.174 +test iocmd-6.1 {tell command} {
1.175 + list [catch {tell} msg] $msg
1.176 +} {1 {wrong # args: should be "tell channelId"}}
1.177 +test iocmd-6.2 {tell command} {
1.178 + list [catch {tell a b c d e} msg] $msg
1.179 +} {1 {wrong # args: should be "tell channelId"}}
1.180 +test iocmd-6.3 {tell command} {
1.181 + list [catch {tell aaa} msg] $msg
1.182 +} {1 {can not find channel named "aaa"}}
1.183 +
1.184 +test iocmd-7.1 {close command} {
1.185 + list [catch {close} msg] $msg
1.186 +} {1 {wrong # args: should be "close channelId"}}
1.187 +test iocmd-7.2 {close command} {
1.188 + list [catch {close a b c d e} msg] $msg
1.189 +} {1 {wrong # args: should be "close channelId"}}
1.190 +test iocmd-7.3 {close command} {
1.191 + list [catch {close aaa} msg] $msg
1.192 +} {1 {can not find channel named "aaa"}}
1.193 +
1.194 +test iocmd-8.1 {fconfigure command} {
1.195 + list [catch {fconfigure} msg] $msg
1.196 +} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
1.197 +test iocmd-8.2 {fconfigure command} {
1.198 + list [catch {fconfigure a b c d e f} msg] $msg
1.199 +} {1 {wrong # args: should be "fconfigure channelId ?optionName? ?value? ?optionName value?..."}}
1.200 +test iocmd-8.3 {fconfigure command} {
1.201 + list [catch {fconfigure a b} msg] $msg
1.202 +} {1 {can not find channel named "a"}}
1.203 +test iocmd-8.4 {fconfigure command} {
1.204 + file delete $path(test1)
1.205 + set f1 [open $path(test1) w]
1.206 + set x [list [catch {fconfigure $f1 froboz} msg] $msg]
1.207 + close $f1
1.208 + set x
1.209 +} {1 {bad option "froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
1.210 +test iocmd-8.5 {fconfigure command} {
1.211 + list [catch {fconfigure stdin -buffering froboz} msg] $msg
1.212 +} {1 {bad value for -buffering: must be one of full, line, or none}}
1.213 +test iocmd-8.6 {fconfigure command} {
1.214 + list [catch {fconfigure stdin -translation froboz} msg] $msg
1.215 +} {1 {bad value for -translation: must be one of auto, binary, cr, lf, crlf, or platform}}
1.216 +test iocmd-8.7 {fconfigure command} {
1.217 + file delete $path(test1)
1.218 + set f1 [open $path(test1) w]
1.219 + fconfigure $f1 -translation lf -eofchar {} -encoding unicode
1.220 + set x [fconfigure $f1]
1.221 + close $f1
1.222 + set x
1.223 +} {-blocking 1 -buffering full -buffersize 4096 -encoding unicode -eofchar {} -translation lf}
1.224 +test iocmd-8.8 {fconfigure command} {
1.225 + file delete $path(test1)
1.226 + set f1 [open $path(test1) w]
1.227 + fconfigure $f1 -translation lf -buffering line -buffersize 3030 \
1.228 + -eofchar {} -encoding unicode
1.229 + set x ""
1.230 + lappend x [fconfigure $f1 -buffering]
1.231 + lappend x [fconfigure $f1]
1.232 + close $f1
1.233 + set x
1.234 +} {line {-blocking 1 -buffering line -buffersize 3030 -encoding unicode -eofchar {} -translation lf}}
1.235 +test iocmd-8.9 {fconfigure command} {
1.236 + file delete $path(test1)
1.237 + set f1 [open $path(test1) w]
1.238 + fconfigure $f1 -translation binary -buffering none -buffersize 4040 \
1.239 + -eofchar {} -encoding binary
1.240 + set x [fconfigure $f1]
1.241 + close $f1
1.242 + set x
1.243 +} {-blocking 1 -buffering none -buffersize 4040 -encoding binary -eofchar {} -translation lf}
1.244 +test iocmd-8.10 {fconfigure command} {
1.245 + list [catch {fconfigure a b} msg] $msg
1.246 +} {1 {can not find channel named "a"}}
1.247 +
1.248 +set path(fconfigure.dummy) [makeFile {} fconfigure.dummy]
1.249 +
1.250 +test iocmd-8.11 {fconfigure command} {
1.251 + set chan [open $path(fconfigure.dummy) r]
1.252 + set res [list [catch {fconfigure $chan -froboz blarfo} msg] $msg]
1.253 + close $chan
1.254 + set res
1.255 +} {1 {bad option "-froboz": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
1.256 +
1.257 +test iocmd-8.12 {fconfigure command} {
1.258 + set chan [open $path(fconfigure.dummy) r]
1.259 + set res [list [catch {fconfigure $chan -b blarfo} msg] $msg]
1.260 + close $chan
1.261 + set res
1.262 +} {1 {bad option "-b": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
1.263 +
1.264 +test iocmd-8.13 {fconfigure command} {
1.265 + set chan [open $path(fconfigure.dummy) r]
1.266 + set res [list [catch {fconfigure $chan -buffer blarfo} msg] $msg]
1.267 + close $chan
1.268 + set res
1.269 +} {1 {bad option "-buffer": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, or -translation}}
1.270 +
1.271 +removeFile fconfigure.dummy
1.272 +
1.273 +test iocmd-8.14 {fconfigure command} {
1.274 + fconfigure stdin -buffers
1.275 +} 4096
1.276 +
1.277 +proc iocmdSSETUP {} {
1.278 + uplevel {
1.279 + set srv [socket -server iocmdSRV 0]
1.280 + set port [lindex [fconfigure $srv -sockname] 2]
1.281 + proc iocmdSRV {sock ip port} {close $sock}
1.282 + set cli [socket 127.0.0.1 $port]
1.283 + }
1.284 +}
1.285 +proc iocmdSSHTDWN {} {
1.286 + uplevel {
1.287 + close $cli
1.288 + close $srv
1.289 + unset cli srv port
1.290 + rename iocmdSRV {}
1.291 + }
1.292 +}
1.293 +
1.294 +test iocmd-8.15.0 {fconfigure command / tcp channel} {socket macOnly} {
1.295 + iocmdSSETUP
1.296 + set r [list [catch {fconfigure $cli -blah} msg] $msg]
1.297 + iocmdSSHTDWN
1.298 + set r
1.299 +} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -error, -peername, or -sockname}}
1.300 +test iocmd-8.15.1 {fconfigure command / tcp channel} {socket unixOrPc} {
1.301 + iocmdSSETUP
1.302 + set r [list [catch {fconfigure $cli -blah} msg] $msg]
1.303 + iocmdSSHTDWN
1.304 + set r
1.305 +} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -peername, or -sockname}}
1.306 +test iocmd-8.16 {fconfigure command / tcp channel} {socket} {
1.307 + iocmdSSETUP
1.308 + set r [expr [lindex [fconfigure $cli -peername] 2]==$port]
1.309 + iocmdSSHTDWN
1.310 + set r
1.311 +} 1
1.312 +test iocmd-8.17 {fconfigure command / tcp channel} {nonPortable} {
1.313 + # It is possible that you don't get the connection reset by peer
1.314 + # error but rather a valid answer. depends of the tcp implementation
1.315 + iocmdSSETUP
1.316 + update;
1.317 + puts $cli "blah"; flush $cli; # that flush could/should fail too
1.318 + update;
1.319 + set r [catch {fconfigure $cli -peername} msg]
1.320 + iocmdSSHTDWN
1.321 + regsub -all {can([^:])+: } $r {} r;
1.322 + set r
1.323 +} 1
1.324 +test iocmd-8.18 {fconfigure command / unix tty channel} {nonPortable unixOnly} {
1.325 + # might fail if /dev/ttya is unavailable
1.326 + set tty [open /dev/ttya]
1.327 + set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
1.328 + close $tty;
1.329 + set r;
1.330 +} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, or -mode}}
1.331 +test iocmd-8.19 {fconfigure command / win tty channel} {nonPortable pcOnly} {
1.332 + # might fail if com1 is unavailable
1.333 + set tty [open com1]
1.334 + set r [list [catch {fconfigure $tty -blah blih} msg] $msg];
1.335 + close $tty;
1.336 + set r;
1.337 +} {1 {bad option "-blah": should be one of -blocking, -buffering, -buffersize, -encoding, -eofchar, -translation, -mode, or -pollinterval}}
1.338 +
1.339 +test iocmd-9.1 {eof command} {
1.340 + list [catch {eof} msg] $msg $errorCode
1.341 +} {1 {wrong # args: should be "eof channelId"} NONE}
1.342 +test iocmd-9.2 {eof command} {
1.343 + list [catch {eof a b} msg] $msg $errorCode
1.344 +} {1 {wrong # args: should be "eof channelId"} NONE}
1.345 +test iocmd-9.3 {eof command} {
1.346 + catch {close file100}
1.347 + list [catch {eof file100} msg] $msg $errorCode
1.348 +} {1 {can not find channel named "file100"} NONE}
1.349 +
1.350 +# The tests for Tcl_ExecObjCmd are in exec.test
1.351 +
1.352 +test iocmd-10.1 {fblocked command} {
1.353 + list [catch {fblocked} msg] $msg
1.354 +} {1 {wrong # args: should be "fblocked channelId"}}
1.355 +test iocmd-10.2 {fblocked command} {
1.356 + list [catch {fblocked a b c d e f g} msg] $msg
1.357 +} {1 {wrong # args: should be "fblocked channelId"}}
1.358 +test iocmd-10.3 {fblocked command} {
1.359 + list [catch {fblocked file1000} msg] $msg
1.360 +} {1 {can not find channel named "file1000"}}
1.361 +test iocmd-10.4 {fblocked command} {
1.362 + list [catch {fblocked stdout} msg] $msg
1.363 +} {1 {channel "stdout" wasn't opened for reading}}
1.364 +test iocmd-10.5 {fblocked command} {
1.365 + fblocked stdin
1.366 +} 0
1.367 +
1.368 +set path(test4) [makeFile {} test4]
1.369 +set path(test5) [makeFile {} test5]
1.370 +
1.371 +file delete $path(test5)
1.372 +test iocmd-11.1 {I/O to command pipelines} {unixOrPc unixExecs} {
1.373 + set f [open $path(test4) w]
1.374 + close $f
1.375 + list [catch {open "| cat < $path(test4) > $path(test5)" w} msg] $msg $errorCode
1.376 +} {1 {can't write input to command: standard input was redirected} NONE}
1.377 +test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
1.378 + list [catch {open "| echo > $path(test5)" r} msg] $msg $errorCode
1.379 +} {1 {can't read output from command: standard output was redirected} NONE}
1.380 +test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
1.381 + list [catch {open "| echo > $path(test5)" r+} msg] $msg $errorCode
1.382 +} {1 {can't read output from command: standard output was redirected} NONE}
1.383 +
1.384 +test iocmd-12.1 {POSIX open access modes: RDONLY} {
1.385 + file delete $path(test1)
1.386 + set f [open $path(test1) w]
1.387 + puts $f "Two lines: this one"
1.388 + puts $f "and this one"
1.389 + close $f
1.390 + set f [open $path(test1) RDONLY]
1.391 + set x [list [gets $f] [catch {puts $f Test} msg] $msg]
1.392 + close $f
1.393 + string compare $x \
1.394 + "{Two lines: this one} 1 [list [format "channel \"%s\" wasn't opened for writing" $f]]"
1.395 +} 0
1.396 +test iocmd-12.2 {POSIX open access modes: RDONLY} -match regexp -body {
1.397 + file delete $path(test3)
1.398 + open $path(test3) RDONLY
1.399 +} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
1.400 +test iocmd-12.3 {POSIX open access modes: WRONLY} -match regexp -body {
1.401 + file delete $path(test3)
1.402 + open $path(test3) WRONLY
1.403 +} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
1.404 +#
1.405 +# Test 13.4 relies on assigning the same channel name twice.
1.406 +#
1.407 +test iocmd-12.4 {POSIX open access modes: WRONLY} {unixOnly} {
1.408 + file delete $path(test3)
1.409 + set f [open $path(test3) w]
1.410 + fconfigure $f -eofchar {}
1.411 + puts $f xyzzy
1.412 + close $f
1.413 + set f [open $path(test3) WRONLY]
1.414 + fconfigure $f -eofchar {}
1.415 + puts -nonewline $f "ab"
1.416 + seek $f 0 current
1.417 + set x [list [catch {gets $f} msg] $msg]
1.418 + close $f
1.419 + set f [open $path(test3) r]
1.420 + fconfigure $f -eofchar {}
1.421 + lappend x [gets $f]
1.422 + close $f
1.423 + set y [list 1 [format "channel \"%s\" wasn't opened for reading" $f] abzzy]
1.424 + string compare $x $y
1.425 +} 0
1.426 +test iocmd-12.5 {POSIX open access modes: RDWR} -match regexp -body {
1.427 + file delete $path(test3)
1.428 + open $path(test3) RDWR
1.429 +} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
1.430 +test iocmd-12.6 {POSIX open access modes: errors} {
1.431 + concat [catch {open $path(test3) "FOO \{BAR BAZ"} msg] $msg\n$errorInfo
1.432 +} "1 unmatched open brace in list
1.433 +unmatched open brace in list
1.434 + while processing open access modes \"FOO {BAR BAZ\"
1.435 + invoked from within
1.436 +\"open \$path(test3) \"FOO \\{BAR BAZ\"\""
1.437 +test iocmd-12.7 {POSIX open access modes: errors} {
1.438 + list [catch {open $path(test3) {FOO BAR BAZ}} msg] $msg
1.439 +} {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC}}
1.440 +test iocmd-12.8 {POSIX open access modes: errors} {
1.441 + list [catch {open $path(test3) {TRUNC CREAT}} msg] $msg
1.442 +} {1 {access mode must include either RDONLY, WRONLY, or RDWR}}
1.443 +close [open $path(test3) w]
1.444 +
1.445 +test iocmd-13.1 {errors in open command} {
1.446 + list [catch {open} msg] $msg
1.447 +} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
1.448 +test iocmd-13.2 {errors in open command} {
1.449 + list [catch {open a b c d} msg] $msg
1.450 +} {1 {wrong # args: should be "open fileName ?access? ?permissions?"}}
1.451 +test iocmd-13.3 {errors in open command} {
1.452 + list [catch {open $path(test1) x} msg] $msg
1.453 +} {1 {illegal access mode "x"}}
1.454 +test iocmd-13.4 {errors in open command} {
1.455 + list [catch {open $path(test1) rw} msg] $msg
1.456 +} {1 {illegal access mode "rw"}}
1.457 +test iocmd-13.5 {errors in open command} {
1.458 + list [catch {open $path(test1) r+1} msg] $msg
1.459 +} {1 {illegal access mode "r+1"}}
1.460 +test iocmd-13.6 {errors in open command} {
1.461 + set msg [list [catch {open _non_existent_} msg] $msg $errorCode]
1.462 + regsub [file join {} _non_existent_] $msg "_non_existent_" msg
1.463 + string tolower $msg
1.464 +} {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}}
1.465 +
1.466 +
1.467 +test iocmd-13.7.1 {open for append, a mode} -setup {
1.468 + set log [makeFile {} out]
1.469 + set chans {}
1.470 +} -body {
1.471 + foreach i { 0 1 2 3 4 5 6 7 8 9 } {
1.472 + puts [set ch [open $log a]] $i
1.473 + lappend chans $ch
1.474 + }
1.475 + foreach ch $chans {catch {close $ch}}
1.476 + lsort [split [string trim [viewFile out]] \n]
1.477 +} -cleanup {
1.478 + removeFile out
1.479 + # Ensure that channels are gone, even if body failed to do so
1.480 + foreach ch $chans {catch {close $ch}}
1.481 +} -result {0 1 2 3 4 5 6 7 8 9}
1.482 +
1.483 +test iocmd-13.7.2 {open for append, O_APPEND} -setup {
1.484 + set log [makeFile {} out]
1.485 + set chans {}
1.486 +} -body {
1.487 + foreach i { 0 1 2 3 4 5 6 7 8 9 } {
1.488 + puts [set ch [open $log {WRONLY CREAT APPEND}]] $i
1.489 + lappend chans $ch
1.490 + }
1.491 + foreach ch $chans {catch {close $ch}}
1.492 + lsort [split [string trim [viewFile out]] \n]
1.493 +} -cleanup {
1.494 + removeFile out
1.495 + # Ensure that channels are gone, even if body failed to do so
1.496 + foreach ch $chans {catch {close $ch}}
1.497 +} -result {0 1 2 3 4 5 6 7 8 9}
1.498 +
1.499 +
1.500 +
1.501 +
1.502 +test iocmd-14.1 {file id parsing errors} {
1.503 + list [catch {eof gorp} msg] $msg $errorCode
1.504 +} {1 {can not find channel named "gorp"} NONE}
1.505 +test iocmd-14.2 {file id parsing errors} {
1.506 + list [catch {eof filex} msg] $msg
1.507 +} {1 {can not find channel named "filex"}}
1.508 +test iocmd-14.3 {file id parsing errors} {
1.509 + list [catch {eof file12a} msg] $msg
1.510 +} {1 {can not find channel named "file12a"}}
1.511 +test iocmd-14.4 {file id parsing errors} {
1.512 + list [catch {eof file123} msg] $msg
1.513 +} {1 {can not find channel named "file123"}}
1.514 +test iocmd-14.5 {file id parsing errors} {
1.515 + list [catch {eof stdout} msg] $msg
1.516 +} {0 0}
1.517 +test iocmd-14.6 {file id parsing errors} {
1.518 + list [catch {eof stdin} msg] $msg
1.519 +} {0 0}
1.520 +test iocmd-14.7 {file id parsing errors} {
1.521 + list [catch {eof stdout} msg] $msg
1.522 +} {0 0}
1.523 +test iocmd-14.8 {file id parsing errors} {
1.524 + list [catch {eof stderr} msg] $msg
1.525 +} {0 0}
1.526 +test iocmd-14.9 {file id parsing errors} {
1.527 + list [catch {eof stderr1} msg] $msg
1.528 +} {1 {can not find channel named "stderr1"}}
1.529 +
1.530 +set f [open $path(test1) w]
1.531 +close $f
1.532 +
1.533 +set expect "1 {can not find channel named \"$f\"}"
1.534 +test iocmd-14.10 {file id parsing errors} {
1.535 + list [catch {eof $f} msg] $msg
1.536 +} $expect
1.537 +
1.538 +test iocmd-15.1 {Tcl_FcopyObjCmd} {fcopy} {
1.539 + list [catch {fcopy} msg] $msg
1.540 +} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
1.541 +test iocmd-15.2 {Tcl_FcopyObjCmd} {fcopy} {
1.542 + list [catch {fcopy 1} msg] $msg
1.543 +} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
1.544 +test iocmd-15.3 {Tcl_FcopyObjCmd} {fcopy} {
1.545 + list [catch {fcopy 1 2 3 4 5 6 7} msg] $msg
1.546 +} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
1.547 +test iocmd-15.4 {Tcl_FcopyObjCmd} {fcopy} {
1.548 + list [catch {fcopy 1 2 3} msg] $msg
1.549 +} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
1.550 +test iocmd-15.5 {Tcl_FcopyObjCmd} {fcopy} {
1.551 + list [catch {fcopy 1 2 3 4 5} msg] $msg
1.552 +} {1 {wrong # args: should be "fcopy input output ?-size size? ?-command callback?"}}
1.553 +
1.554 +set path(test2) [makeFile {} test2]
1.555 +
1.556 +set f [open $path(test1) w]
1.557 +close $f
1.558 +
1.559 +set rfile [open $path(test1) r]
1.560 +set wfile [open $path(test2) w]
1.561 +
1.562 +test iocmd-15.6 {Tcl_FcopyObjCmd} {fcopy} {
1.563 + list [catch {fcopy foo $wfile} msg] $msg
1.564 +} {1 {can not find channel named "foo"}}
1.565 +test iocmd-15.7 {Tcl_FcopyObjCmd} {fcopy} {
1.566 + list [catch {fcopy $rfile foo} msg] $msg
1.567 +} {1 {can not find channel named "foo"}}
1.568 +test iocmd-15.8 {Tcl_FcopyObjCmd} {fcopy} {
1.569 + list [catch {fcopy $wfile $wfile} msg] $msg
1.570 +} "1 {channel \"$wfile\" wasn't opened for reading}"
1.571 +test iocmd-15.9 {Tcl_FcopyObjCmd} {fcopy} {
1.572 + list [catch {fcopy $rfile $rfile} msg] $msg
1.573 +} "1 {channel \"$rfile\" wasn't opened for writing}"
1.574 +test iocmd-15.10 {Tcl_FcopyObjCmd} {fcopy} {
1.575 + list [catch {fcopy $rfile $wfile foo bar} msg] $msg
1.576 +} {1 {bad switch "foo": must be -size or -command}}
1.577 +test iocmd-15.11 {Tcl_FcopyObjCmd} {fcopy} {
1.578 + list [catch {fcopy $rfile $wfile -size foo} msg] $msg
1.579 +} {1 {expected integer but got "foo"}}
1.580 +test iocmd-15.12 {Tcl_FcopyObjCmd} {fcopy} {
1.581 + list [catch {fcopy $rfile $wfile -command bar -size foo} msg] $msg
1.582 +} {1 {expected integer but got "foo"}}
1.583 +
1.584 +close $rfile
1.585 +close $wfile
1.586 +
1.587 +# cleanup
1.588 +foreach file [list test1 test2 test3 test4] {
1.589 + removeFile $file
1.590 +}
1.591 +# delay long enough for background processes to finish
1.592 +after 500
1.593 +foreach file [list test5] {
1.594 + removeFile $file
1.595 +}
1.596 +cleanupTests
1.597 +return