663 lines
21 KiB
Plaintext
663 lines
21 KiB
Plaintext
|
# 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 {}
|