summaryrefslogtreecommitdiffstats
path: root/contrib/tcl/tests/io.test
diff options
context:
space:
mode:
Diffstat (limited to 'contrib/tcl/tests/io.test')
-rw-r--r--contrib/tcl/tests/io.test272
1 files changed, 165 insertions, 107 deletions
diff --git a/contrib/tcl/tests/io.test b/contrib/tcl/tests/io.test
index c83033b..7392482 100644
--- a/contrib/tcl/tests/io.test
+++ b/contrib/tcl/tests/io.test
@@ -6,12 +6,12 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1991-1994 The Regents of the University of California.
-# Copyright (c) 1994-1996 Sun Microsystems, Inc.
+# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# SCCS: @(#) io.test 1.119 97/06/23 18:47:01
+# SCCS: @(#) io.test 1.128 97/08/13 10:24:56
if {[string compare test [info procs test]] == 1} then {source defs}
@@ -24,13 +24,6 @@ if {"[info commands testchannel]" != "testchannel"} {
removeFile test1
removeFile pipe
-set testConfig(umask2) 1
-catch {
- if {"[exec umask]" != "002"} {
- set testConfig(umask2) 0
- }
-}
-
# set up a long data file for some of the following tests
set f [open longfile w]
@@ -42,6 +35,28 @@ for { set i 0 } { $i < 100 } { incr i} {
}
close $f
+set f [open cat w]
+puts $f {
+ if {$argv == {}} {
+ set argv -
+ }
+ foreach name $argv {
+ if {$name == "-"} {
+ set f stdin
+ } elseif {[catch {open $name r} f] != 0} {
+ puts stderr $f
+ continue
+ }
+ while {[eof $f] == 0} {
+ puts -nonewline stdout [read $f]
+ }
+ if {$f != "stdin"} {
+ close $f
+ }
+ }
+}
+close $f
+
# These tests are disabled until we decide what to do with "unsupported0".
#
#test io-1.7 {unsupported0 command} {
@@ -51,7 +66,7 @@ close $f
# unsupported0 $f1 $f2
# close $f1
# catch {close $f2}
-# set s1 [file size io.test]
+# set s1 [file size [info script]]
# set s2 [file size test1]
# set x ok
# if {"$s1" != "$s2"} {
@@ -61,7 +76,7 @@ close $f
#} ok
#test io-1.8 {unsupported0 command} {
# removeFile test1
-# set f1 [open io.test]
+# set f1 [open [info script]]
# set f2 [open test1 w]
# unsupported0 $f1 $f2 40
# close $f1
@@ -70,13 +85,13 @@ close $f
#} 40
#test io-1.9 {unsupported0 command} {
# removeFile test1
-# set f1 [open io.test]
+# set f1 [open [info script]]
# set f2 [open test1 w]
# unsupported0 $f1 $f2 -1
# close $f1
# close $f2
# set x ok
-# set s1 [file size io.test]
+# set s1 [file size [info script]]
# set s2 [file size test1]
# if {$s1 != $s2} {
# set x broken
@@ -89,11 +104,11 @@ close $f
# set f1 [open pipe w]
# puts $f1 {puts ready}
# puts $f1 {gets stdin}
-# puts $f1 {set f1 [open io.test r]}
+# puts $f1 {set f1 [open [info script] r]}
# puts $f1 {puts [read $f1 100]}
# puts $f1 {close $f1}
# close $f1
-# set f1 [open "|$tcltest pipe" r+]
+# set f1 [open "|[list $tcltest pipe]" r+]
# gets $f1
# puts $f1 ready
# flush $f1
@@ -135,7 +150,7 @@ test io-1.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
interp delete x
set l
} {line line none}
-test io-1.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOrPc} {
+test io-1.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {stdio} {
set f [open test1 w]
puts $f {
close stdin
@@ -152,7 +167,7 @@ test io-1.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOrPc} {
close $f3
}
close $f
- set result [eval exec $tcltest test1]
+ set result [exec $tcltest test1]
set f [open test2 r]
set f2 [open test3 r]
lappend result [read $f] [read $f2]
@@ -180,7 +195,7 @@ test io-1.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {unixOnly} {
close $f3
}
close $f
- set result [eval exec $tcltest test1]
+ set result [exec $tcltest test1]
set f [open test2 r]
set f2 [open test3 r]
lappend result [read $f] [read $f2]
@@ -235,12 +250,12 @@ test io-1.8 {reuse of stdio special channels} {unixOnly} {
puts [gets $f]
}
close $f
- set f [open "|$tcltest script" r]
+ set f [open "|[list $tcltest script]" r]
set c [gets $f]
close $f
set c
} hello
-test io-1.9 {reuse of stdio special channels} {unixOnly} {
+test io-1.9 {reuse of stdio special channels} {stdio} {
removeFile script
removeFile test1
set f [open script w]
@@ -249,11 +264,11 @@ test io-1.9 {reuse of stdio special channels} {unixOnly} {
puts $f hello
close $f
close stderr
- set f [open "|cat test1" r]
+ set f [open "|[list [info nameofexecutable] cat test1]" r]
puts [gets $f]
}
close $f
- set f [open "|$tcltest script" r]
+ set f [open "|[list $tcltest script]" r]
set c [gets $f]
close $f
set c
@@ -500,7 +515,7 @@ test io-4.5 {FlushChannel, implicit flush when buffer fills and on close} {unixO
lappend l [file size test1]
set l
} {0 60 72}
-test io-4.6 {FlushChannel, async flushing, async close} {unixOrPc asyncPipeClose} {
+test io-4.6 {FlushChannel, async flushing, async close} {stdio && asyncPipeClose} {
removeFile pipe
removeFile output
set f [open pipe w]
@@ -520,7 +535,7 @@ test io-4.6 {FlushChannel, async flushing, async close} {unixOrPc asyncPipeClose
}
set f [open output w]
close $f
- set f [open "|$tcltest pipe" w]
+ set f [open "|[list $tcltest pipe]" w]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
@@ -567,7 +582,7 @@ test io-5.2 {CloseChannel called when all references are dropped} {
close $f
set l
} abcdef
-test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc asyncPipeClose tempNotPc nonPortable} {
+test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc asyncPipeClose nonPortable tempNotPc} {
removeFile pipe
removeFile output
set f [open pipe w]
@@ -595,8 +610,12 @@ test io-5.3 {CloseChannel, not called before output queue is empty} {unixOrPc as
}
set f [open output w]
close $f
- set f [open "|$tcltest pipe" r+]
+ set f [open "|[list $tcltest pipe]" r+]
fconfigure $f -blocking off -eofchar {}
+
+ # Under windows, the first 24576 bytes of $x are copied to $f, and
+ # then the writing fails.
+
puts -nonewline $f $x
close $f
set counter 0
@@ -632,7 +651,7 @@ test io-5.5 {Tcl_Close vs standard handles} {unixOnly} {
puts [testchannel open]
}
close $f
- set f [open "|$tcltest script" r]
+ set f [open "|[list $tcltest script]" r]
set l [gets $f]
close $f
set l
@@ -766,7 +785,7 @@ test io-6.11 {Tcl_Write, no newline, implicit flush} {
close $f2
file size test1
} 377
-test io-6.12 {Tcl_Write on a pipe} {unixOrPc} {
+test io-6.12 {Tcl_Write on a pipe} {stdio} {
removeFile test1
removeFile pipe
set f1 [open pipe w]
@@ -777,7 +796,7 @@ test io-6.12 {Tcl_Write on a pipe} {unixOrPc} {
}
}
close $f1
- set f1 [open "|$tcltest pipe" r]
+ set f1 [open "|[list $tcltest pipe]" r]
set f2 [open longfile r]
set y ok
for {set x 0} {$x < 10} {incr x} {
@@ -791,7 +810,7 @@ test io-6.12 {Tcl_Write on a pipe} {unixOrPc} {
close $f2
set y
} ok
-test io-6.13 {Tcl_Write to a pipe, line buffered} {unixOrPc} {
+test io-6.13 {Tcl_Write to a pipe, line buffered} {stdio} {
removeFile test1
removeFile pipe
set f1 [open pipe w]
@@ -801,7 +820,7 @@ test io-6.13 {Tcl_Write to a pipe, line buffered} {unixOrPc} {
}
close $f1
set y ok
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
fconfigure $f1 -buffering line
set f2 [open longfile r]
set line [gets $f2]
@@ -842,8 +861,8 @@ test io-6.15 {Tcl_Flush, channel not open for writing} {
string compare $x \
[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
-test io-6.16 {Tcl_Flush on pipe opened only for reading} {unixOrPc unixExecs} {
- set fd [open "|cat longfile" r]
+test io-6.16 {Tcl_Flush on pipe opened only for reading} {stdio} {
+ set fd [open "|[list $tcltest cat longfile]" r]
set x [list [catch {flush $fd} msg] $msg]
catch {close $fd}
string compare $x \
@@ -916,21 +935,21 @@ test io-6.20 {Implicit flush when buffer is full} {
lappend z [file size test1]
set z
} {4096 12288 12600}
-test io-6.21 {Tcl_Flush to pipe} {unixOrPc} {
+test io-6.21 {Tcl_Flush to pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {set x [read stdin 6]}
puts $f1 {set cnt [string length $x]}
puts $f1 {puts "read $cnt characters"}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
puts $f1 hello
flush $f1
set x [gets $f1]
catch {close $f1}
set x
} "read 6 characters"
-test io-6.22 {Tcl_Flush called at other end of pipe} {unixOrPc} {
+test io-6.22 {Tcl_Flush called at other end of pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {
@@ -943,7 +962,7 @@ test io-6.22 {Tcl_Flush called at other end of pipe} {unixOrPc} {
flush stdout
}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
set x ""
lappend x [gets $f1]
lappend x [gets $f1]
@@ -953,7 +972,7 @@ test io-6.22 {Tcl_Flush called at other end of pipe} {unixOrPc} {
close $f1
set x
} {hello hello bye}
-test io-6.23 {Tcl_Flush and line buffering at end of pipe} {unixOrPc} {
+test io-6.23 {Tcl_Flush and line buffering at end of pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {
@@ -963,7 +982,7 @@ test io-6.23 {Tcl_Flush and line buffering at end of pipe} {unixOrPc} {
puts bye
}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
set x ""
lappend x [gets $f1]
lappend x [gets $f1]
@@ -989,9 +1008,9 @@ test io-6.24 {Tcl_Write and Tcl_Flush move end of file} {
set x
} {{} {Line 1
Line 2}}
-test io-6.25 {Implicit flush with Tcl_Flush to command pipelines} {unixOrPc unixExecs} {
+test io-6.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio} {
removeFile test3
- set f [open "| cat | cat > test3" w]
+ set f [open "|[list $tcltest cat | $tcltest cat > test3]" w]
puts $f "Line 1"
puts $f "Line 2"
close $f
@@ -1003,20 +1022,20 @@ test io-6.25 {Implicit flush with Tcl_Flush to command pipelines} {unixOrPc unix
} {Line 1
Line 2
}
-test io-6.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {unixOrPc unixExecs} {
- set f [open "| cat -u" r+]
+test io-6.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {unixOrPc && unixExecs && tempNotPc} {
+ set f [open "|[list cat -u]" r+]
puts $f "Line1"
flush $f
set x [gets $f]
close $f
set x
} {Line1}
-test io-6.27 {Tcl_Flush on closed pipeline} {unixOrPc tempNotPc} {
+test io-6.27 {Tcl_Flush on closed pipeline} {stdio && tempNotPc} {
removeFile pipe
set f [open pipe w]
puts $f {exit}
close $f
- set f [open "|$tcltest pipe" r+]
+ set f [open "|[list $tcltest pipe]" r+]
gets $f
puts $f output
after 50
@@ -1065,7 +1084,7 @@ test io-6.30 {Tcl_Write, crlf mode} {
close $f
file size test1
} 25
-test io-6.31 {Tcl_Write, background flush} {unixOrPc} {
+test io-6.31 {Tcl_Write, background flush} {stdio} {
removeFile pipe
removeFile output
set f [open pipe w]
@@ -1085,7 +1104,7 @@ test io-6.31 {Tcl_Write, background flush} {unixOrPc} {
}
set f [open output w]
close $f
- set f [open "|$tcltest pipe" r+]
+ set f [open "|[list $tcltest pipe]" r+]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
@@ -1101,7 +1120,7 @@ test io-6.31 {Tcl_Write, background flush} {unixOrPc} {
set result ok
}
} ok
-test io-6.32 {Tcl_Write, background flush to slow reader} {unixOrPc asyncPipeClose} {
+test io-6.32 {Tcl_Write, background flush to slow reader} {stdio && asyncPipeClose} {
removeFile pipe
removeFile output
set f [open pipe w]
@@ -1122,7 +1141,7 @@ test io-6.32 {Tcl_Write, background flush to slow reader} {unixOrPc asyncPipeClo
}
set f [open output w]
close $f
- set f [open "|$tcltest pipe" r+]
+ set f [open "|[list $tcltest pipe]" r+]
fconfigure $f -blocking off
puts -nonewline $f $x
close $f
@@ -1138,7 +1157,7 @@ test io-6.32 {Tcl_Write, background flush to slow reader} {unixOrPc asyncPipeClo
set result ok
}
} ok
-test io-6.33 {Tcl_Flush, implicit flush on exit} {unixOrPc} {
+test io-6.33 {Tcl_Flush, implicit flush on exit} {stdio} {
set f [open script w]
puts $f {
set f [open test1 w]
@@ -1148,7 +1167,7 @@ test io-6.33 {Tcl_Flush, implicit flush on exit} {unixOrPc} {
puts $f strange
}
close $f
- eval exec $tcltest script
+ exec $tcltest script
set f [open test1 r]
set r [read $f]
close $f
@@ -1158,7 +1177,7 @@ bye
strange
}
-test io-6.34 {Tcl_Close, async flush on close, using sockets} {tempNotMac} {
+test io-6.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac} {
set c 0
set x running
set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
@@ -1194,7 +1213,7 @@ test io-6.34 {Tcl_Close, async flush on close, using sockets} {tempNotMac} {
vwait x
set c
} 2000
-test io-6.35 {Tcl_Close vs fileevent vs multiple interpreters} {
+test io-6.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket} {
catch {interp delete x}
catch {interp delete y}
interp create x
@@ -2345,25 +2364,25 @@ test io-9.9 {Tcl_Read, read to end of file} {
}
set x
} ok
-test io-9.10 {Tcl_Read from a pipe} {unixOrPc} {
+test io-9.10 {Tcl_Read from a pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
puts $f1 hello
flush $f1
set x [read $f1]
close $f1
set x
} "hello\n"
-test io-9.11 {Tcl_Read from a pipe} {unixOrPc} {
+test io-9.11 {Tcl_Read from a pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {puts [gets stdin]}
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
puts $f1 hello
flush $f1
set x ""
@@ -2467,12 +2486,12 @@ test io-10.2 {Tcl_Gets into variable} {
close $f1
set z
} ok
-test io-10.3 {Tcl_Gets from pipe} {unixOrPc} {
+test io-10.3 {Tcl_Gets from pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {puts [gets stdin]}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
puts $f1 hello
flush $f1
set x [gets $f1]
@@ -2664,8 +2683,8 @@ test io-11.7 {Tcl_Seek to offset from end of file, then to current position} {
close $f1
list $c1 $r1 $c2
} {44 rstuv 49}
-test io-11.8 {Tcl_Seek on pipes: not supported} {unixOrPc} {
- set f1 [open "|$tcltest" r+]
+test io-11.8 {Tcl_Seek on pipes: not supported} {stdio} {
+ set f1 [open "|[list $tcltest]" r+]
set x [list [catch {seek $f1 0 current} msg] $msg]
close $f1
regsub {".*":} $x {"":} x
@@ -2771,14 +2790,14 @@ test io-11.15 {Tcl_Tell combined with seeking} {
close $f1
list $c1 $c2
} {10 20}
-test io-11.16 {Tcl_tell on pipe: always -1} {unixOrPc} {
- set f1 [open "|$tcltest" r+]
+test io-11.16 {Tcl_tell on pipe: always -1} {stdio} {
+ set f1 [open "|[list $tcltest]" r+]
set c [tell $f1]
close $f1
set c
} -1
-test io-11.17 {Tcl_Tell on pipe: always -1} {unixOrPc} {
- set f1 [open "|$tcltest" r+]
+test io-11.17 {Tcl_Tell on pipe: always -1} {stdio} {
+ set f1 [open "|[list $tcltest]" r+]
puts $f1 {puts hello}
flush $f1
set c [tell $f1]
@@ -2854,13 +2873,13 @@ test io-12.1 {Tcl_Eof} {
close $f
set x
} {0 0 0 0 1 1}
-test io-12.2 {Tcl_Eof with pipe} {unixOrPc} {
+test io-12.2 {Tcl_Eof with pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {gets stdin}
puts $f1 {puts hello}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
puts $f1 hello
set x [eof $f1]
flush $f1
@@ -2872,13 +2891,13 @@ test io-12.2 {Tcl_Eof with pipe} {unixOrPc} {
close $f1
set x
} {0 0 0 1}
-test io-12.3 {Tcl_Eof with pipe} {unixOrPc} {
+test io-12.3 {Tcl_Eof with pipe} {stdio} {
removeFile pipe
set f1 [open pipe w]
puts $f1 {gets stdin}
puts $f1 {puts hello}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
puts $f1 hello
set x [eof $f1]
flush $f1
@@ -2906,14 +2925,14 @@ test io-12.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
close $f
set l
} {{} 1}
-test io-12.5 {Tcl_Eof, eof detection on nonblocking pipe} {unixOrPc} {
+test io-12.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio} {
removeFile pipe
set f [open pipe w]
puts $f {
exit
}
close $f
- set f [open "|$tcltest pipe" r]
+ set f [open "|[list $tcltest pipe]" r]
set l ""
lappend l [gets $f]
lappend l [eof $f]
@@ -3098,7 +3117,7 @@ test io-12.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
# Test Tcl_InputBlocked
test io-13.1 {Tcl_InputBlocked on nonblocking pipe} {unixOrPc tempNotPc} {
- set f1 [open "|$tcltest" r+]
+ set f1 [open "|[list $tcltest]" r+]
puts $f1 {puts hello_from_pipe}
flush $f1
gets $f1
@@ -3117,7 +3136,7 @@ test io-13.1 {Tcl_InputBlocked on nonblocking pipe} {unixOrPc tempNotPc} {
set x
} {{} 1 hello 0 {} 1}
test io-13.2 {Tcl_InputBlocked on blocking pipe} {unixOrPc tempNotPc} {
- set f1 [open "|$tcltest" r+]
+ set f1 [open "|[list $tcltest]" r+]
fconfigure $f1 -buffering line
puts $f1 {puts hello_from_pipe}
set x ""
@@ -3375,7 +3394,7 @@ test io-16.10 {Tcl_SetChannelOption, blocking mode} {unixOrPc tempNotPc} {
puts $f1 {gets stdin}
close $f1
set x ""
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
fconfigure $f1 -blocking off -buffering line
lappend x [fconfigure $f1 -blocking]
lappend x [gets $f1]
@@ -3448,7 +3467,7 @@ test io-17.2 {POSIX open access modes: CREAT} {unixOnly} {
close $f
set x
} {0600 {line 1}}
-test io-17.3 {POSIX open access modes: CREAT} {unixOnly nonPortable umask2} {
+test io-17.3 {POSIX open access modes: CREAT} {$testConfig(unix) && ([exec umask] == 2)} {
# This test only works if your umask is 2, like ouster's.
removeFile test3
set f [open test3 {WRONLY CREAT}]
@@ -3639,8 +3658,8 @@ test io-19.2 {Tcl_FileeventCmd: replacing} {
if {($tcl_platform(platform) != "macintosh") && \
($testConfig(unixExecs) == 1)} {
-catch {set f2 [open {|cat -u} r+]}
-catch {set f3 [open {|cat -u} r+]}
+catch {set f2 [open "|[list cat -u]" r+]}
+catch {set f3 [open "|[list cat -u]" r+]}
test io-20.1 {Tcl_FileeventCmd: creating, deleting, querying} {
set result {}
@@ -3715,8 +3734,8 @@ test io-21.4 {FileEventProc procedure: eror in write event} {
rename bgerror {}
list $x [fileevent $f2 writable]
} {bad-write {}}
-test io-21.5 {FileEventProc procedure: end of file} {unixOrPc unixExecs} {
- set f4 [open {|cat << foo} r]
+test io-21.5 {FileEventProc procedure: end of file} {unixOrPc} {
+ set f4 [open "|[list $tcltest cat << foo]" r]
fileevent $f4 readable {
if {[gets $f4 line] < 0} {
lappend x eof
@@ -4012,7 +4031,7 @@ test io-25.3 {testing readability conditions} {unixOnly nonBlockFiles} {
}
}
close $f
- set f [open |$tcltest r+]
+ set f [open "|[list $tcltest]" r+]
fileevent $f readable [list consume $f]
fconfigure $f -buffering line
fconfigure $f -blocking off
@@ -4610,7 +4629,7 @@ test io-27.6 {testing handler deletion vs reentrant calls} {
{first after update}]
} 0
-test io-28.1 {Test old socket deletion on Macintosh} {tempNotMac} {
+test io-28.1 {Test old socket deletion on Macintosh} {socket} {
set x 0
set result ""
proc accept {s a p} {
@@ -4650,7 +4669,7 @@ test io-28.1 {Test old socket deletion on Macintosh} {tempNotMac} {
test io-29.1 {TclCopyChannel} {
removeFile test1
- set f1 [open io.test]
+ set f1 [open [info script]]
set f2 [open test1 w]
fcopy $f1 $f2 -command { # }
catch { fcopy $f1 $f2 } msg
@@ -4660,9 +4679,9 @@ test io-29.1 {TclCopyChannel} {
} {0}
test io-29.2 {TclCopyChannel} {
removeFile test1
- set f1 [open io.test]
+ set f1 [open [info script]]
set f2 [open test1 w]
- set f3 [open io.test]
+ set f3 [open [info script]]
fcopy $f1 $f2 -command { # }
catch { fcopy $f3 $f2 } msg
close $f1
@@ -4672,7 +4691,7 @@ test io-29.2 {TclCopyChannel} {
} {0}
test io-29.3 {TclCopyChannel} {
removeFile test1
- set f1 [open io.test]
+ set f1 [open [info script]]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
@@ -4680,7 +4699,7 @@ test io-29.3 {TclCopyChannel} {
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
- set s1 [file size io.test]
+ set s1 [file size [info script]]
set s2 [file size test1]
if {("$s1" == "$s2") && ($s0 == $s1)} {
lappend result ok
@@ -4689,7 +4708,7 @@ test io-29.3 {TclCopyChannel} {
} {0 0 ok}
test io-29.4 {TclCopyChannel} {
removeFile test1
- set f1 [open io.test]
+ set f1 [open [info script]]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
@@ -4701,7 +4720,7 @@ test io-29.4 {TclCopyChannel} {
} {0 0 40}
test io-29.5 {TclCopyChannel} {
removeFile test1
- set f1 [open io.test]
+ set f1 [open [info script]]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
@@ -4709,7 +4728,7 @@ test io-29.5 {TclCopyChannel} {
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
- set s1 [file size io.test]
+ set s1 [file size [info script]]
set s2 [file size test1]
if {"$s1" == "$s2"} {
lappend result ok
@@ -4718,15 +4737,15 @@ test io-29.5 {TclCopyChannel} {
} {0 0 ok}
test io-29.6 {TclCopyChannel} {
removeFile test1
- set f1 [open io.test]
+ set f1 [open [info script]]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
- set s0 [fcopy $f1 $f2 -size [expr [file size io.test] + 5]]
+ set s0 [fcopy $f1 $f2 -size [expr [file size [info script]] + 5]]
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
close $f2
- set s1 [file size io.test]
+ set s1 [file size [info script]]
set s2 [file size test1]
if {("$s1" == "$s2") && ($s0 == $s1)} {
lappend result ok
@@ -4735,13 +4754,13 @@ test io-29.6 {TclCopyChannel} {
} {0 0 ok}
test io-29.7 {TclCopyChannel} {
removeFile test1
- set f1 [open io.test]
+ set f1 [open [info script]]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation lf -blocking 0
fcopy $f1 $f2
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
- set s1 [file size io.test]
+ set s1 [file size [info script]]
set s2 [file size test1]
close $f1
close $f2
@@ -4750,23 +4769,27 @@ test io-29.7 {TclCopyChannel} {
}
set result
} {0 0 ok}
-test io-29.8 {TclCopyChannel} {unixOrPc} {
+test io-29.8 {TclCopyChannel} {stdio} {
removeFile test1
removeFile pipe
set f1 [open pipe w]
+ fconfigure $f1 -translation lf
puts $f1 {
puts ready
gets stdin
- set f1 [open io.test r]
+ set f1 [open [info script] r]
+ fconfigure $f1 -translation lf
puts [read $f1 100]
close $f1
}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
+ fconfigure $f1 -translation lf
gets $f1
puts $f1 ready
flush $f1
set f2 [open test1 w]
+ fconfigure $f2 -translation lf
set s0 [fcopy $f1 $f2 -size 40]
catch {close $f1}
close $f2
@@ -4775,7 +4798,7 @@ test io-29.8 {TclCopyChannel} {unixOrPc} {
test io-30.1 {CopyData} {
removeFile test1
- set f1 [open io.test]
+ set f1 [open [info script]]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
@@ -4787,7 +4810,7 @@ test io-30.1 {CopyData} {
} {0 0 0}
test io-30.2 {CopyData} {
removeFile test1
- set f1 [open io.test]
+ set f1 [open [info script]]
set f2 [open test1 w]
fconfigure $f1 -translation lf -blocking 0
fconfigure $f2 -translation cr -blocking 0
@@ -4796,7 +4819,7 @@ test io-30.2 {CopyData} {
vwait s0
close $f1
close $f2
- set s1 [file size io.test]
+ set s1 [file size [info script]]
set s2 [file size test1]
if {("$s1" == "$s2") && ($s0 == $s1)} {
lappend result ok
@@ -4818,7 +4841,7 @@ test io-30.3 {CopyData: background read underflow} {unixOnly} {
close $f
}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
set result [gets $f1]
puts $f1 line1
flush $f1
@@ -4851,7 +4874,7 @@ test io-30.4 {CopyData: background write overflow} {unixOnly} {
close $f
}
close $f1
- set f1 [open "|$tcltest pipe" r+]
+ set f1 [open "|[list $tcltest pipe]" r+]
set result [gets $f1]
fconfigure $f1 -blocking 0
puts $f1 $big
@@ -4885,21 +4908,38 @@ if [catch {socket -server FcopyTestAccept 2828} listen] {
puts stderr "Skipping fcopy error test"
} else {
test io-30.5 {CopyData: error during fcopy} {
- set in [open io.test] ;# 126 K
+ set in [open [info script]] ;# 126 K
set out [socket localhost 2828]
catch {unset fcopyTestDone}
close $listen ;# This means the socket open never really succeeds
fcopy $in $out -command FcopyTestDone
if ![info exists fcopyTestDone] {
- vwait fcopyTestDone
+ vwait fcopyTestDone ;# The error occurs here in the b.g.
}
close $in
close $out
- set fcopyTestDone
+ set fcopyTestDone ;# 1 for error condition
} 1
}
+test io-30.6 {CopyData: error during fcopy} {stdio} {
+ removeFile pipe
+ removeFile test1
+ catch {unset fcopyTestDone}
+ set f1 [open pipe w]
+ puts $f1 "exit 1"
+ close $f1
+ set in [open "|[list $tcltest pipe]" r+]
+ set out [open test1 w]
+ fcopy $in $out -command [list FcopyTestDone]
+ if ![info exists fcopyTestDone] {
+ vwait fcopyTestDone
+ }
+ catch {close $in}
+ close $out
+ set fcopyTestDone ;# 0 for plain end of file
+} {0}
-test io-31.1 {Recursive channel events} {
+test io-31.1 {Recursive channel events} {socket} {
# This test checks to see if file events are delivered during recursive
# event loops when there is buffered data on the channel.
@@ -4951,7 +4991,7 @@ test io-31.1 {Recursive channel events} {
close $cs
list $result $x
} {{{line 1} 1 2} 2}
-test io-31.2 {Testing for busy-wait in recursive channel events} {
+test io-31.2 {Testing for busy-wait in recursive channel events} {socket} {
set s [socket -server accept 3939]
proc accept {s a p} {
global counter
@@ -4998,7 +5038,23 @@ test io-31.2 {Testing for busy-wait in recursive channel events} {
close $s
set counter
} 1
+test io-32.1 {ChannelEventScriptInvoker: deletion} {
+ proc eventScript {fd} {
+ close $fd
+ error "planned error"
+ set ::x whoops
+ }
+ proc bgerror {args} {
+ set ::x got_error
+ }
+ set f [open fooBar w]
+ fileevent $f writable [list eventScript $f]
+ set x not_done
+ vwait x
+ set x
+} {got_error}
+removeFile fooBar
removeFile longfile
removeFile script
removeFile output
@@ -5010,5 +5066,7 @@ removeFile bar
removeFile test2
removeFile test3
+file delete cat
+
set x ""
unset x
OpenPOWER on IntegriCloud