diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2010-11-24 11:56:56 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2010-11-24 11:56:56 (GMT) |
commit | 9fac83aef554818514b08c278f77c9e979384c2b (patch) | |
tree | 4257bda96aa4d8a7a579d3d160813632c1fd1d65 /tests/chanio.test | |
parent | d16303062416f96eaea30320cc3caafcff34aa86 (diff) | |
download | tcl-9fac83aef554818514b08c278f77c9e979384c2b.zip tcl-9fac83aef554818514b08c278f77c9e979384c2b.tar.gz tcl-9fac83aef554818514b08c278f77c9e979384c2b.tar.bz2 |
* tests/chanio.test, tests/iogt.test, tests/ioTrans.test: Convert more
tests to tcltest2 and factor them to be easier to understand.
Diffstat (limited to 'tests/chanio.test')
-rw-r--r-- | tests/chanio.test | 523 |
1 files changed, 223 insertions, 300 deletions
diff --git a/tests/chanio.test b/tests/chanio.test index f15bad6..b1c4e8a 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -13,7 +13,7 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: chanio.test,v 1.25 2010/11/21 12:12:36 dkf Exp $ +# RCS: @(#) $Id: chanio.test,v 1.26 2010/11/24 11:56:57 dkf Exp $ if {[catch {package require tcltest 2}]} { chan puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -41,12 +41,12 @@ namespace eval ::tcl::test::io { testConstraint testmainthread [llength [info commands testmainthread]] testConstraint testthread [llength [info commands testthread]] - # You need a *very* special environment to do some tests. In - # particular, many file systems do not support large-files... + # You need a *very* special environment to do some tests. In particular, + # many file systems do not support large-files... testConstraint largefileSupport 0 - # some tests can only be run is umask is 2 - # if "umask" cannot be run, the tests will be skipped. + # some tests can only be run is umask is 2 if "umask" cannot be run, the + # tests will be skipped. set umaskValue 0 testConstraint umask [expr {![catch {set umaskValue [scan [exec /bin/sh -c umask] %o]}]}] @@ -92,6 +92,11 @@ namespace eval ::tcl::test::io { chan close $f return $a } + + # Wrapper round butt-ugly pipe syntax + proc openpipe {{mode r+} args} { + open "|[list [interpreter] {*}$args]" $mode + } test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} { # no test, need to cause an async error. @@ -184,9 +189,9 @@ test chan-io-2.2 {WriteBytes: savedLF > 0} { lappend x [contents $path(test1)] } [list "123456789012345\r" "123456789012345\r\n12"] test chan-io-2.3 {WriteBytes: flush on line} -body { - # Tcl "line" buffering has weird behavior: if current buffer contains - # a \n, entire buffer gets flushed. Logical behavior would be to flush - # only up to the \n. + # Tcl "line" buffering has weird behavior: if current buffer contains a + # \n, entire buffer gets flushed. Logical behavior would be to flush only + # up to the \n. set f [open $path(test1) w] chan configure $f -encoding binary -buffering line -translation crlf chan puts -nonewline $f "\n12" @@ -223,9 +228,9 @@ test chan-io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} { lappend x [contents $path(test1)] } [list "123456789012345\r" "123456789012345\r\n12"] test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -body { - # Tcl "line" buffering has weird behavior: if current buffer contains - # a \n, entire buffer gets flushed. Logical behavior would be to flush - # only up to the \n. + # Tcl "line" buffering has weird behavior: if current buffer contains a + # \n, entire buffer gets flushed. Logical behavior would be to flush only + # up to the \n. set f [open $path(test1) w] chan configure $f -encoding ascii -buffering line -translation crlf chan puts -nonewline $f "\n12" @@ -441,7 +446,7 @@ test chan-io-6.6 {Tcl_GetsObj: loop test} -body { } -result [list 256 $a] test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints {stdio openpipe} -body { # if (FilterInputBytes(chanPtr, &gs) != 0) - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan puts -nonewline $f "hi\nwould" chan flush $f chan gets $f @@ -702,7 +707,7 @@ test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} -setup { set x "" } -constraints {stdio testchannel openpipe fileevent} -body { # (FilterInputBytes() != 0) - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation {crlf lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r" chan configure $f -buffersize 16 @@ -842,7 +847,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup { set x "" } -constraints {stdio testchannel openpipe fileevent} -body { # if (chanPtr->flags & INPUT_SAW_CR) - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation {auto lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" chan configure $f -buffersize 16 @@ -860,7 +865,7 @@ test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup { set x "" } -constraints {stdio testchannel openpipe fileevent} -body { # not (*eol == '\n') - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation {auto lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" chan configure $f -buffersize 16 @@ -878,7 +883,7 @@ test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} -setup set x "" } -constraints {stdio testchannel openpipe fileevent} -body { # Tcl_ExternalToUtf() - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation {auto lf} -buffering none chan configure $f -encoding unicode chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" @@ -896,7 +901,7 @@ test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eo set x "" } -constraints {stdio testchannel openpipe fileevent} -body { # memmove() - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation {auto lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" chan configure $f -buffersize 16 @@ -1013,7 +1018,7 @@ test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -se update variable x {} } -constraints {stdio openpipe fileevent} -body { - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -buffering none chan puts -nonewline $f "foobar" chan configure $f -blocking 0 @@ -1080,7 +1085,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup { test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup { variable x "" } -constraints {stdio openpipe fileevent} -body { - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -encoding binary -buffering none chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" chan configure $f -encoding shiftjis -blocking 0 @@ -1115,7 +1120,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 { # not (bufPtr->nextPtr == NULL) - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation lf -encoding ascii -buffering none chan puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz" chan event $f read [namespace code { @@ -1132,7 +1137,7 @@ test chan-io-8.2 {PeekAhead: only go to device if no more cached data} -setup { } -result {-1 {} 42 15 123456789012345 25} test chan-io-8.3 {PeekAhead: no cached data available} -constraints {stdio testchannel openpipe fileevent} -body { # (bytesLeft == 0) - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation {auto binary} chan puts -nonewline $f "abcdefghijklmno\r" chan flush $f @@ -1161,7 +1166,7 @@ test chan-io-8.4 {PeekAhead: cached data available in this buffer} -body { unset a test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {stdio testchannel openpipe fileevent} -body { # (bufPtr->nextAdded < bufPtr->length) - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation {auto binary} chan puts -nonewline $f "abcdefghijklmno\r" chan flush $f @@ -1172,7 +1177,7 @@ test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {st } -result {15 abcdefghijklmno 1} test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body { # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation {auto binary} -buffersize 16 chan puts -nonewline $f "abcdefghijklmno\r" chan flush $f @@ -1185,7 +1190,7 @@ test chan-io-8.7 {PeekAhead: cleanup} -setup { set x "" } -constraints {stdio testchannel openpipe fileevent} -body { # Make sure bytes are removed from buffer. - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -translation {auto binary} -buffering none chan puts -nonewline $f "abcdefghijklmno\r" # here @@ -1336,7 +1341,7 @@ test chan-io-12.4 {ReadChars: split-up char} -setup { variable x {} } -constraints {stdio testchannel openpipe fileevent} -body { # (srcRead == 0) - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -encoding binary -buffering none -buffersize 16 chan puts -nonewline $f "123456789012345\x96" chan configure $f -encoding shiftjis -blocking 0 @@ -1363,7 +1368,7 @@ test chan-io-12.5 {ReadChars: chan events on partial characters} -setup { chan gets stdin; chan puts -nonewline "\x89" chan gets stdin; chan puts -nonewline "\xa6" } test1] - set f [open "|[list [interpreter] $path(test1)]" r+] + set f [openpipe r+ $path(test1)] chan event $f readable [namespace code { lappend x [chan read $f] if {[chan eof $f]} { @@ -1452,7 +1457,7 @@ test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} -setup } -constraints {stdio testchannel openpipe fileevent} -body { # (chanPtr->flags & INPUT_SAW_CR) # This test may fail on slower machines. - set f [open "|[list [interpreter] $path(cat)]" w+] + set f [openpipe w+ $path(cat)] chan configure $f -blocking 0 -buffering none -translation {auto lf} chan event $f read [namespace code { lappend x [chan read $f] [testchannel queuedcr $f] @@ -1607,7 +1612,8 @@ test chan-io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} -constraints {exec} -b chan puts $f [list open $path(test1) r]] chan puts $f "set f2 \[[list open $path(test2) w]]" chan puts $f "set f3 \[[list open $path(test3) w]]" - chan puts $f { chan puts stdout [chan gets stdin] + chan puts $f { + chan puts stdout [chan gets stdin] chan puts stdout $f2 chan puts stderr $f3 chan close $f @@ -1679,7 +1685,7 @@ test chan-io-14.8 {reuse of stdio special channels} -setup { chan puts [chan gets $f] } chan close $f - set f [open "|[list [interpreter] $path(script)]" r] + set f [openpipe r $path(script)] chan gets $f } -cleanup { chan close $f @@ -1699,7 +1705,7 @@ test chan-io-14.9 {reuse of stdio special channels} -setup { chan puts [chan gets $f] } chan close $f - set f [open "|[list [interpreter] $path(script) [array get path]]" r] + set f [openpipe r $path(script) [array get path]] chan gets $f } -cleanup { chan close $f @@ -1773,8 +1779,7 @@ test chan-io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup { } else { lappend l "very broken: $f found after being chan closed" } - string equal [string tolower $l] \ - [list 1 "can not find channel named \"$f\""] + string equal $l [list 1 "can not find channel named \"$f\""] } -result 1 test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup { file delete -force $path(test1) @@ -1795,8 +1800,7 @@ test chan-io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup { } else { lappend l "very broken: $f found after being chan closed" } - string equal [string tolower $l] \ - [list 1 2 1 1 "can not find channel named \"$f\""] + string equal $l [list 1 2 1 1 "can not find channel named \"$f\""] } -result 1 test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup { file delete $path(test1) @@ -1815,8 +1819,7 @@ test chan-io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} -setup { } else { lappend l "very broken: $f found after being chan closed" } - string equal [string tolower $l] \ - [list 1 2 1 "can not find channel named \"$f\""] + string equal $l [list 1 2 1 "can not find channel named \"$f\""] } -result 1 test chan-io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} { @@ -1845,8 +1848,7 @@ test chan-io-19.4 {Tcl_CreateChannel, insertion into channel table} -setup { } else { lappend l "very broken: $f found after being chan closed" } - string equal [string tolower $l] \ - [list 0 "can not find channel named \"$f\""] + string equal $l [list 0 "can not find channel named \"$f\""] } -result 1 test chan-io-20.1 {Tcl_CreateChannel: initial settings} -setup { @@ -1886,7 +1888,7 @@ test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} -setup { chan puts stderr [chan configure stdout -buffersize] } chan close $f - set f [open "|[list [interpreter] $path(script)]"] + set f [openpipe r $path(script)] chan close $f } -cleanup { removeFile $path(stdout) @@ -1958,7 +1960,7 @@ test chan-io-25.2 {Tcl_GetChannelHandle, output} -setup { test chan-io-26.1 {Tcl_GetChannelInstanceData} -body { # "pid" command uses Tcl_GetChannelInstanceData # Don't care what pid is (but must be a number), just want to exercise it. - set f [open "|[list [interpreter] << exit]"] + set f [openpipe r << exit] pid $f } -constraints {stdio openpipe} -cleanup { chan close $f @@ -2053,7 +2055,7 @@ test chan-io-27.6 {FlushChannel, async flushing, async chan close} -setup { } set f [open $path(output) w] chan close $f - set f [open "|[list [interpreter] $path(pipe)]" w] + set f [openpipe w $path(pipe)] chan configure $f -blocking off chan puts -nonewline $f $x chan close $f @@ -2128,7 +2130,7 @@ test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} - } set f [open $path(output) w] chan close $f - set f [open "|[list [interpreter] pipe]" r+] + set f [openpipe r+ $path(pipe)] chan configure $f -blocking off -eofchar {} chan puts -nonewline $f $x chan close $f @@ -2166,7 +2168,7 @@ test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup { chan puts [testchannel open] } chan close $f - set f [open "|[list [interpreter] $path(script)]" r] + set f [openpipe r $path(script)] set l [chan gets $f] chan close $f lsort $l @@ -2174,27 +2176,28 @@ test chan-io-28.5 {Tcl_Chan Close vs standard handles} -setup { test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} -setup { set cat [makeFile { fconfigure stdout -buffering line - while {[gets stdin line]>=0} {puts $line} + while {[gets stdin line] >= 0} {puts $line} puts DONE exit 0 } cat.tcl] + variable done } -body { - set ::ff [open "|[list [interpreter] $cat]" r+] - puts $::ff Hey - close $::ff w - set timer [after 1000 {set ::done Failed}] - set ::acc {} - fileevent $::ff readable { - if {[gets $::ff line]<0} { - set ::done Succeeded + set ff [openpipe r+ $cat] + puts $ff Hey + close $ff w + set timer [after 1000 [namespace code {set done Failed}]] + set acc {} + fileevent $ff readable [namespace code { + if {[gets $ff line] < 0} { + set done Succeeded } else { - lappend ::acc $line + lappend acc $line } - } - vwait ::done + }] + vwait [namespace which -variable done] after cancel $timer - close $::ff r - list $::done $::acc + close $ff r + list $done $acc } -cleanup { removeFile cat.tcl } -result {Succeeded {Hey DONE}} @@ -2205,31 +2208,31 @@ test chan-io-28.7 {Tcl_CloseEx (half-close) socket} -setup { puts [lindex [fconfigure $s -sockname] 2] flush stdout vwait ::sok - fconfigure $::sok -buffering line - while {[gets $::sok line]>=0} {puts $::sok $line} - puts $::sok DONE + fconfigure $sok -buffering line + while {[gets $sok line]>=0} {puts $sok $line} + puts $sok DONE exit 0 } echo.tcl] } -body { - set ::ff [open "|[list [interpreter] $echo]" r] - gets $::ff port - set ::s [socket 127.0.0.1 $port] - puts $::s Hey - close $::s w - set timer [after 1000 {set ::done Failed}] - set ::acc {} - fileevent $::s readable { - if {[gets $::s line]<0} { - set ::done Succeeded + set ff [openpipe r $echo] + gets $ff port + set s [socket 127.0.0.1 $port] + puts $s Hey + close $s w + set timer [after 1000 [namespace code {set ::done Failed}]] + set acc {} + fileevent $s readable [namespace code { + if {[gets $s line]<0} { + set done Succeeded } else { - lappend ::acc $line + lappend acc $line } - } - vwait ::done + }] + vwait [namespace which -variable done] after cancel $timer - close $::s r - close $::ff - list $::done $::acc + close $s r + close $ff + list $done $acc } -cleanup { removeFile echo.tcl } -result {Succeeded {Hey DONE}} @@ -2380,13 +2383,13 @@ test chan-io-29.12 {Tcl_WriteChars on a pipe} -setup { } } chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r] + set f1 [openpipe r $path(pipe)] set f2 [open $path(longfile) r] set y ok for {set x 0} {$x < 10} {incr x} { set l1 [chan gets $f1] set l2 [chan gets $f2] - if {"$l1" ne "$l2"} { + if {$l1 ne $l2} { set y broken:$x } } @@ -2406,20 +2409,20 @@ test chan-io-29.13 {Tcl_WriteChars to a pipe, line buffered} -setup { } chan close $f1 set y ok - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] chan configure $f1 -buffering line set f2 [open $path(longfile) r] set line [chan gets $f2] chan puts $f1 $line set backline [chan gets $f1] - if {"$line" ne "$backline"} { - set y broken + if {$line ne $backline} { + set y broken1 } set line [chan gets $f2] chan puts $f1 $line set backline [chan gets $f1] - if {"$line" ne "$backline"} { - set y broken + if {$line ne $backline} { + set y broken2 } return $y } -cleanup { @@ -2450,7 +2453,7 @@ test chan-io-29.15 {Tcl_Flush, channel not open for writing} -setup { catch {chan close $fd} } -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 [open "|[list [interpreter] cat longfile]" r] + set fd [openpipe r cat longfile] } -constraints {stdio openpipe} -body { chan flush $fd } -returnCodes error -cleanup { @@ -2533,7 +2536,7 @@ test chan-io-29.21 {Tcl_Flush to pipe} -setup { chan puts $f1 {set cnt [string length $x]} chan puts $f1 {chan puts "read $cnt characters"} chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello chan flush $f1 chan gets $f1 @@ -2554,7 +2557,7 @@ test chan-io-29.22 {Tcl_Flush called at other end of pipe} -setup { chan flush stdout } chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] set x "" lappend x [chan gets $f1] lappend x [chan gets $f1] @@ -2575,7 +2578,7 @@ test chan-io-29.23 {Tcl_Flush and line buffering at end of pipe} -setup { chan puts bye } chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] set x "" lappend x [chan gets $f1] lappend x [chan gets $f1] @@ -2604,7 +2607,7 @@ test chan-io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} -setup { test chan-io-29.25 {Implicit flush with Tcl_Flush to command pipelines} -setup { file delete $path(test3) } -constraints {stdio openpipe fileevent} -body { - set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w] + set f [openpipe w $path(cat) | [interpreter] $path(cat) > $path(test3)] chan puts $f "Line 1" chan puts $f "Line 2" chan close $f @@ -2628,7 +2631,7 @@ test chan-io-29.27 {Tcl_Flush on chan closed pipeline} -setup { chan puts $f {exit} chan close $f } -constraints {stdio openpipe} -body { - set f [open "|[list [interpreter] $path(pipe)]" r+] + set f [openpipe r+ $path(pipe)] chan gets $f chan puts $f output after 50 @@ -2698,7 +2701,7 @@ test chan-io-29.31 {Tcl_WriteChars, background flush} -setup { } set f [open $path(output) w] chan close $f - set f [open "|[list [interpreter] $path(pipe)]" r+] + set f [openpipe r+ $path(pipe)] chan configure $f -blocking off chan puts -nonewline $f $x chan close $f @@ -2740,7 +2743,7 @@ test chan-io-29.32 {Tcl_WriteChars, background flush to slow reader} -setup { } set f [open $path(output) w] chan close $f - set f [open "|[list [interpreter] $path(pipe)]" r+] + set f [openpipe r+ $path(pipe)] chan configure $f -blocking off chan puts -nonewline $f $x chan close $f @@ -3998,7 +4001,7 @@ test chan-io-32.10 {Tcl_Read from a pipe} -setup { set f1 [open $path(pipe) w] chan puts $f1 {chan puts [chan gets stdin]} chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello chan flush $f1 chan read $f1 @@ -4013,7 +4016,7 @@ test chan-io-32.11 {Tcl_Read from a pipe} -setup { chan puts $f1 {chan puts [chan gets stdin]} chan puts $f1 {chan puts [chan gets stdin]} chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello chan flush $f1 lappend x [chan read $f1 6] @@ -4124,7 +4127,7 @@ test chan-io-33.3 {Tcl_Gets from pipe} -setup { set f1 [open $path(pipe) w] chan puts $f1 {chan puts [chan gets stdin]} chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello chan flush $f1 chan gets $f1 @@ -4321,7 +4324,7 @@ test chan-io-34.7 {Tcl_Seek to offset from end of file, then to current position chan close $f1 } -result {44 rstuv 49} test chan-io-34.8 {Tcl_Seek on pipes: not supported} -setup { - set pipe [open "|[list [interpreter]]" r+] + set pipe [openpipe] } -constraints {stdio openpipe} -body { chan seek $pipe 0 current } -returnCodes error -cleanup { @@ -4433,13 +4436,13 @@ test chan-io-34.15 {Tcl_Tell combined with seeking} -setup { chan close $f1 } -result {10 20} test chan-io-34.16 {Tcl_Tell on pipe: always -1} -constraints {stdio openpipe} -body { - set f1 [open "|[list [interpreter]]" r+] + 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} { - set f1 [open "|[list [interpreter]]" r+] + set f1 [openpipe] chan puts $f1 {chan puts hello} chan flush $f1 set c [chan tell $f1] @@ -4547,7 +4550,7 @@ test chan-io-35.2 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup { chan puts $f1 {chan gets stdin} chan puts $f1 {chan puts hello} chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello set x [chan eof $f1] chan flush $f1 @@ -4566,7 +4569,7 @@ test chan-io-35.3 {Tcl_Eof with pipe} -constraints {stdio openpipe} -setup { chan puts $f1 {chan gets stdin} chan puts $f1 {chan puts hello} chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] chan puts $f1 hello set x [chan eof $f1] chan flush $f1 @@ -4603,7 +4606,7 @@ test chan-io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} -setup { exit } chan close $f - set f [open "|[list [interpreter] $path(pipe)]" r] + set f [openpipe r $path(pipe)] lappend l [chan gets $f] lappend l [chan eof $f] } -cleanup { @@ -4783,7 +4786,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 { - set f1 [open "|[list [interpreter]]" r+] + set f1 [openpipe] chan puts $f1 {chan puts hello_from_pipe} chan flush $f1 chan gets $f1 @@ -4803,7 +4806,7 @@ test chan-io-36.1 {Tcl_InputBlocked on nonblocking pipe} -setup { test chan-io-36.2 {Tcl_InputBlocked on blocking pipe} -setup { set x "" } -constraints {stdio openpipe} -body { - set f1 [open "|[list [interpreter]]" r+] + set f1 [openpipe] chan configure $f1 -buffering line chan puts $f1 {chan puts hello_from_pipe} lappend x [chan gets $f1] @@ -4837,17 +4840,14 @@ test chan-io-36.4 {Tcl_InputBlocked vs files, event driven read} -setup { set l "" variable x } -constraints {fileevent} -body { - proc in {f} { - variable l - variable x - lappend l [chan read $f 3] - if {[chan eof $f]} {lappend l eof; chan close $f; set x done} - } set f [open $path(test1) w] chan puts $f abcdefghijklmnop chan close $f set f [open $path(test1) r] - chan event $f readable [namespace code [list in $f]] + chan event $f readable [namespace code { + lappend l [chan read $f 3] + if {[chan eof $f]} {lappend l eof; chan close $f; set x done} + }] vwait [namespace which -variable x] return $l } -result {abc def ghi jkl mno {p @@ -4875,18 +4875,15 @@ test chan-io-36.6 {Tcl_InputBlocked vs files, event driven read} -setup { set l "" variable x } -constraints {nonBlockFiles fileevent} -body { - proc in {f} { - variable l - variable x - lappend l [chan read $f 3] - if {[chan eof $f]} {lappend l eof; chan close $f; set x done} - } set f [open $path(test1) w] chan puts $f abcdefghijklmnop chan close $f set f [open $path(test1) r] chan configure $f -blocking off - chan event $f readable [namespace code [list in $f]] + chan event $f readable [namespace code { + lappend l [chan read $f 3] + if {[chan eof $f]} {lappend l eof; chan close $f; set x done} + }] vwait [namespace which -variable x] return $l } -result {abc def ghi jkl mno {p @@ -5091,7 +5088,7 @@ test chan-io-39.10 {Tcl_SetChannelOption, blocking mode} -setup { chan gets stdin } chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] chan configure $f1 -blocking off -buffering line lappend x [chan configure $f1 -blocking] lappend x [chan gets $f1] @@ -5180,7 +5177,7 @@ test chan-io-39.16 {Tcl_SetChannelOption: -encoding, errors} -setup { test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} -setup { variable x {} } -constraints {stdio openpipe fileevent} -body { - set f [open "|[list [interpreter] $path(cat)]" r+] + set f [openpipe r+ $path(cat)] chan configure $f -encoding binary chan puts -nonewline $f "\xe7" chan flush $f @@ -5630,7 +5627,7 @@ test chan-io-44.4 {FileEventProc procedure: eror in write event} -setup { catch {chan close $f3} } -result {bad-write {}} test chan-io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} { - set f4 [open "|[list [interpreter] $path(cat) << foo]" r] + set f4 [openpipe r $path(cat) << foo] chan event $f4 readable [namespace code { if {[chan gets $f4 line] < 0} { lappend x eof @@ -5657,7 +5654,9 @@ test chan-io-45.1 {DeleteFileEvent, cleanup on chan close} {fileevent} { }] chan close $f set x initial - after 100 [namespace code { set y done }] + after 100 [namespace code { + set y done + }] variable y vwait [namespace which -variable y] set x @@ -5666,9 +5665,9 @@ test chan-io-45.2 {DeleteFileEvent, cleanup on chan close} {fileevent} { set f [open $path(foo) r] set f2 [open $path(foo) r] chan event $f readable [namespace code { - lappend x "f triggered: \"[chan gets $f]\"" - chan event $f readable {} - }] + lappend x "f triggered: \"[chan gets $f]\"" + chan event $f readable {} + }] chan event $f2 readable [namespace code { lappend x "f2 triggered: \"[chan gets $f2]\"" chan event $f2 readable {} @@ -5860,10 +5859,7 @@ test chan-io-48.1 {testing readability conditions} {fileevent} { chan puts $f abcdefg chan close $f set f [open $path(bar) r] - chan event $f readable [namespace code [list consume $f]] - proc consume {f} { - variable l - variable x + chan event $f readable [namespace code { lappend l called if {[chan eof $f]} { chan close $f @@ -5871,7 +5867,7 @@ test chan-io-48.1 {testing readability conditions} {fileevent} { } else { chan gets $f } - } + }] set l "" variable x not_done vwait [namespace which -variable x] @@ -5886,11 +5882,7 @@ test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} { chan puts $f abcdefg chan close $f set f [open $path(bar) r] - chan event $f readable [namespace code [list consume $f]] - chan configure $f -blocking off - proc consume {f} { - variable x - variable l + chan event $f readable [namespace code { lappend l called if {[chan eof $f]} { chan close $f @@ -5898,7 +5890,8 @@ test chan-io-48.2 {testing readability conditions} {nonBlockFiles fileevent} { } else { chan gets $f } - } + }] + chan configure $f -blocking off set l "" variable x not_done vwait [namespace which -variable x] @@ -5926,13 +5919,8 @@ test chan-io-48.3 {testing readability conditions} -setup { } } chan close $f - set f [open "|[list [interpreter]]" r+] - chan event $f readable [namespace code [list consume $f]] - chan configure $f -buffering line - chan configure $f -blocking off - proc consume {f} { - variable l - variable x + set f [openpipe] + chan event $f readable [namespace code { if {[chan eof $f]} { set x done } else { @@ -5941,7 +5929,9 @@ test chan-io-48.3 {testing readability conditions} -setup { chan gets $f lappend l [chan blocked $f] } - } + }] + chan configure $f -buffering line + chan configure $f -blocking off variable x not_done chan puts $f [list source $path(my_script)] chan puts $f "set f \[[list open $path(bar) r]]" @@ -5961,10 +5951,9 @@ test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode chan configure $f -translation lf chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f - proc consume {f} { - variable l - variable c - variable x + set f [open $path(test1) r] + chan configure $f -translation auto -eofchar \x1a + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -5972,10 +5961,7 @@ test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -5989,10 +5975,9 @@ test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} chan configure $f -translation lf chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f - proc consume {f} { - variable l - variable x - variable c + set f [open $path(test1) r] + chan configure $f -eofchar \x1a -translation auto + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6000,10 +5985,7 @@ test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6017,10 +5999,9 @@ test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode chan configure $f -translation cr chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f - proc consume {f} { - variable l - variable x - variable c + set f [open $path(test1) r] + chan configure $f -translation auto -eofchar \x1a + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6028,10 +6009,7 @@ test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6045,10 +6023,9 @@ test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} chan configure $f -translation cr chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f - proc consume {f} { - variable l - variable c - variable x + set f [open $path(test1) r] + chan configure $f -eofchar \x1a -translation auto + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6056,10 +6033,7 @@ test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6073,10 +6047,9 @@ test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mo chan configure $f -translation crlf chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f - proc consume {f} { - variable l - variable x - variable c + set f [open $path(test1) r] + chan configure $f -translation auto -eofchar \x1a + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6084,10 +6057,7 @@ test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mo lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -translation auto -eofchar \x1a - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6101,10 +6071,9 @@ test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode chan configure $f -translation crlf chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f - proc consume {f} { - variable l - variable c - variable x + set f [open $path(test1) r] + chan configure $f -eofchar \x1a -translation auto + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6112,10 +6081,7 @@ test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation auto - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6129,10 +6095,9 @@ test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} - chan configure $f -translation lf chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f - proc consume {f} { - variable l - variable c - variable x + set f [open $path(test1) r] + chan configure $f -eofchar \x1a -translation lf + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6140,10 +6105,7 @@ test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} - lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation lf - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6157,10 +6119,9 @@ test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} chan configure $f -translation lf chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f - proc consume {f} { - variable l - variable x - variable c + set f [open $path(test1) r] + chan configure $f -translation lf -eofchar \x1a + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6168,10 +6129,7 @@ test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode} lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -translation lf -eofchar \x1a - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6185,10 +6143,9 @@ test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} - chan configure $f -translation cr chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f - proc consume {f} { - variable l - variable x - variable c + set f [open $path(test1) r] + chan configure $f -eofchar \x1a -translation cr + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6196,10 +6153,7 @@ test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} - lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation cr - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6213,10 +6167,9 @@ test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} chan configure $f -translation cr chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f - proc consume {f} { - variable c - variable x - variable l + set f [open $path(test1) r] + chan configure $f -translation cr -eofchar \x1a + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6224,10 +6177,7 @@ test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode} lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -translation cr -eofchar \x1a - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6241,10 +6191,9 @@ test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mod chan configure $f -translation crlf chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26] chan close $f - proc consume {f} { - variable c - variable x - variable l + set f [open $path(test1) r] + chan configure $f -eofchar \x1a -translation crlf + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6252,10 +6201,7 @@ test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mod lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -eofchar \x1a -translation crlf - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6269,10 +6215,9 @@ test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} - chan configure $f -translation crlf chan puts -nonewline $f [format "abc\ndef\n%c" 26] chan close $f - proc consume {f} { - variable c - variable x - variable l + set f [open $path(test1) r] + chan configure $f -translation crlf -eofchar \x1a + chan event $f readable [namespace code { if {[chan eof $f]} { set x done chan close $f @@ -6280,10 +6225,7 @@ test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} - lappend l [chan gets $f] incr c } - } - set f [open $path(test1) r] - chan configure $f -translation crlf -eofchar \x1a - chan event $f readable [namespace code [list consume $f]] + }] variable x vwait [namespace which -variable x] list $c $l @@ -6413,13 +6355,11 @@ test chan-io-50.1 {testing handler deletion} -setup { set f [open $path(test1) w] chan close $f set f [open $path(test1) r] - testchannelevent $f add readable [namespace code [list delhandler $f]] - proc delhandler {f} { - variable z - set z called + testchannelevent $f add readable [namespace code { + variable z called testchannelevent $f delete 0 - } - set z not_called + }] + variable z not_called update return $z } -cleanup { @@ -6427,8 +6367,8 @@ test chan-io-50.1 {testing handler deletion} -setup { } -result called test chan-io-50.2 {testing handler deletion with multiple handlers} -setup { file delete $path(test1) - set f [open $path(test1) w] - chan close $f + 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]] @@ -6438,7 +6378,6 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup { lappend z "called delhandler $f $i" testchannelevent $f delete 0 } - set z "" update string equal $z \ [list [list called delhandler $f 0] [list called delhandler $f 1]] @@ -6447,13 +6386,12 @@ test chan-io-50.2 {testing handler deletion with multiple handlers} -setup { } -result 1 test chan-io-50.3 {testing handler deletion with multiple handlers} -setup { file delete $path(test1) - set f [open $path(test1) w] - chan close $f + 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]] - set z "" proc notcalled {f i} { variable z lappend z "notcalled was called!! $f $i" @@ -6465,7 +6403,6 @@ test chan-io-50.3 {testing handler deletion with multiple handlers} -setup { testchannelevent $f delete 0 lappend z "delhandler $f $i deleted myself" } - set z "" update string equal $z \ [list [list delhandler $f 0 called] \ @@ -6479,11 +6416,8 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup { chan close $f } -constraints {testchannelevent} -body { set f [open $path(test1) r] - testchannelevent $f add readable [namespace code [list delrecursive $f]] - proc delrecursive {f} { - variable z - variable u - if {"$u" eq "recursive"} { + testchannelevent $f add readable [namespace code { + if {$u eq "recursive"} { testchannelevent $f delete 0 lappend z "delrecursive deleting recursive" } else { @@ -6491,7 +6425,7 @@ test chan-io-50.4 {testing handler deletion vs reentrant calls} -setup { set u recursive update } - } + }] variable u toplevel variable z "" update @@ -6514,7 +6448,7 @@ test chan-io-50.5 {testing handler deletion vs reentrant calls} -setup { proc del {f} { variable u variable z - if {"$u" eq "recursive"} { + if {$u eq "recursive"} { testchannelevent $f delete 1 testchannelevent $f delete 0 lappend z "del deleted notcalled" @@ -6545,7 +6479,7 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup { proc first {f} { variable u variable z - if {"$u" == "toplevel"} { + if {$u eq "toplevel"} { lappend z "first called" set u first update @@ -6557,11 +6491,11 @@ test chan-io-50.6 {testing handler deletion vs reentrant calls} -setup { proc second {f} { variable u variable z - if {"$u" == "first"} { + if {$u eq "first"} { lappend z "second called, first time" set u second testchannelevent $f delete 0 - } elseif {"$u" == "second"} { + } elseif {$u eq "second"} { lappend z "second called, second time" testchannelevent $f delete 0 } else { @@ -6586,11 +6520,10 @@ test chan-io-51.1 {Test old socket deletion on Macintosh} -setup { } -constraints {socket} -body { proc accept {s a p} { variable x - variable wait chan configure $s -blocking off chan puts $s "sock[incr x]" chan close $s - set wait done + variable wait done } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [chan configure $ss -sockname] 2] @@ -6598,17 +6531,14 @@ test chan-io-51.1 {Test old socket deletion on Macintosh} -setup { vwait [namespace which -variable wait] lappend result [chan gets $cs] chan close $cs - set wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] chan close $cs - set wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] chan close $cs - set wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] @@ -6770,7 +6700,7 @@ test chan-io-52.8 {TclCopyChannel} -setup { chan close \$f1 " chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] chan configure $f1 -translation lf chan gets $f1 chan puts $f1 ready @@ -6866,7 +6796,7 @@ test chan-io-53.2 {CopyData} -setup { chan close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] - if {("$s1" == "$s2") && ($s0 == $s1)} { + if {($s1 == $s2) && ($s0 == $s1)} { lappend result ok } return $result @@ -6889,7 +6819,7 @@ test chan-io-53.3 {CopyData: background read underflow} -setup { chan close $f } chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] set result [chan gets $f1] chan puts $f1 line1 chan flush $f1 @@ -6924,7 +6854,7 @@ test chan-io-53.4 {CopyData: background write overflow} -setup { chan close $f } chan close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] + set f1 [openpipe r+ $path(pipe)] set result [chan gets $f1] chan configure $f1 -blocking 0 chan puts $f1 $big @@ -6980,7 +6910,7 @@ test chan-io-53.6 {CopyData: error during chan copy} -setup { set f1 [open $path(pipe) w] chan puts $f1 "exit 1" chan close $f1 - set in [open "|[list [interpreter] $path(pipe)]" r+] + set in [openpipe r+ $path(pipe)] set out [open $path(test1) w] chan copy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone @@ -7029,7 +6959,7 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup { exit 0 } chan close $f1 - set in [open "|[list [interpreter] $path(pipe) &]" r+] + set in [openpipe r+ $path(pipe) &] set out [open $path(test1) w] doFcopy $in $out variable fcopyTestDone @@ -7044,7 +6974,7 @@ test chan-io-53.7 {CopyData: Flooding chan copy from pipe} -setup { } -result {3450} test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { # copy progress callback. errors out intentionally - proc ::cmd args { + proc cmd args { lappend ::RES "CMD $args" error !STOP } @@ -7064,7 +6994,7 @@ test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -se # Record input size, so that result is always defined lappend ::RES [file size $bar] # Run the copy. Should not invoke -command now. - chan copy $f $g -size 2 -command ::cmd + chan copy $f $g -size 2 -command [namespace code cmd] # Check that -command was not called synchronously set sbs [file size $bar] lappend ::RES [expr {($sbs > 0) ? "sync/FAIL" : "sync/OK"}] $sbs @@ -7077,20 +7007,19 @@ test chan-io-53.8 {CopyData: async callback and error handling, Bug 1932639} -se vwait ::forever catch {after cancel $token} # Report - set ::RES + return $::RES } -cleanup { chan close $f chan close $g catch {unset ::RES} catch {unset ::forever} - rename ::cmd {} rename ::bgerror {} removeFile foo removeFile bar } -result {0 sync/OK 0 {CMD 2} {bgerror/OK !STOP}} test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} -setup { - # copy progress callback. errors out intentionally - proc ::cmd args { + # copy progress callback. + proc cmd args { lappend ::RES "CMD $args" set ::forever has-been-reached return @@ -7106,7 +7035,7 @@ test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at chan seek $f 0 end ; chan read $f 1 set ::RES [chan eof $f] # Run the copy. Should not invoke -command now. - chan copy $f $g -size 2 -command ::cmd + chan copy $f $g -size 2 -command [namespace code cmd] # Check that -command was not called synchronously lappend ::RES [expr {([llength $::RES] > 1) ? "sync/FAIL" : "sync/OK"}] # Now let the async part happen. Should capture the eof in cmd @@ -7118,13 +7047,12 @@ test chan-io-53.8a {CopyData: async callback and error handling, Bug 1932639, at vwait ::forever catch {after cancel $token} # Report - set ::RES + return $::RES } -cleanup { chan close $f chan close $g catch {unset ::RES} catch {unset ::forever} - rename ::cmd {} removeFile foo removeFile bar } -result {1 sync/OK {CMD 0}} @@ -7202,7 +7130,7 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup { global l srv chan configure $sok -translation binary -buffering none lappend l $sok - if {[llength $l]==2} { + if {[llength $l] == 2} { chan close $srv foreach {a b} $l break chan copy $a $b -command [list geof $a] @@ -7222,7 +7150,7 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup { # wait for OK from server. chan gets $pipe # Now the two clients. - proc ::done {sock} { + proc done {sock} { if {[chan eof $sock]} { chan close $sock ; return } lappend ::forever [chan gets $sock] return @@ -7231,8 +7159,8 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup { set b [socket 127.0.0.1 9999] chan configure $a -translation binary -buffering none chan configure $b -translation binary -buffering none - chan event $a readable [list ::done $a] - chan event $b readable [list ::done $b] + chan event $a readable [namespace code "done $a"] + chan event $b readable [namespace code "done $b"] } -constraints {stdio openpipe fcopy} -body { # Now pass data through the server in both directions. set ::forever {} @@ -7245,7 +7173,6 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup { catch {chan close $a} catch {chan close $b} chan close $pipe - rename ::done {} if {[testConstraint win]} { after 1000 ;# Give Windows time to kill the process } @@ -7309,6 +7236,7 @@ test chan-io-54.1 {Recursive channel events} {socket fileevent} { test chan-io-54.2 {Testing for busy-wait in recursive channel events} -setup { set accept {} set after {} + variable done 0 } -constraints {socket fileevent} -body { variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] proc accept {s a p} { @@ -7321,17 +7249,20 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} -setup { variable counter variable after incr counter - set l [chan gets $s] - if {"$l" == ""} { + if {[chan gets $s] eq ""} { chan event $s readable [namespace code "doit1 $s"] - set after [after 1000 [namespace code newline]] + set after [after 1000 [namespace code { + chan puts $writer hello + chan flush $writer + set done 1 + }]] } } proc doit1 {s} { variable counter variable accept incr counter - set l [chan gets $s] + chan gets $s chan close $s set accept {} } @@ -7343,15 +7274,7 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} -setup { chan puts -nonewline $writer hello chan flush $writer } - proc newline {} { - variable done - variable writer - chan puts $writer hello - chan flush $writer - set done 1 - } producer - variable done vwait [namespace which -variable done] chan close $writer chan close $s @@ -7479,7 +7402,7 @@ test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc ope } } chan close $out - set pipe [open "|[list [interpreter] $path(script)]" r] + set pipe [openpipe r $path(script)] chan event $pipe readable [namespace code [list readit $pipe]] variable x "" set result "" @@ -7518,7 +7441,7 @@ test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} { } } chan close $out - set pipe [open "|[list [interpreter] $path(script)]" r] + set pipe [openpipe r $path(script)] chan event $pipe readable [namespace code [list readit $pipe]] variable x "" set result "" |