# Commands covered: open, close, gets, puts, read, seek, tell, eof, flush # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1991-1993 The Regents of the University of California. # All rights reserved. # # Permission is hereby granted, without written agreement and without # license or royalty fees, to use, copy, modify, and distribute this # software and its documentation for any purpose, provided that the # above copyright notice and the following two paragraphs appear in # all copies of this software. # # IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR # DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT # OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF # CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. # # THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY # AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS # ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO # PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. # # $Header: /user6/ouster/tcl/tests/RCS/open.test,v 1.19 93/10/18 08:52:24 ouster Exp $ (Berkeley) if {[string compare test [info procs test]] == 1} then {source defs} catch {exec rm -f test1 test2 test3} exec cat > test1 << "Two lines: this one\nand this one\n" exec cat > test2 << "line1\nline2\nline3\nline4\nline5\n" test open-1.1 {open command (files only)} { set f [open test1] set x [gets $f] close $f set x } {Two lines: this one} test open-1.2 {open command (files only)} { set f [open test1] set f2 [open test2] set f3 [open test1] set f4 [open test1] set x [list [gets $f] [gets $f2] [gets $f3] [gets $f4] \ [gets $f] [gets $f2]] close $f close $f2 close $f3 close $f4 set x } {{Two lines: this one} line1 {Two lines: this one} {Two lines: this one} {and this one} line2} test open-1.3 {open command (files only)} { set f [open test3 w] puts $f xyz close $f exec cat test3 } "xyz" test open-1.4 {open command (files only)} { set f [open test3 w] puts $f xyz close $f set f [open test3 a] puts $f 123 close $f exec cat test3 } "xyz\n123" test open-1.5 {open command (files only)} { set f [open test3 w] puts $f xyz\n123 close $f set f [open test3 r+] set x [gets $f] seek $f 0 current puts $f 456 close $f list $x [exec cat test3] } "xyz {xyz 456}" test open-1.6 {open command (files only)} { set f [open test3 w] puts $f xyz\n123 close $f set f [open test3 w+] puts $f xyzzy seek $f 2 set x [gets $f] close $f list $x [exec cat test3] } "zzy xyzzy" test open-1.7 {open command (files only)} { set f [open test3 w] puts $f xyz\n123 close $f set f [open test3 a+] puts $f xyzzy flush $f set x [tell $f] seek $f -4 cur set y [gets $f] close $f list $x [exec cat test3] $y } {14 {xyz 123 xyzzy} zzy} test open-2.1 {errors in open command} { list [catch {open} msg] $msg } {1 {wrong # args: should be "open filename ?access? ?permissions?"}} test open-2.2 {errors in open command} { list [catch {open a b c d} msg] $msg } {1 {wrong # args: should be "open filename ?access? ?permissions?"}} test open-2.3 {errors in open command} { list [catch {open test1 x} msg] $msg } {1 {illegal access mode "x"}} test open-2.4 {errors in open command} { list [catch {open test1 rw} msg] $msg } {1 {illegal access mode "rw"}} test open-2.5 {errors in open command} { list [catch {open test1 r+1} msg] $msg } {1 {illegal access mode "r+1"}} test open-2.6 {errors in open command} { string tolower [list [catch {open _non_existent_} msg] $msg $errorCode] } {1 {couldn't open "_non_existent_": no such file or directory} {posix enoent {no such file or directory}}} if {![file exists ~/_test_] && [file writable ~]} { test open-3.1 {tilde substitution in open} { set f [open ~/_test_ w] puts $f "Some text" close $f set x [file exists $env(HOME)/_test_] exec rm -f $env(HOME)/_test_ set x } 1 } test open-3.2 {tilde substitution in open} { set home $env(HOME) unset env(HOME) set x [list [catch {open ~/foo} msg] $msg] set env(HOME) $home set x } {1 {couldn't find HOME environment variable to expand "~/foo"}} test open-4.1 {file id parsing errors} { list [catch {eof gorp} msg] $msg $errorCode } {1 {bad file identifier "gorp"} NONE} test open-4.2 {file id parsing errors} { list [catch {eof filex} msg] $msg } {1 {bad file identifier "filex"}} test open-4.3 {file id parsing errors} { list [catch {eof file12a} msg] $msg } {1 {bad file identifier "file12a"}} test open-4.4 {file id parsing errors} { list [catch {eof file123} msg] $msg } {1 {file "file123" isn't open}} test open-4.5 {file id parsing errors} { list [catch {eof file1} msg] $msg } {0 0} test open-4.5 {file id parsing errors} { list [catch {eof stdin} msg] $msg } {0 0} test open-4.6 {file id parsing errors} { list [catch {eof stdout} msg] $msg } {0 0} test open-4.7 {file id parsing errors} { list [catch {eof stderr} msg] $msg } {0 0} test open-4.8 {file id parsing errors} { list [catch {eof stderr1} msg] $msg } {1 {bad file identifier "stderr1"}} set f [open test1] close $f set expect "1 {file \"$f\" isn't open}" test open-4.9 {file id parsing errors} { list [catch {eof $f} msg] $msg } $expect test open-5.1 {close command (files only)} { list [catch {close} msg] $msg $errorCode } {1 {wrong # args: should be "close fileId"} NONE} test open-5.2 {close command (files only)} { list [catch {close a b} msg] $msg $errorCode } {1 {wrong # args: should be "close fileId"} NONE} test open-5.3 {close command (files only)} { list [catch {close gorp} msg] $msg $errorCode } {1 {bad file identifier "gorp"} NONE} test open-5.4 {close command (files only)} { list [catch {close file4} msg] \ [string range $msg [string first {" } $msg] end] $errorCode } {1 {" isn't open} NONE} test open-6.1 {puts command} { list [catch {puts} msg] $msg $errorCode } {1 {wrong # args: should be "puts" ?-nonewline? ?fileId? string} NONE} test open-6.2 {puts command} { list [catch {puts a b c d} msg] $msg $errorCode } {1 {wrong # args: should be "puts" ?-nonewline? ?fileId? string} NONE} test open-6.3 {puts command} { list [catch {puts a b nonewlinx} msg] $msg $errorCode } {1 {bad argument "nonewlinx": should be "nonewline"} NONE} test open-6.4 {puts command} { list [catch {puts gorp "New text"} msg] $msg $errorCode } {1 {bad file identifier "gorp"} NONE} test open-6.5 {puts command} { set f [open test3] set x [list [catch {puts $f "New text"} msg] \ [string range $msg [string first " " $msg] end] $errorCode] close $f set x } {1 { wasn't opened for writing} NONE} test open-6.6 {puts command} { set f [open test3 w] puts -nonewline $f "Text1" puts -nonewline $f " Text 2" puts $f " Text 3" close $f exec cat test3 } {Text1 Text 2 Text 3} test open-7.1 {gets command} { list [catch {gets} msg] $msg $errorCode } {1 {wrong # args: should be "gets fileId ?varName?"} NONE} test open-7.2 {gets command} { list [catch {gets a b c} msg] $msg $errorCode } {1 {wrong # args: should be "gets fileId ?varName?"} NONE} test open-7.3 {gets command} { list [catch {gets a} msg] $msg $errorCode } {1 {bad file identifier "a"} NONE} test open-7.4 {gets command} { set f [open test3 w] set x [list [catch {gets $f} msg] \ [string range $msg [string first " " $msg] end] $errorCode] close $f set x } {1 { wasn't opened for reading} NONE} set f [open test3 w] puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" close $f test open-7.5 {gets command with long line} { set f [open test3] set x [gets $f] close $f set x } {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} test open-7.6 {gets command with long line} { set f [open test3] set x [gets $f y] close $f list $x $y } {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} test open-7.7 {gets command and end of file} { set f [open test3 w] puts -nonewline $f "Test1\nTest2" close $f set f [open test3] set x {} set y {} lappend x [gets $f y] $y set y {} lappend x [gets $f y] $y set y {} lappend x [gets $f y] $y close $f set x } {5 Test1 5 Test2 -1 {}} set f [open test3 w] puts $f "Line 1" puts $f "Line 2" close $f test open-7.8 {gets command and bad variable} { catch {unset x} set x 24 set f [open test3 r] set result [list [catch {gets $f x(0)} msg] $msg] close $f set result } {1 {can't set "x(0)": variable isn't array}} test open-8.1 {read command} { list [catch {read} msg] $msg $errorCode } {1 {wrong # args: should be "read fileId ?numBytes?" or "read ?-nonewline? fileId"} NONE} test open-8.2 {read command} { list [catch {read -nonewline} msg] $msg $errorCode } {1 {bad file identifier "-nonewline"} NONE} test open-8.3 {read command} { list [catch {read a b c} msg] $msg $errorCode } {1 {wrong # args: should be "read fileId ?numBytes?" or "read ?-nonewline? fileId"} NONE} test open-8.4 {read command} { list [catch {read -nonew file4} msg] $msg $errorCode } {1 {bad file identifier "-nonew"} NONE} test open-8.5 {read command} { list [catch {read stdin foo} msg] $msg $errorCode } {1 {bad argument "foo": should be "nonewline"} NONE} test open-8.6 {read command} { list [catch {read file10} msg] $msg $errorCode } {1 {file "file10" isn't open} NONE} test open-8.7 {read command} { set f [open test3 w] set x [list [catch {read $f} msg] \ [string range $msg [string first " " $msg] end] $errorCode] close $f set x } {1 { wasn't opened for reading} NONE} test open-8.8 {read command} { set f [open test1] set x [list [catch {read $f 12z} msg] $msg $errorCode] close $f set x } {1 {expected integer but got "12z"} NONE} test open-898 {read command} { set f [open test1] set x [list [catch {read $f z} msg] $msg $errorCode] close $f set x } {1 {bad argument "z": should be "nonewline"} NONE} test open-8.10 {read command} { set f [open test1] set x [list [read $f 1] [read $f 2] [read $f]] close $f set x } {T wo { lines: this one and this one }} test open-8.11 {read command, with over-large count} { set f [open test1] set x [read $f 100] close $f set x } {Two lines: this one and this one } test open-8.12 {read command, -nonewline switch} { set f [open test1] set x [read -nonewline $f] close $f set x } {Two lines: this one and this one} test open-9.1 {seek command} { list [catch {seek foo} msg] $msg $errorCode } {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE} test open-9.2 {seek command} { list [catch {seek foo a b c} msg] $msg $errorCode } {1 {wrong # args: should be "seek fileId offset ?origin?"} NONE} test open-9.3 {seek command} { list [catch {seek foo 0} msg] $msg $errorCode } {1 {bad file identifier "foo"} NONE} test open-9.4 {seek command} { set f [open test2] set x [list [catch {seek $f xyz} msg] $msg $errorCode] close $f set x } {1 {expected integer but got "xyz"} NONE} test open-9.5 {seek command} { set f [open test2] set x [list [catch {seek $f 100 gorp} msg] $msg $errorCode] close $f set x } {1 {bad origin "gorp": should be start, current, or end} NONE} set f [open test3 w] puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" close $f test open-9.6 {seek command} { set f [open test3] set x [read $f 1] seek $f 3 lappend x [read $f 1] seek $f 0 start lappend x [read $f 1] seek $f 10 current lappend x [read $f 1] seek $f -2 end lappend x [read $f 1] seek $f 50 end lappend x [read $f 1] seek $f 1 lappend x [read $f 1] close $f set x } {a d a l Y {} b} test open-10.1 {tell command} { list [catch {tell} msg] $msg $errorCode } {1 {wrong # args: should be "tell fileId"} NONE} test open-10.2 {tell command} { list [catch {tell a b} msg] $msg $errorCode } {1 {wrong # args: should be "tell fileId"} NONE} test open-10.3 {tell command} { list [catch {tell a} msg] $msg $errorCode } {1 {bad file identifier "a"} NONE} test open-10.4 {tell command} { set f [open test2] set x [tell $f] read $f 3 lappend x [tell $f] seek $f 2 lappend x [tell $f] seek $f 10 current lappend x [tell $f] seek $f 0 end lappend x [tell $f] close $f set x } {0 3 2 12 30} test open-11.1 {eof command} { list [catch {eof} msg] $msg $errorCode } {1 {wrong # args: should be "eof fileId"} NONE} test open-11.2 {eof command} { list [catch {eof a b} msg] $msg $errorCode } {1 {wrong # args: should be "eof fileId"} NONE} test open-11.3 {eof command} { list [catch {eof file100} msg] $msg $errorCode } {1 {file "file100" isn't open} NONE} test open-11.4 {eof command} { set f [open test1] set x [eof $f] lappend x [eof $f] gets $f lappend x [eof $f] gets $f lappend x [eof $f] gets $f lappend x [eof $f] lappend x [eof $f] close $f set x } {0 0 0 0 1 1} test open-12.1 {flush command} { list [catch {flush} msg] $msg $errorCode } {1 {wrong # args: should be "flush fileId"} NONE} test open-12.2 {flush command} { list [catch {flush a b} msg] $msg $errorCode } {1 {wrong # args: should be "flush fileId"} NONE} test open-12.3 {flush command} { list [catch {flush a} msg] $msg $errorCode } {1 {bad file identifier "a"} NONE} test open-12.4 {flush command} { set f [open test3] set x [list [catch {flush $f} msg] \ [string range $msg [string first " " $msg] end] $errorCode] close $f set x } {1 { wasn't opened for writing} NONE} test open-12.5 {flush command} { set f [open test3 w] puts $f "Line 1" puts $f "Line 2" set f2 [open test3] set x {} lappend x [read -nonewline $f2] close $f2 flush $f set f2 [open test3] lappend x [read -nonewline $f2] close $f2 close $f set x } {{} {Line 1 Line 2}} test open-13.1 {I/O to command pipelines} { list [catch {open "| cat < test1 > test3" w} msg] $msg $errorCode } {1 {can't write input to command: standard input was redirected} NONE} test open-13.2 {I/O to command pipelines} { list [catch {open "| echo > test3" r} msg] $msg $errorCode } {1 {can't read output from command: standard output was redirected} NONE} test open-13.3 {I/O to command pipelines} { list [catch {open "| echo > test3" r+} msg] $msg $errorCode } {1 {can't read output from command: standard output was redirected} NONE} test open-13.4 {writing to command pipelines} { exec rm test3 set f [open "| cat | cat > test3" w] puts $f "Line 1" puts $f "Line 2" close $f exec cat test3 } {Line 1 Line 2} test open-13.5 {reading from command pipelines} { set f [open "| cat test2" r] set x [list [gets $f] [gets $f] [gets $f]] close $f set x } {line1 line2 line3} test open-13.6 {both reading and writing from/to command pipelines} { set f [open "| cat -u" r+] puts $f "Line1" flush $f set x [gets $f] close $f set x } {Line1} test open-13.7 {errors in command pipelines} { set f [open "|gorp"] list [catch {close $f} msg] $msg [lindex $errorCode 0] [lindex $errorCode 2] } {1 {couldn't find "gorp" to execute} CHILDSTATUS 1} test open-13.8 {errors in command pipelines} { set f [open "|gorp" w] exec sleep 1 puts $f output set x [list [catch {flush $f} msg] [concat \ [string range $msg 0 [string first {"} $msg]] \ [string range $msg [string first : $msg] end]] $errorCode] catch {close $f} string tolower $x } {1 {error flushing " : broken pipe} {posix epipe {broken pipe}}} test open-13.9 {errors in command pipelines} { set f [open "|gorp" w] list [catch {close $f} msg] $msg \ [lindex $errorCode 0] [lindex $errorCode 2] } {1 {couldn't find "gorp" to execute} CHILDSTATUS 1} test open-13.10 {errors in command pipelines} { set f [open "|gorp" w] exec sleep 1 puts $f output string tolower [list [catch {close $f} msg] [concat \ [string range $msg 0 [string first {"} $msg]] \ [string range $msg [string first : $msg] end]] \ [lindex $errorCode 0] [lindex $errorCode 2]] } {1 {error closing " : broken pipe couldn't find "gorp" to execute} childstatus 1} test open-14.1 {POSIX open access modes: RDONLY} { set f [open test1 RDONLY] set x [list [gets $f] [catch {puts $f Test} msg] $msg] close $f # The regsub is needed to avoid false errors if the file # number varies from system to system. regsub {"file."} $x {"file"} x set x } {{Two lines: this one} 1 {"file" wasn't opened for writing}} test open-14.2 {POSIX open access modes: RDONLY} { catch {exec rm -f test3} string tolower [list [catch {open test3 RDONLY} msg] $msg] } {1 {couldn't open "test3": no such file or directory}} test open-14.3 {POSIX open access modes: WRONLY} { catch {exec rm -f test3} string tolower [list [catch {open test3 WRONLY} msg] $msg] } {1 {couldn't open "test3": no such file or directory}} test open-14.4 {POSIX open access modes: WRONLY} { exec echo xyzzy > test3 set f [open test3 WRONLY] puts -nonewline $f "ab" seek $f 0 current set x [list [catch {gets $f} msg] $msg] close $f lappend x [exec cat test3] # The regsub is needed to avoid false errors if the file # number varies from system to system. regsub {"file."} $x {"file"} x set x } {1 {"file" wasn't opened for reading} abzzy} test open-14.5 {POSIX open access modes: RDWR} { catch {exec rm -f test3} string tolower [list [catch {open test3 RDWR} msg] $msg] } {1 {couldn't open "test3": no such file or directory}} test open-14.6 {POSIX open access modes: RDWR} { exec echo xyzzy > test3 set f [open test3 RDWR] puts -nonewline $f "ab" seek $f 0 current set x [gets $f] close $f lappend x [exec cat test3] } {zzy abzzy} test open-14.7 {POSIX open access modes: CREAT} { catch {exec rm -f test3} set f [open test3 {WRONLY CREAT} 0600] file stat test3 stats set x [format "0%o" [expr $stats(mode)&0777]] puts $f "line 1" close $f lappend x [exec cat test3] } {0600 {line 1}} if $atBerkeley { test open-14.8 {POSIX open access modes: CREAT} { catch {exec rm -f test3} set f [open test3 {WRONLY CREAT}] close $f file stat test3 stats format "0%o" [expr $stats(mode)&0777] } 0664 } test open-14.9 {POSIX open access modes: CREAT} { exec echo xyzzy > test3 set f [open test3 {WRONLY CREAT}] puts -nonewline $f "ab" close $f exec cat test3 } abzzy test open-14.10 {POSIX open access modes: APPEND} { exec echo xyzzy > test3 set f [open test3 {WRONLY APPEND}] puts $f "new line" seek $f 0 puts $f "abc" close $f exec cat test3 } {xyzzy new line abc} test open-14.11 {POSIX open access modes: EXCL} { exec echo xyzzy > test3 set msg [list [catch {open test3 {WRONLY CREAT EXCL}} msg] $msg] regsub " already " $msg " " msg string tolower $msg } {1 {couldn't open "test3": file exists}} test open-14.12 {POSIX open access modes: EXCL} { catch {exec rm -f test3} set x [catch {set f [open test3 {WRONLY CREAT EXCL}]}] puts $f "A test line" close $f lappend x [exec cat test3] } {0 {A test line}} test open-14.13 {POSIX open access modes: TRUNC} { exec echo xyzzy > test3 set f [open test3 {WRONLY TRUNC}] puts $f abc close $f exec cat test3 } {abc} if $atBerkeley { test open-14.14 {POSIX open access modes: NOCTTY} { catch {exec rm -f test3} list [catch {open test3 {WRONLY NOCTTY CREAT}} msg] $msg } {1 {access mode "NOCTTY" not supported by this system}} test open-14.15 {POSIX open access modes: NONBLOCK} { catch {exec rm -f test3} set f [open test3 {WRONLY NONBLOCK CREAT}] puts $f "NONBLOCK test" close $f exec cat test3 } {NONBLOCK test} } test open-14.16 {POSIX open access modes: errors} { concat [catch {open test3 "FOO \{BAR BAZ"} msg] $msg\n$errorInfo } "1 unmatched open brace in list unmatched open brace in list while processing open access modes \"FOO {BAR BAZ\" invoked from within \"open test3 \"FOO \\{BAR BAZ\"\"" test open-14.17 {POSIX open access modes: errors} { list [catch {open test3 {FOO BAR BAZ}} msg] $msg } {1 {invalid access mode "FOO": must be RDONLY, WRONLY, RDWR, APPEND, CREAT EXCL, NOCTTY, NONBLOCK, or TRUNC}} test open-14.18 {POSIX open access modes: errors} { list [catch {open test3 {TRUNC CREAT}} msg] $msg } {1 {access mode must include either RDONLY, WRONLY, or RDWR}} catch {exec rm -f test1 test2 test3} concat {}