Import Tcl 8.6.11
This commit is contained in:
Steve Dower
@@ -13,9 +13,8 @@
|
||||
# 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 eval ::tcl::test::io {
|
||||
@@ -39,11 +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 knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]
|
||||
testConstraint testservicemode [llength [info commands testservicemode]]
|
||||
testConstraint notWinCI [expr {
|
||||
$::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
|
||||
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 +449,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 +710,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 +850,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 +868,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 +886,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 +904,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 +1022,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 +1089,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 +1123,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 +1140,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 +1169,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 +1180,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 +1193,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 +1344,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 +1366,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 +1459,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 +1477,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 +1578,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 +1675,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 +1698,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 +1882,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 notWinCI} -body {
|
||||
set f [open $path(script) w]
|
||||
chan puts -nonewline $f {
|
||||
chan close stdout
|
||||
@@ -1966,7 +1967,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 +2042,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 +2112,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 +2166,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 +2383,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 +2410,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 +2463,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 +2539,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 +2554,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 +2578,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 +2615,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 +2626,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 +2639,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 +2692,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 +2725,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 +2733,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}
|
||||
@@ -2791,7 +2792,7 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} -s
|
||||
chan puts $s $l
|
||||
}
|
||||
}
|
||||
} -constraints {socket tempNotMac fileevent knownMsvcBug} -body {
|
||||
} -constraints {socket tempNotMac fileevent notWinCI} -body {
|
||||
proc accept {s a p} {
|
||||
variable x
|
||||
chan event $s readable [namespace code [list readit $s]]
|
||||
@@ -3045,7 +3046,7 @@ test chan-io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} -setup {
|
||||
string length [chan read $f]
|
||||
} -cleanup {
|
||||
chan close $f
|
||||
} -result [expr 700*15+1]
|
||||
} -result [expr {700*15 + 1}]
|
||||
test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
|
||||
file delete $path(test1)
|
||||
} -body {
|
||||
@@ -3062,7 +3063,7 @@ test chan-io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} -setup {
|
||||
string length [chan read $f]
|
||||
} -cleanup {
|
||||
chan close $f
|
||||
} -result [expr 700*15+1]
|
||||
} -result [expr {700*15 + 1}]
|
||||
test chan-io-30.15 {Tcl_Write mixed, Tcl_Read auto} -setup {
|
||||
file delete $path(test1)
|
||||
} -body {
|
||||
@@ -3904,7 +3905,7 @@ test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} -setup {
|
||||
}
|
||||
chan close $f
|
||||
string length $c
|
||||
} -result [expr 700*15+1]
|
||||
} -result [expr {700*15 + 1}]
|
||||
test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
|
||||
file delete $path(test1)
|
||||
set c ""
|
||||
@@ -3924,7 +3925,7 @@ test chan-io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} -setup {
|
||||
}
|
||||
chan close $f
|
||||
string length $c
|
||||
} -result [expr 700*15+1]
|
||||
} -result [expr {700*15 + 1}]
|
||||
|
||||
# Test Tcl_Read and buffering.
|
||||
|
||||
@@ -4005,7 +4006,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 +4020,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 +4132,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 +4342,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 +4452,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 +4560,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 +4579,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 +4617,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 +4802,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 +4822,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 +5096,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 +5193,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"
|
||||
@@ -5333,24 +5334,24 @@ test chan-io-40.1 {POSIX open access modes: RDWR} -setup {
|
||||
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
|
||||
file delete $path(test3)
|
||||
} -constraints {unix} -body {
|
||||
set f [open $path(test3) {WRONLY CREAT} 0600]
|
||||
set f [open $path(test3) {WRONLY CREAT} 0o600]
|
||||
file stat $path(test3) stats
|
||||
set x [format "%#o" [expr $stats(mode)&0o777]]
|
||||
set x [format 0o%03o [expr {$stats(mode) & 0o777}]]
|
||||
chan puts $f "line 1"
|
||||
chan close $f
|
||||
set f [open $path(test3) r]
|
||||
lappend x [chan gets $f]
|
||||
} -cleanup {
|
||||
chan close $f
|
||||
} -result {0600 {line 1}}
|
||||
} -result {0o600 {line 1}}
|
||||
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
|
||||
file delete $path(test3)
|
||||
} -constraints {unix umask} -body {
|
||||
# This test only works if your umask is 2, like ouster's.
|
||||
chan close [open $path(test3) {WRONLY CREAT}]
|
||||
file stat $path(test3) stats
|
||||
format "%#o" [expr $stats(mode)&0o777]
|
||||
} -result [format %#4o [expr {0o666 & ~ $umaskValue}]]
|
||||
format "0o%03o" [expr {$stats(mode) & 0o777}]
|
||||
} -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]]
|
||||
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
|
||||
file delete $path(test3)
|
||||
} -body {
|
||||
@@ -5552,7 +5553,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 +5573,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 +5593,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 +5607,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 +5633,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 +5643,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 +5658,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 +5722,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 +5732,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 +5923,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 +6377,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 +6399,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 +6422,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 +6434,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 +6453,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 +6467,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 +6496,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 [testservicemode 1]
|
||||
vwait z
|
||||
after cancel $timer
|
||||
testservicemode $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 +6558,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} \
|
||||
@@ -6678,7 +6717,7 @@ test chan-io-52.6 {TclCopyChannel} -setup {
|
||||
set f2 [open $path(test1) w]
|
||||
chan configure $f1 -translation lf -blocking 0
|
||||
chan configure $f2 -translation lf -blocking 0
|
||||
set s0 [chan copy $f1 $f2 -size [expr [file size $thisScript] + 5]]
|
||||
set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
|
||||
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
|
||||
chan close $f1
|
||||
chan close $f2
|
||||
@@ -6709,7 +6748,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 +6869,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 +6907,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
|
||||
@@ -6920,7 +6959,7 @@ test chan-io-53.5 {CopyData: error during chan copy} {socket fcopy} {
|
||||
chan close $listen ;# This means the socket open never really succeeds
|
||||
chan copy $in $out -command [namespace code FcopyTestDone]
|
||||
variable fcopyTestDone
|
||||
if ![info exists fcopyTestDone] {
|
||||
if {![info exists fcopyTestDone]} {
|
||||
vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
|
||||
}
|
||||
chan close $in
|
||||
@@ -6932,7 +6971,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
|
||||
@@ -6940,7 +6979,7 @@ test chan-io-53.6 {CopyData: error during chan copy} -setup {
|
||||
set out [open $path(test1) w]
|
||||
chan copy $in $out -command [namespace code FcopyTestDone]
|
||||
variable fcopyTestDone
|
||||
if ![info exists fcopyTestDone] {
|
||||
if {![info exists fcopyTestDone]} {
|
||||
vwait [namespace which -variable fcopyTestDone]
|
||||
}
|
||||
return $fcopyTestDone ;# 0 for plain end of file
|
||||
@@ -6966,7 +7005,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 {
|
||||
@@ -6993,7 +7032,7 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup {
|
||||
vwait [namespace which -variable fcopyTestDone]
|
||||
}
|
||||
# -1=error 0=script error N=number of bytes
|
||||
expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
|
||||
expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1}
|
||||
} -cleanup {
|
||||
catch {chan close $in}
|
||||
chan close $out
|
||||
@@ -7016,7 +7055,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 +7095,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 +7153,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 +7226,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 +7448,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 +7486,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}"
|
||||
|
||||
Reference in New Issue
Block a user