summaryrefslogtreecommitdiffstats
path: root/tests/chanio.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/chanio.test')
-rw-r--r--tests/chanio.test263
1 files changed, 153 insertions, 110 deletions
diff --git a/tests/chanio.test b/tests/chanio.test
index c7c07ce..daacdd0 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -13,13 +13,17 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-# TODO: This test is likely worthless. Confirm and remove
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
}
namespace eval ::tcl::test::io {
- namespace import ::tcltest::*
+
+ if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+ namespace import -force ::tcltest::*
+ }
variable umaskValue
variable path
@@ -39,11 +43,12 @@ 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 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...
@@ -448,7 +453,7 @@ test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
} -cleanup {
chan close $f
} -result [list 256 $a]
-test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints {stdio openpipe} -body {
+test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints stdio -body {
# if (FilterInputBytes(chanPtr, &gs) != 0)
set f [openpipe w+ $path(cat)]
chan puts -nonewline $f "hi\nwould"
@@ -709,7 +714,7 @@ test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} -constraints {testc
} -result [list 15 "123456789012345" 15]
test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# (FilterInputBytes() != 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {crlf lf} -buffering none
@@ -849,7 +854,7 @@ test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} -setup {
} -result {4 abcd 4 efgh 4 ijkl 4 mnop -1 {}}
test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# if (chanPtr->flags & INPUT_SAW_CR)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -867,7 +872,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# not (*eol == '\n')
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -885,7 +890,7 @@ test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
} -result {bbbbbbbbbbbbbbb 15 123456789abcdef 1 4 abcd 0 3 efg}
test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# Tcl_ExternalToUtf()
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -903,7 +908,7 @@ test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup
} -result {15 123456789abcdef 1 4 abcd 0}
test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# memmove()
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
@@ -1021,7 +1026,7 @@ test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
update
variable x {}
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -buffering none
chan puts -nonewline $f "foobar"
@@ -1088,7 +1093,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
} -result [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
variable x ""
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none
chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
@@ -1122,7 +1127,7 @@ test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constrai
} -result 7
test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup {
variable x {}
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# not (bufPtr->nextPtr == NULL)
set f [openpipe w+ $path(cat)]
chan configure $f -translation lf -encoding ascii -buffering none
@@ -1139,7 +1144,7 @@ test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup {
} -cleanup {
chan close $f
} -result {-1 {} 42 15 123456789012345 25}
-test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel openpipe fileevent} -body {
+test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel fileevent} -body {
# (bytesLeft == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary}
@@ -1168,7 +1173,7 @@ test chan-io-8.4 {PeekAhead: cached data available in this buffer} -body {
chan close $f
} -result $a
unset a
-test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel openpipe fileevent} -body {
+test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel fileevent} -body {
# (bufPtr->nextAdded < bufPtr->length)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary}
@@ -1179,7 +1184,7 @@ test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {st
} -cleanup {
chan close $f
} -result {15 abcdefghijklmno 1}
-test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
+test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel fileevent} -body {
# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffersize 16
@@ -1192,7 +1197,7 @@ test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio te
} -result {15 abcdefghijklmno 1}
test chan-io-8.7 {PeekAhead: cleanup} -setup {
set x ""
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# Make sure bytes are removed from buffer.
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffering none
@@ -1343,7 +1348,7 @@ test chan-io-12.3 {ReadChars: allocate more space} -body {
} -result {abcdefghijklmnopqrstuvwxyz}
test chan-io-12.4 {ReadChars: split-up char} -setup {
variable x {}
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# (srcRead == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none -buffersize 16
@@ -1365,7 +1370,7 @@ test chan-io-12.4 {ReadChars: split-up char} -setup {
} -result [list "123456789012345" 1 "\u672c" 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
variable x {}
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set path(test1) [makeFile {
chan configure stdout -encoding binary -buffering none
chan gets stdin; chan puts -nonewline "\xe7"
@@ -1458,7 +1463,7 @@ test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup {
variable x {}
variable y {}
-} -constraints {stdio testchannel openpipe fileevent} -body {
+} -constraints {stdio testchannel fileevent} -body {
# (chanPtr->flags & INPUT_SAW_CR)
# This test may fail on slower machines.
set f [openpipe w+ $path(cat)]
@@ -1476,7 +1481,7 @@ test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup
} -cleanup {
chan close $f
} -result [list "abcdefghj\n" 1 "01234" 0]
-test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints {testchannel openpipe} -body {
+test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} -constraints testchannel -body {
# (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
@@ -1577,7 +1582,7 @@ test chan-io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} -setup {
interp delete x
} -result {line line none}
set path(test3) [makeFile {} test3]
-test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec openpipe} -body {
+test chan-io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints exec -body {
set f [open $path(test1) w]
chan puts -nonewline $f {
chan close stdin
@@ -1674,7 +1679,7 @@ set path(script) [makeFile {} script]
test chan-io-14.8 {reuse of stdio special channels} -setup {
file delete $path(script)
file delete $path(test1)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stderr
@@ -1697,7 +1702,7 @@ test chan-io-14.8 {reuse of stdio special channels} -setup {
test chan-io-14.9 {reuse of stdio special channels} -setup {
file delete $path(script)
file delete $path(test1)
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [open $path(script) w]
chan puts $f {
array set path [lindex $argv 0]
@@ -1881,7 +1886,7 @@ test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -bod
} -result {{{} {}} {auto lf}}
test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup {
set path(stdout) [makeFile {} stdout]
-} -constraints {stdio openpipe knownMsvcBug} -body {
+} -constraints {stdio knownMsvcBug} -body {
set f [open $path(script) w]
chan puts -nonewline $f {
chan close stdout
@@ -1966,7 +1971,7 @@ test chan-io-26.1 {Tcl_GetChannelInstanceData} -body {
# Don't care what pid is (but must be a number), just want to exercise it.
set f [openpipe r << exit]
pid $f
-} -constraints {stdio openpipe} -cleanup {
+} -constraints stdio -cleanup {
chan close $f
} -match regexp -result {^\d+$}
@@ -2041,7 +2046,7 @@ set path(output) [makeFile {} output]
test chan-io-27.6 {FlushChannel, async flushing, async chan close} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio asyncPipeChan Close openpipe} -body {
+} -constraints {stdio asyncPipeChan Close} -body {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {
@@ -2111,7 +2116,7 @@ test chan-io-28.2 {Chan CloseChannel called when all references are dropped} -se
test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio asyncPipeChan Close nonPortable openpipe} -body {
+} -constraints {stdio asyncPipeChan Close nonPortable} -body {
set f [open $path(pipe) w]
chan puts $f {
# Need to not have eof char appended on chan close, because the other
@@ -2165,7 +2170,7 @@ test chan-io-28.4 {Tcl_Chan Close} -constraints {testchannel} -setup {
} -result ok
test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup {
file delete $path(script)
-} -constraints {stdio unix testchannel openpipe} -body {
+} -constraints {stdio unix testchannel} -body {
set f [open $path(script) w]
chan puts $f {
chan close stdin
@@ -2382,7 +2387,7 @@ test chan-io-29.11 {Tcl_WriteChars, no newline, implicit flush} -setup {
test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 "set f1 \[[list open $path(longfile) r]]"
chan puts $f1 {
@@ -2409,7 +2414,7 @@ test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup {
test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts [chan gets stdin]
@@ -2462,7 +2467,7 @@ test chan-io-29.15 {Tcl_Flush, channel not open for writing} -setup {
} -match glob -result {channel "*" wasn't opened for writing}
test chan-io-29.16 {Tcl_Flush on pipe opened only for reading} -setup {
set fd [openpipe r cat longfile]
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
chan flush $fd
} -returnCodes error -cleanup {
catch {chan close $fd}
@@ -2538,7 +2543,7 @@ test chan-io-29.20 {Implicit flush when buffer is full} -setup {
} -result {4096 12288 12600}
test chan-io-29.21 {Tcl_Flush to pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {set x [chan read stdin 6]}
chan puts $f1 {set cnt [string length $x]}
@@ -2553,7 +2558,7 @@ test chan-io-29.21 {Tcl_Flush to pipe} -setup {
} -result "read 6 characters"
test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan configure stdout -buffering full
@@ -2577,7 +2582,7 @@ test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup {
} -result {hello hello bye}
test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts hello
@@ -2614,7 +2619,7 @@ test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} -setup {
} -result "{} {Line 1\nLine 2}"
test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
file delete $path(test3)
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe w $path(cat) | [interpreter] $path(cat) > $path(test3)]
chan puts $f "Line 1"
chan puts $f "Line 2"
@@ -2625,7 +2630,7 @@ test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup {
} -cleanup {
chan close $f
} -result "Line 1\nLine 2\n"
-test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs openpipe} -body {
+test chan-io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} -constraints {stdio unixExecs} -body {
set f [open "|[list cat -u]" r+]
chan puts $f "Line1"
chan flush $f
@@ -2638,7 +2643,7 @@ test chan-io-29.27 {Tcl_Flush on chan closed pipeline} -setup {
set f [open $path(pipe) w]
chan puts $f {exit}
chan close $f
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [openpipe r+ $path(pipe)]
chan gets $f
chan puts $f output
@@ -2691,7 +2696,7 @@ test chan-io-29.30 {Tcl_WriteChars, crlf mode} -setup {
test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {chan configure $f -translation lf}
@@ -2724,7 +2729,7 @@ test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
set result ok
}
# allow a little time for the background process to chan 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
return $result
@@ -2732,7 +2737,7 @@ test chan-io-29.31 {Tcl_WriteChars, background flush} -setup {
test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} -setup {
file delete $path(pipe)
file delete $path(output)
-} -constraints {stdio asyncPipeChan Close openpipe} -body {
+} -constraints {stdio asyncPipeChan Close} -body {
set f [open $path(pipe) w]
chan puts $f "set f \[[list open $path(output) w]]"
chan puts $f {chan configure $f -translation lf}
@@ -4005,7 +4010,7 @@ test chan-io-32.9 {Tcl_Read, read to end of file} {
} ok
test chan-io-32.10 {Tcl_Read from a pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan close $f1
@@ -4019,7 +4024,7 @@ test chan-io-32.10 {Tcl_Read from a pipe} -setup {
test chan-io-32.11 {Tcl_Read from a pipe} -setup {
file delete $path(pipe)
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan puts $f1 {chan puts [chan gets stdin]}
@@ -4131,7 +4136,7 @@ test chan-io-33.2 {Tcl_Gets into variable} {
} ok
test chan-io-33.3 {Tcl_Gets from pipe} -setup {
file delete $path(pipe)
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {chan puts [chan gets stdin]}
chan close $f1
@@ -4341,7 +4346,7 @@ test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position
} -result {44 rstuv 49}
test chan-io-34.8 {Tcl_Seek on pipes: not supported} -setup {
set pipe [openpipe]
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
chan seek $pipe 0 current
} -returnCodes error -cleanup {
chan close $pipe
@@ -4451,13 +4456,13 @@ test chan-io-34.15 {Tcl_Tell combined with seeking} -setup {
} -cleanup {
chan close $f1
} -result {10 20}
-test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints {stdio openpipe} -body {
+test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints stdio -body {
set f1 [openpipe]
chan tell $f1
} -cleanup {
chan close $f1
} -result -1
-test chan-io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
+test chan-io-34.17 {Tcl_Tell on pipe: always -1} stdio {
set f1 [openpipe]
chan puts $f1 {chan puts hello}
chan flush $f1
@@ -4559,7 +4564,7 @@ test chan-io-35.1 {Tcl_Eof} -setup {
} -cleanup {
chan close $f
} -result {0 0 0 0 1 1}
-test chan-io-35.2 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
+test chan-io-35.2 {Tcl_Eof with pipe} -constraints stdio -setup {
file delete $path(pipe)
} -body {
set f1 [open $path(pipe) w]
@@ -4578,7 +4583,7 @@ test chan-io-35.2 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
} -cleanup {
chan close $f1
} -result {0 0 0 1}
-test chan-io-35.3 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup {
+test chan-io-35.3 {Tcl_Eof with pipe} -constraints stdio -setup {
file delete $path(pipe)
} -body {
set f1 [open $path(pipe) w]
@@ -4616,7 +4621,7 @@ test chan-io-35.4 {Tcl_Eof, eof detection on nonblocking file} -setup {
test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} -setup {
file delete $path(pipe)
set l ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f [open $path(pipe) w]
chan puts $f {
exit
@@ -4801,7 +4806,7 @@ test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup {
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [openpipe]
chan puts $f1 {chan puts hello_from_pipe}
chan flush $f1
@@ -4821,7 +4826,7 @@ test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup {
} -result {{} 1 hello 0 {} 1}
test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} -setup {
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [openpipe]
chan configure $f1 -buffering line
chan puts $f1 {chan puts hello_from_pipe}
@@ -5095,7 +5100,7 @@ test chan-io-39.9 {Tcl_SetChannelOption, blocking mode} -setup {
test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} -setup {
file delete $path(pipe)
set x ""
-} -constraints {stdio openpipe} -body {
+} -constraints stdio -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan gets stdin
@@ -5192,7 +5197,7 @@ test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup {
} -result {unknown encoding "foobar"}
test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup {
variable x {}
-} -constraints {stdio openpipe fileevent} -body {
+} -constraints {stdio fileevent} -body {
set f [openpipe r+ $path(cat)]
chan configure $f -encoding binary
chan puts -nonewline $f "\xe7"
@@ -5552,7 +5557,7 @@ test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
set f2 [open "|[list cat -u]" r+]
set f3 [open "|[list cat -u]" r+]
set result {}
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
lappend result [chan event $f r] [chan event $f2 r] [chan event $f3 r]
chan event $f r "chan read f"
chan event $f2 r "chan read f2"
@@ -5572,7 +5577,7 @@ test chan-io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
test chan-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 {
chan event $f2 readable [namespace code {
set x [chan gets $f2]; chan event $f2 readable {}
}]
@@ -5592,7 +5597,7 @@ test chan-io-44.2 {FileEventProc procedure: error in read event} -setup {
}
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 readable {error bogus}
chan puts $f2 text; chan flush $f2
variable x initial
@@ -5606,7 +5611,7 @@ test chan-io-44.2 {FileEventProc procedure: error in read event} -setup {
test chan-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 {
chan event $f2 writable [namespace code {
lappend x "triggered"
incr count -1
@@ -5632,7 +5637,7 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
}
set handler [interp bgerror {}]
interp bgerror {} [namespace which myHandler]
-} -constraints {stdio unixExecs fileevent openpipe} -body {
+} -constraints {stdio unixExecs fileevent} -body {
chan event $f2 writable {error bad-write}
variable x initial
vwait [namespace which -variable x]
@@ -5642,7 +5647,9 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup {
catch {chan close $f2}
catch {chan close $f3}
} -result {bad-write {}}
-test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
+test chan-io-44.5 {FileEventProc procedure: end of file} -constraints {
+ stdio unixExecs fileevent
+} -body {
set f4 [openpipe r $path(cat) << foo]
chan event $f4 readable [namespace code {
if {[chan gets $f4 line] < 0} {
@@ -5655,9 +5662,10 @@ test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpi
variable x initial
vwait [namespace which -variable x]
vwait [namespace which -variable x]
- chan close $f4
set x
-} {initial foo eof}
+} -cleanup {
+ chan close $f4
+} -result {initial foo eof}
chan close $f
makeFile "foo bar" foo
@@ -5718,7 +5726,7 @@ test chan-io-45.3 {DeleteFileEvent, cleanup on chan close} {fileevent} {
# Execute these tests only if the "testfevent" command is present.
-test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
+test chan-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 {
@@ -5728,9 +5736,10 @@ test chan-io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileeven
chan event $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 {chan close $f}
list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
} {{f triggered: foo bar} after}
@@ -5918,7 +5927,7 @@ test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
set path(my_script) [makeFile {} my_script]
test chan-io-48.3 {testing readability conditions} -setup {
set l ""
-} -constraints {stdio unix nonBlockFiles openpipe fileevent} -body {
+} -constraints {stdio unix nonBlockFiles fileevent} -body {
set f [open $path(bar) w]
chan puts $f abcdefg
chan puts $f abcdefg
@@ -6372,17 +6381,21 @@ test chan-io-49.5 {testing crlf reading, leftover cr disgorgment} -setup {
test chan-io-50.1 {testing handler deletion} -setup {
file delete $path(test1)
-} -constraints {testchannelevent} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) w]
chan close $f
set f [open $path(test1) r]
+ variable z not_called
+ set timer [after 50 lappend z timeout]
+ testservicemode 0
testchannelevent $f add readable [namespace code {
variable z called
testchannelevent $f delete 0
}]
- variable z not_called
- update
- return $z
+ testservicemode 1
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
chan close $f
} -result called
@@ -6390,16 +6403,21 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
set z ""
-} -constraints {testchannelevent} -body {
- 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]]
+} -constraints {testchannelevent testservicemode} -body {
proc delhandler {f i} {
variable z
lappend z "called delhandler $f $i"
testchannelevent $f delete 0
}
- update
+ set z ""
+ set timer [after 50 lappend z timeout]
+ 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
+ vwait z
+ after cancel $timer
string equal $z \
[list [list called delhandler $f 0] [list called delhandler $f 1]]
} -cleanup {
@@ -6408,11 +6426,7 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup {
test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
file delete $path(test1)
chan close [open $path(test1) w]
- set z ""
-} -constraints {testchannelevent} -body {
- 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]]
+} -constraints {testchannelevent testservicemode} -body {
proc notcalled {f i} {
variable z
lappend z "notcalled was called!! $f $i"
@@ -6424,7 +6438,15 @@ test chan-io-50.3 {testing handler deletion with multiple handlers} -setup {
testchannelevent $f delete 0
lappend z "delhandler $f $i deleted myself"
}
- update
+ set z ""
+ set timer [after 50 lappend z timeout]
+ 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
+ vwait z
+ after cancel $timer
string equal $z \
[list [list delhandler $f 0 called] \
[list delhandler $f 0 deleted myself]]
@@ -6435,7 +6457,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent} -body {
+} -constraints testchannelevent -body {
set f [open $path(test1) r]
testchannelevent $f add readable [namespace code {
if {$u eq "recursive"} {
@@ -6449,19 +6471,20 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup {
}]
variable u toplevel
variable z ""
- update
- return $z
+ set timer [after 50 lappend z timeout]
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
chan close $f
+ update
} -result {{delrecursive calling recursive} {delrecursive deleting recursive}}
test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent} -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list notcalled $f]]
- testchannelevent $f add readable [namespace code [list del $f]]
+ update
+} -constraints {testchannelevent testservicemode notOSX} -body {
proc notcalled {f} {
variable z
lappend z "notcalled was called!! $f"
@@ -6477,33 +6500,46 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup {
} else {
set u recursive
lappend z "del calling recursive"
- update
+ set timer [after 50 lappend z timeout]
+ set mode [test servicemode 1]
+ vwait z
+ after cancel $timer
+ test servicemode $mode
lappend z "del after update"
}
}
set z ""
set u toplevel
- update
- return $z
+ set timer [after 50 lappend z timeout]
+ 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
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
chan close $f
+ update
} -result [list {del calling recursive} {del deleted notcalled} \
{del deleted myself} {del after update}]
test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
file delete $path(test1)
set f [open $path(test1) w]
chan close $f
-} -constraints {testchannelevent} -body {
- set f [open $path(test1) r]
- testchannelevent $f add readable [namespace code [list second $f]]
- testchannelevent $f add readable [namespace code [list first $f]]
+} -constraints {testchannelevent testservicemode} -body {
proc first {f} {
variable u
variable z
if {$u eq "toplevel"} {
lappend z "first called"
+ set mode [testservicemode 1]
+ set timer [after 50 lappend z timeout]
set u first
- update
+ vwait z
+ after cancel $timer
+ testservicemode $mode
lappend z "first after update"
} else {
lappend z "first called not toplevel"
@@ -6526,8 +6562,15 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup {
}
set z ""
set u toplevel
- update
- return $z
+ set timer [after 50 lappend z timeout]
+ 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
+ vwait z
+ after cancel $timer
+ set z
} -cleanup {
chan close $f
} -result [list {first called} {first called not toplevel} \
@@ -6709,7 +6752,7 @@ test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
test chan-io-52.8 {TclCopyChannel} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set f1 [open $path(pipe) w]
chan configure $f1 -translation lf
chan puts $f1 "
@@ -6830,7 +6873,7 @@ test chan-io-53.2 {CopyData} -setup {
test chan-io-53.3 {CopyData: background read underflow} -setup {
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio unix openpipe fcopy} -body {
+} -constraints {stdio unix fcopy} -body {
set f1 [open $path(pipe) w]
chan puts -nonewline $f1 {
chan puts ready
@@ -6868,7 +6911,7 @@ test chan-io-53.4 {CopyData: background write overflow} -setup {
}
file delete $path(test1)
file delete $path(pipe)
-} -constraints {stdio unix openpipe fileevent fcopy} -body {
+} -constraints {stdio unix fileevent fcopy} -body {
set f1 [open $path(pipe) w]
chan puts $f1 {
chan puts ready
@@ -6932,7 +6975,7 @@ test chan-io-53.6 {CopyData: error during chan copy} -setup {
file delete $path(pipe)
file delete $path(test1)
catch {unset fcopyTestDone}
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set f1 [open $path(pipe) w]
chan puts $f1 "exit 1"
chan close $f1
@@ -6966,7 +7009,7 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup {
variable fcopyTestDone
file delete $path(pipe)
catch {unset fcopyTestDone}
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
set fcopyTestCount 0
set f1 [open $path(pipe) w]
chan puts $f1 {
@@ -7016,7 +7059,7 @@ test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -se
# 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.
@@ -7056,7 +7099,7 @@ test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at
# Channels to copy between
set f [open $foo r] ; chan configure $f -translation binary
set g [open $bar w] ; chan configure $g -translation binary -buffering none
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Initialize and force eof on the input.
chan seek $f 0 end ; chan read $f 1
set ::RES [chan eof $f]
@@ -7114,7 +7157,7 @@ test chan-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 {
chan copy $pipe $out -size 6 -command ::done
set token [after 5000 {
set ::forever {fcopy hangs}
@@ -7187,7 +7230,7 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup {
chan configure $b -translation binary -buffering none
chan event $a readable [namespace code "done $a"]
chan event $b readable [namespace code "done $b"]
-} -constraints {stdio openpipe fcopy} -body {
+} -constraints {stdio fcopy} -body {
# Now pass data through the server in both directions.
set ::forever {}
chan puts $a AB
@@ -7409,7 +7452,7 @@ test chan-io-57.2 {buffered data and file events, read} -setup {
chan close $server
} -result {1 readable 234567890 timer}
-test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin openpipe fileevent} {
+test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} {
set out [open $path(script) w]
chan puts $out {
chan puts "normal message from pipe"
@@ -7447,7 +7490,7 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
string equal $result [testmainthread]
} {1}
-test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent testbytestring} {
+test chan-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]
chan puts $out "catch {load $::tcltestlib Tcltest}"
generated by cgit v0.12 at 2024-10-22 07:24:51 (GMT)