summaryrefslogtreecommitdiffstats
path: root/tests/io.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/io.test')
-rw-r--r--tests/io.test329
1 files changed, 188 insertions, 141 deletions
diff --git a/tests/io.test b/tests/io.test
index 73481ca..2752408 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -13,8 +13,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
}
namespace eval ::tcl::test::io {
@@ -38,12 +38,13 @@ namespace eval ::tcl::test::io {
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
-testConstraint openpipe 1
testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint testobj [llength [info commands testobj]]
+testConstraint testservicemode [llength [info commands testservicemode]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
+testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
@@ -481,7 +482,7 @@ test io-6.6 {Tcl_GetsObj: loop test} {
close $f
set x
} [list 256 $a]
-test io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} {
+test io-6.7 {Tcl_GetsObj: error in input} stdio {
# if (FilterInputBytes(chanPtr, &gs) != 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -741,7 +742,7 @@ test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {
close $f
set x
} [list 15 "123456789012345" 15]
-test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} {
+test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel fileevent} {
# (FilterInputBytes() != 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -880,7 +881,7 @@ test io-6.42 {Tcl_GetsObj: auto mode: several chars} {
close $f
set x
} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
-test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} {
+test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel fileevent} {
# if (chanPtr->flags & INPUT_SAW_CR)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -897,7 +898,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
close $f
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
+test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fileevent} {
# not (*eol == '\n')
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -914,7 +915,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel
close $f
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
-test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} {
+test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel fileevent} {
# Tcl_ExternalToUtf()
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -931,7 +932,7 @@ test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio test
close $f
set x
} [list 15 "123456789abcdef" 1 4 "abcd" 0]
-test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} {
+test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel fileevent} {
# memmove()
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1056,7 +1057,7 @@ test io-6.55 {Tcl_GetsObj: overconverted} {
close $f
set x
} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
-test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio openpipe fileevent} {
+test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} {
update
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -buffering none
@@ -1116,7 +1117,7 @@ test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
close $f
set x
} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
-test io-7.4 {FilterInputBytes: recover from split up character} {stdio openpipe fileevent} {
+test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none
puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
@@ -1151,7 +1152,7 @@ test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel}
close $f
set x
} "7"
-test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel openpipe fileevent} {
+test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel fileevent} {
# not (bufPtr->nextPtr == NULL)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1171,7 +1172,7 @@ test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testcha
close $f
set x
} [list -1 "" 42 15 "123456789012345" 25]
-test io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} {
+test io-8.3 {PeekAhead: no cached data available} {stdio testchannel fileevent} {
# (bytesLeft == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1204,7 +1205,7 @@ test io-8.4 {PeekAhead: cached data available in this buffer} {
set x
} $a
unset a
-test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
+test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel fileevent} {
# (bufPtr->nextAdded < bufPtr->length)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1216,7 +1217,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel op
close $f
set x
} {15 abcdefghijklmno 1}
-test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
+test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel fileevent} {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1228,7 +1229,7 @@ test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe
close $f
set x
} {15 abcdefghijklmno 1}
-test io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} {
+test io-8.7 {PeekAhead: cleanup} {stdio testchannel fileevent} {
# Make sure bytes are removed from buffer.
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1393,7 +1394,7 @@ test io-12.3 {ReadChars: allocate more space} {
close $f
set x
} {abcdefghijklmnopqrstuvwxyz}
-test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
+test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} {
# (srcRead == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1418,7 +1419,7 @@ test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
close $f
set x
} [list "123456789012345" 1 "\u672c" 0]
-test io-12.5 {ReadChars: fileevents on partial characters} {stdio openpipe fileevent} {
+test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
set path(test1) [makeFile {
fconfigure stdout -encoding binary -buffering none
gets stdin; puts -nonewline "\xe7"
@@ -1612,7 +1613,7 @@ test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
close $f
set x
} "abcd\ndef\nfgh"
-test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel openpipe fileevent} {
+test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel fileevent} {
# (chanPtr->flags & INPUT_SAW_CR)
# This test may fail on slower machines.
@@ -1638,7 +1639,7 @@ test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testc
close $f
set x
} [list "abcdefghj\n" 1 "01234" 0]
-test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} {
+test io-13.7 {TranslateInputEOL: auto mode: naked \r} testchannel {
# (src >= srcMax)
set f [open $path(test1) w]
@@ -1783,7 +1784,7 @@ test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
set l
} {line line none}
set path(test3) [makeFile {} test3]
-test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
+test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} exec {
set f [open $path(test1) w]
puts -nonewline $f {
close stdin
@@ -1873,7 +1874,7 @@ test io-14.7 {Tcl_GetChannel: stdio name translation} {
set result
} {{} {} {can not find channel named "stderr"}}
set path(script) [makeFile {} script]
-test io-14.8 {reuse of stdio special channels} {stdio openpipe} {
+test io-14.8 {reuse of stdio special channels} stdio {
file delete $path(script)
file delete $path(test1)
set f [open $path(script) w]
@@ -1895,7 +1896,7 @@ test io-14.8 {reuse of stdio special channels} {stdio openpipe} {
close $f
set c
} hello
-test io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
+test io-14.9 {reuse of stdio special channels} {stdio fileevent} {
file delete $path(script)
file delete $path(test1)
set f [open $path(script) w]
@@ -2078,7 +2079,7 @@ test io-20.3 {Tcl_CreateChannel: initial settings} {unix} {
set x
} {{{} {}} {auto lf}}
set path(stdout) [makeFile {} stdout]
-test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} {
+test io-20.5 {Tcl_CreateChannel: install channel in empty slot} stdio {
set f [open $path(script) w]
puts -nonewline $f {
close stdout
@@ -2152,7 +2153,7 @@ test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} {
set l
} {6 6 0 6}
-test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
+test io-26.1 {Tcl_GetChannelInstanceData} stdio {
# "pid" command uses Tcl_GetChannelInstanceData
# Don't care what pid is (but must be a number), just want to exercise it.
@@ -2229,7 +2230,7 @@ test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
set path(pipe) [makeFile {} pipe]
set path(output) [makeFile {} output]
test io-27.6 {FlushChannel, async flushing, async close} \
- {stdio asyncPipeClose openpipe knownMsvcBug} {
+ {stdio asyncPipeClose knownMsvcBug} {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -2298,7 +2299,7 @@ test io-28.2 {CloseChannel called when all references are dropped} {
set l
} abcdef
test io-28.3 {CloseChannel, not called before output queue is empty} \
- {stdio asyncPipeClose nonPortable openpipe} {
+ {stdio asyncPipeClose nonPortable} {
file delete $path(pipe)
file delete $path(output)
set f [open $path(pipe) w]
@@ -2355,7 +2356,7 @@ test io-28.4 {Tcl_Close} {testchannel} {
$consoleFileNames]
string compare $l $x
} 0
-test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel openpipe} {
+test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel} {
file delete $path(script)
set f [open $path(script) w]
puts $f {
@@ -2494,7 +2495,7 @@ test io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
close $f2
file size $path(test1)
} 377
-test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
+test io-29.12 {Tcl_WriteChars on a pipe} stdio {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -2519,7 +2520,7 @@ test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
close $f2
set y
} ok
-test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} {
+test io-29.13 {Tcl_WriteChars to a pipe, line buffered} stdio {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -2570,7 +2571,7 @@ test io-29.15 {Tcl_Flush, channel not open for writing} {
string compare $x \
[list 1 "channel \"$fd\" wasn't opened for writing"]
} 0
-test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} {
+test io-29.16 {Tcl_Flush on pipe opened only for reading} stdio {
set fd [open "|[list [interpreter] cat longfile]" r]
set x [list [catch {flush $fd} msg] $msg]
catch {close $fd}
@@ -2644,7 +2645,7 @@ test io-29.20 {Implicit flush when buffer is full} {
lappend z [file size $path(test1)]
set z
} {4096 12288 12600}
-test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
+test io-29.21 {Tcl_Flush to pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {set x [read stdin 6]}
@@ -2658,7 +2659,7 @@ test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
catch {close $f1}
set x
} "read 6 characters"
-test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
+test io-29.22 {Tcl_Flush called at other end of pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
@@ -2681,7 +2682,7 @@ test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
close $f1
set x
} {hello hello bye}
-test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe} {
+test io-29.23 {Tcl_Flush and line buffering at end of pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
@@ -2716,7 +2717,7 @@ test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
close $f
set x
} "{} {Line 1\nLine 2}"
-test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpipe fileevent} {
+test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio fileevent} {
file delete $path(test3)
set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w]
puts $f "Line 1"
@@ -2728,7 +2729,7 @@ test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpi
close $f
set x
} "Line 1\nLine 2\n"
-test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs openpipe} {
+test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} {
set f [open "|[list cat -u]" r+]
puts $f "Line1"
flush $f
@@ -2736,7 +2737,7 @@ test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs
close $f
set x
} {Line1}
-test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} {
+test io-29.27 {Tcl_Flush on closed pipeline} stdio {
file delete $path(pipe)
set f [open $path(pipe) w]
puts $f {exit}
@@ -2790,7 +2791,7 @@ test io-29.30 {Tcl_WriteChars, crlf mode} {
close $f
file size $path(test1)
} 25
-test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
+test io-29.31 {Tcl_WriteChars, background flush} stdio {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -2827,13 +2828,13 @@ test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
set result ok
}
# allow a little time for the background process to close.
- # otherwise, the following test fails on the [file delete $path(output)
+ # otherwise, the following test fails on the [file delete $path(output)]
# on Windows because a process still has the file open.
after 100 set v 1; vwait v
set result
} ok
test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
- {stdio asyncPipeClose openpipe knownMsvcBug} {
+ {stdio asyncPipeClose knownMsvcBug} {
# This test may fail on old Unix systems (seen on IRIX64 6.5) with
# obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197.
file delete $path(pipe)
@@ -4093,7 +4094,7 @@ test io-32.9 {Tcl_Read, read to end of file} {
}
set x
} ok
-test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.10 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
@@ -4105,7 +4106,7 @@ test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
close $f1
set x
} "hello\n"
-test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.11 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
@@ -4124,7 +4125,7 @@ test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
} {{hello
} {hello
}}
-test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.11.1 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {chan configure stdout -translation crlf}
@@ -4144,7 +4145,7 @@ test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
} {{hello
} {hello
}}
-test io-32.11.2 {Tcl_Read from a pipe} {stdio openpipe} {
+test io-32.11.2 {Tcl_Read from a pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {chan configure stdout -translation crlf}
@@ -4255,7 +4256,7 @@ test io-33.2 {Tcl_Gets into variable} {
close $f1
set z
} ok
-test io-33.3 {Tcl_Gets from pipe} {stdio openpipe} {
+test io-33.3 {Tcl_Gets from pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {puts [gets stdin]}
@@ -4563,7 +4564,7 @@ test io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
close $f1
list $c1 $r1 $c2
} {44 rstuv 49}
-test io-34.8 {Tcl_Seek on pipes: not supported} {stdio openpipe} {
+test io-34.8 {Tcl_Seek on pipes: not supported} stdio {
set f1 [open "|[list [interpreter]]" r+]
set x [list [catch {seek $f1 0 current} msg] $msg]
close $f1
@@ -4671,13 +4672,13 @@ test io-34.15 {Tcl_Tell combined with seeking} {
close $f1
list $c1 $c2
} {10 20}
-test io-34.16 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+test io-34.16 {Tcl_Tell on pipe: always -1} stdio {
set f1 [open "|[list [interpreter]]" r+]
set c [tell $f1]
close $f1
set c
} -1
-test io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+test io-34.17 {Tcl_Tell on pipe: always -1} stdio {
set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello}
flush $f1
@@ -4776,7 +4777,7 @@ test io-35.1 {Tcl_Eof} {
close $f
set x
} {0 0 0 0 1 1}
-test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
+test io-35.2 {Tcl_Eof with pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {gets stdin}
@@ -4794,7 +4795,7 @@ test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
close $f1
set x
} {0 0 0 1}
-test io-35.3 {Tcl_Eof with pipe} {stdio openpipe} {
+test io-35.3 {Tcl_Eof with pipe} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {gets stdin}
@@ -4828,7 +4829,7 @@ test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
close $f
set l
} {{} 1}
-test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio openpipe} {
+test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio {
file delete $path(pipe)
set f [open $path(pipe) w]
puts $f {
@@ -5105,7 +5106,7 @@ test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} {
# Test Tcl_InputBlocked
-test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
+test io-36.1 {Tcl_InputBlocked on nonblocking pipe} stdio {
set f1 [open "|[list [interpreter]]" r+]
puts $f1 {puts hello_from_pipe}
flush $f1
@@ -5124,7 +5125,7 @@ test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
close $f1
set x
} {{} 1 hello 0 {} 1}
-test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} {
+test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio {
set f1 [open "|[list [interpreter]]" r+]
chan configure $f1 -encoding binary -translation lf -eofchar {}
puts $f1 {
@@ -5147,7 +5148,7 @@ test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} {
close $f1
set x
} {{} 1 hello 0 {} 1}
-test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} {
+test io-36.2 {Tcl_InputBlocked on blocking pipe} stdio {
set f1 [open "|[list [interpreter]]" r+]
fconfigure $f1 -buffering line
puts $f1 {puts hello_from_pipe}
@@ -5411,7 +5412,7 @@ test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
close $f1
set x
} {1 0 {} {} 0 1}
-test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
+test io-39.10 {Tcl_SetChannelOption, blocking mode} stdio {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts $f1 {
@@ -5502,7 +5503,7 @@ test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
close $f
set result
} {1 {unknown encoding "foobar"}}
-test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio openpipe fileevent} {
+test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" r+]
fconfigure $f -encoding binary
puts -nonewline $f "\xe7"
@@ -5851,7 +5852,7 @@ test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs f
test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
set result {}
lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
fileevent $f r "read f"
@@ -5872,7 +5873,7 @@ test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
test io-44.1 {FileEventProc procedure: normal read event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
fileevent $f2 readable [namespace code {
set x [gets $f2]; fileevent $f2 readable {}
}]
@@ -5885,7 +5886,7 @@ test io-44.1 {FileEventProc procedure: normal read event} -setup {
catch {close $f3}
} -result {text}
test io-44.2 {FileEventProc procedure: error in read event} -constraints {
- stdio unixExecs fileevent openpipe
+ stdio unixExecs fileevent
} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
@@ -5908,7 +5909,7 @@ test io-44.2 {FileEventProc procedure: error in read event} -constraints {
test io-44.3 {FileEventProc procedure: normal write event} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
fileevent $f2 writable [namespace code {
lappend x "triggered"
incr count -1
@@ -5927,7 +5928,7 @@ test io-44.3 {FileEventProc procedure: normal write event} -setup {
catch {close $f3}
} -result {initial triggered triggered triggered}
test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
- stdio unixExecs fileevent openpipe
+ stdio unixExecs fileevent
} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
@@ -5946,7 +5947,9 @@ test io-44.4 {FileEventProc procedure: eror in write event} -constraints {
catch {close $f2}
catch {close $f3}
} -result {bad-write {}}
-test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+test io-44.5 {FileEventProc procedure: end of file} -constraints {
+ stdio unixExecs fileevent
+} -body {
set f4 [open "|[list [interpreter] $path(cat) << foo]" r]
fileevent $f4 readable [namespace code {
if {[gets $f4 line] < 0} {
@@ -5959,9 +5962,10 @@ test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fi
variable x initial
vwait [namespace which -variable x]
vwait [namespace which -variable x]
- close $f4
set x
-} {initial foo eof}
+} -cleanup {
+ close $f4
+} -result {initial foo eof}
close $f
@@ -6084,7 +6088,7 @@ test io-45.3 {DeleteFileEvent, cleanup on close} {fileevent} {
# Execute these tests only if the "testfevent" command is present.
-test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
+test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent notOSX} {
testfevent create
set script "set f \[[list open $path(foo) r]]\n"
append script {
@@ -6094,9 +6098,10 @@ test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
fileevent $f readable {}
}]
}
+ set timer [after 10 lappend x timeout]
testfevent cmd $script
- after 1 ;# We must delay because Windows takes a little time to notice
- update
+ vwait x
+ after cancel $timer
testfevent cmd {close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
@@ -6285,7 +6290,7 @@ test io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
list $x $l
} {done {called called called called called called called}}
set path(my_script) [makeFile {} my_script]
-test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles openpipe fileevent} {
+test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles fileevent} {
set f [open $path(bar) w]
puts $f abcdefg
puts $f abcdefg
@@ -6783,47 +6788,57 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} {
set l
} [list 7 a\rb\rc 7 {} 7 1]
-test io-50.1 {testing handler deletion} {testchannelevent} {
+test io-50.1 {testing handler deletion} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f]]
+ update
proc delhandler {f} {
variable z
set z called
testchannelevent $f delete 0
}
set z not_called
- update
- close $f
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f]]
+ testservicemode 1
+ vwait z
+ after cancel $timer
set z
-} called
-test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} {
+} -cleanup {
+ close $f
+} -result called
+test io-50.2 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delhandler $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
proc delhandler {f i} {
variable z
- lappend z "called delhandler $f $i"
+ lappend z "called delhandler $i"
testchannelevent $f delete 0
}
set z ""
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delhandler $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- [list [list called delhandler $f 0] [list called delhandler $f 1]]
-} 0
-test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} {
+} -result {{called delhandler 0} {called delhandler 1}}
+test io-50.3 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f 1]]
- testchannelevent $f add readable [namespace code [list delhandler $f 0]]
set z ""
proc notcalled {f i} {
variable z
@@ -6832,23 +6847,30 @@ test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent
proc delhandler {f i} {
variable z
testchannelevent $f delete 1
- lappend z "delhandler $f $i called"
+ lappend z "delhandler $i called"
testchannelevent $f delete 0
- lappend z "delhandler $f $i deleted myself"
+ lappend z "delhandler $i deleted myself"
}
set z ""
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f 1]]
+ testchannelevent $f add readable [namespace code [list delhandler $f 0]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- [list [list delhandler $f 0 called] \
- [list delhandler $f 0 deleted myself]]
-} 0
-test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
+} -result {{delhandler 0 called} {delhandler 0 deleted myself}}
+test io-50.4 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+ update
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list delrecursive $f]]
+ update
proc delrecursive {f} {
variable z
variable u
@@ -6863,18 +6885,22 @@ test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
}
variable u toplevel
variable z ""
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list delrecursive $f]]
+ testservicemode 1
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- {{delrecursive calling recursive} {delrecursive deleting recursive}}
-} 0
-test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
+} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
+test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode notOSX} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f]]
- testchannelevent $f add readable [namespace code [list del $f]]
proc notcalled {f} {
variable z
lappend z "notcalled was called!! $f"
@@ -6884,39 +6910,50 @@ test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
variable z
if {"$u" == "recursive"} {
testchannelevent $f delete 1
- testchannelevent $f delete 0
lappend z "del deleted notcalled"
+ testchannelevent $f delete 0
lappend z "del deleted myself"
} else {
set u recursive
lappend z "del calling recursive"
- update
- lappend z "del after update"
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ lappend z "del after recursive"
}
}
set z ""
set u toplevel
- update
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list notcalled $f]]
+ testchannelevent $f add readable [namespace code [list del $f]]
+ testservicemode 1
+ set timer [after 50 set z timeout]
+ vwait z
+ after cancel $timer
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- [list {del calling recursive} {del deleted notcalled} \
- {del deleted myself} {del after update}]
-} 0
-test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
+} -result [list {del calling recursive} {del deleted notcalled} \
+ {del deleted myself} {del after recursive}]
+test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup {
file delete $path(test1)
+} -body {
set f [open $path(test1) w]
close $f
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list second $f]]
- testchannelevent $f add readable [namespace code [list first $f]]
proc first {f} {
variable u
variable z
+ variable done
if {"$u" == "toplevel"} {
lappend z "first called"
set u first
- update
- lappend z "first after update"
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ lappend z "first after toplevel"
+ set done 1
} else {
lappend z "first called not toplevel"
}
@@ -6938,14 +6975,24 @@ test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
}
set z ""
set u toplevel
+ set done 0
+ testservicemode 0
+ set f [open $path(test1) r]
+ testchannelevent $f add readable [namespace code [list second $f]]
+ testchannelevent $f add readable [namespace code [list first $f]]
+ testservicemode 1
update
+ if {!$done} {
+ set timer2 [after 200 set done 1]
+ vwait done
+ after cancel $timer2
+ }
+ set z
+} -cleanup {
close $f
- string compare [string tolower $z] \
- [list {first called} {first called not toplevel} \
- {second called, first time} {second called, second time} \
- {first after update}]
-} 0
-
+} -result [list {first called} {first called not toplevel} \
+ {second called, first time} {second called, second time} \
+ {first after toplevel}]
test io-51.1 {Test old socket deletion on Macintosh} {socket} {
set x 0
set result ""
@@ -7135,7 +7182,7 @@ test io-52.7 {TclCopyChannel} {fcopy} {
}
set result
} {0 0 ok}
-test io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
+test io-52.8 {TclCopyChannel} {stdio fcopy} {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -7415,7 +7462,7 @@ test io-53.2 {CopyData} {fcopy} {
}
set result
} {0 0 ok}
-test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} {
+test io-53.3 {CopyData: background read underflow} {stdio unix fcopy} {
file delete $path(test1)
file delete $path(pipe)
set f1 [open $path(pipe) w]
@@ -7447,7 +7494,7 @@ test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} {
close $f
set result
} "ready line1 line2 {done\n}"
-test io-53.4 {CopyData: background write overflow} {stdio openpipe fileevent fcopy} {
+test io-53.4 {CopyData: background write overflow} {stdio fileevent fcopy} {
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
variable x
for {set x 0} {$x < 12} {incr x} {
@@ -7538,7 +7585,7 @@ test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
close $out
set fcopyTestDone ;# 1 for error condition
} 1
-test io-53.6 {CopyData: error during fcopy} {stdio openpipe fcopy} {
+test io-53.6 {CopyData: error during fcopy} {stdio fcopy} {
variable fcopyTestDone
file delete $path(pipe)
file delete $path(test1)
@@ -7571,7 +7618,7 @@ proc doFcopy {in out {bytes 0} {error {}}} {
-command [namespace code [list doFcopy $in $out]]]
}
}
-test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} {
+test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} {
variable fcopyTestDone
file delete $path(pipe)
catch {unset fcopyTestDone}
@@ -7623,7 +7670,7 @@ test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup {
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Record input size, so that result is always defined
lappend ::RES [file size $bar]
# Run the copy. Should not invoke -command now.
@@ -7664,7 +7711,7 @@ test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof}
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Initialize and force eof on the input.
seek $f 0 end ; read $f 1
set ::RES [eof $f]
@@ -7704,7 +7751,7 @@ test io-53.8b {CopyData: async callback and -size 0} -setup {
# Channels to copy between
set f [open $foo r] ; fconfigure $f -translation binary
set g [open $bar w] ; fconfigure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set ::RES {}
# Run the copy. Should not invoke -command now.
fcopy $f $g -size 0 -command ::cmd
@@ -7761,7 +7808,7 @@ test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup {
}
set ::forever {}
set out [open $out w]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
fcopy $pipe $out -size 6 -command ::done
set token [after 5000 {
set ::forever {fcopy hangs}
@@ -7831,7 +7878,7 @@ test io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
fconfigure $b -translation binary -buffering none
fileevent $a readable [list ::done $a]
fileevent $b readable [list ::done $b]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Now pass data through the server in both directions.
set ::forever {}
puts $a AB
@@ -7879,7 +7926,7 @@ test io-53.11 {Bug 2895565} -setup {
removeFile out
removeFile in
} -result {40 bytes copied}
-test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix openpipe fcopy} {
+test io-53.12 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} {
file delete $path(pipe)
set f1 [open $path(pipe) w]
puts -nonewline $f1 {
@@ -8294,7 +8341,7 @@ test io-57.2 {buffered data and file events, read} {fileevent} {
set result
} {1 readable 234567890 timer}
-test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
+test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} {
set out [open $path(script) w]
puts $out {
puts "normal message from pipe"
@@ -8334,7 +8381,7 @@ test io-59.1 {Thread reference of channels} {testmainthread testchannel} {
string equal $result [testmainthread]
} {1}
-test io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
+test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# This test will hang in older revisions of the core.
set out [open $path(script) w]
@@ -8712,16 +8759,16 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup {
set fn [makeFile {} io-74.1]
set rfd [open $fn r]
testobj freeallvars
- interp create slave
+ interp create child
} -constraints testobj -body {
teststringobj set 1 [string range $rfd 0 end]
read [teststringobj get 1]
testobj duplicate 1 2
- interp transfer {} $rfd slave
+ interp transfer {} $rfd child
catch {read [teststringobj get 1]}
read [teststringobj get 2]
} -cleanup {
- interp delete slave
+ interp delete child
testobj freeallvars
removeFile io-74.1
} -returnCodes error -match glob -result {can not find channel named "*"}
generated by cgit v0.12 at 2024-10-22 07:26:48 (GMT)