diff options
Diffstat (limited to 'tests/io.test')
| -rw-r--r-- | tests/io.test | 2504 |
1 files changed, 655 insertions, 1849 deletions
diff --git a/tests/io.test b/tests/io.test index c4e47ac..50c5808 100644 --- a/tests/io.test +++ b/tests/io.test @@ -6,17 +6,17 @@ # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # -# Copyright © 1991-1994 The Regents of the University of California. -# Copyright © 1994-1997 Sun Microsystems, Inc. -# Copyright © 1998-1999 Scriptics Corporation. +# Copyright (c) 1991-1994 The Regents of the University of California. +# Copyright (c) 1994-1997 Sun Microsystems, Inc. +# Copyright (c) 1998-1999 by Scriptics Corporation. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. -if {"::tcltest" ni [namespace children]} { - package require tcltest 2.5 +if {[catch {package require tcltest 2}]} { + puts stderr "Skipping tests in [info script]. tcltest 2 required." + return } - namespace eval ::tcl::test::io { namespace import ::tcltest::* @@ -29,27 +29,15 @@ namespace eval ::tcl::test::io { variable msg variable expected - catch { - ::tcltest::loadTestedCommands - package require -exact tcl::test [info patchlevel] - set ::tcltestlib [info loaded {} Tcltest] - } - source [file join [file dirname [info script]] tcltests.tcl] - -testConstraint testbytestring [llength [info commands testbytestring]] testConstraint testchannel [llength [info commands testchannel]] +testConstraint exec [llength [info commands exec]] +testConstraint openpipe 1 +testConstraint fileevent [llength [info commands fileevent]] +testConstraint fcopy [llength [info commands fcopy]] testConstraint testfevent [llength [info commands testfevent]] testConstraint testchannelevent [llength [info commands testchannelevent]] testConstraint testmainthread [llength [info commands testmainthread]] -testConstraint testobj [llength [info commands testobj]] -testConstraint testservicemode [llength [info commands testservicemode]] -# Some things fail under Windows in Continuous Integration systems for subtle -# reasons such as CI often running with elevated privileges in a container. -testConstraint notWinCI [expr { - $::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}] -testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}] -# File permissions broken on wsl without some "exotic" wsl configuration -testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}] +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... @@ -79,7 +67,7 @@ set path(cat) [makeFile { if {$argv != ""} { set f [open [lindex $argv 0]] } - fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar "\x1A \x1A" + fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a fconfigure stdout -encoding binary -translation lf -buffering none fileevent $f readable "foo $f" proc foo {f} { @@ -110,17 +98,17 @@ set path(test1) [makeFile {} test1] test io-1.6 {Tcl_WriteChars: WriteBytes} { set f [open $path(test1) w] fconfigure $f -encoding binary - puts -nonewline $f "a\x4D\x00" + puts -nonewline $f "a\u4e4d\0" close $f contents $path(test1) -} "a\x4D\x00" +} "a\x4d\x00" test io-1.7 {Tcl_WriteChars: WriteChars} { set f [open $path(test1) w] fconfigure $f -encoding shiftjis - puts -nonewline $f "a乍\x00" + puts -nonewline $f "a\u4e4d\0" close $f contents $path(test1) -} "a\x93\xE1\x00" +} "a\x93\xe1\x00" set path(test2) [makeFile {} test2] test io-1.8 {Tcl_WriteChars: WriteChars} { # This test written for SF bug #506297. @@ -129,12 +117,12 @@ test io-1.8 {Tcl_WriteChars: WriteChars} { # applied to tcl will cause tcl, more specifically WriteChars, to # go into an infinite loop. - set f [open $path(test2) w] - fconfigure $f -encoding iso2022-jp - puts -nonewline $f [format %s%c [string repeat " " 4] 12399] - close $f + set f [open $path(test2) w] + fconfigure $f -encoding iso2022-jp + puts -nonewline $f [format %s%c [string repeat " " 4] 12399] + close $f contents $path(test2) -} " \x1B\$B\$O\x1B(B" +} " \x1b\$B\$O\x1b(B" test io-1.9 {Tcl_WriteChars: WriteChars} { # When closing a channel with an encoding that appends @@ -198,7 +186,7 @@ test io-1.9 {Tcl_WriteChars: WriteChars} { test io-2.1 {WriteBytes} { # loop until all bytes are written - + set f [open $path(test1) w] fconfigure $f -encoding binary -buffersize 16 -translation crlf puts $f "abcdefghijklmnopqrstuvwxyz" @@ -220,7 +208,7 @@ test io-2.3 {WriteBytes: flush on line} { # 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] fconfigure $f -encoding binary -buffering line -translation crlf puts -nonewline $f "\n12" @@ -240,7 +228,7 @@ test io-2.4 {WriteBytes: reset sawLF after each buffer} { test io-3.1 {WriteChars: compatibility with WriteBytes} { # loop until all bytes are written - + set f [open $path(test1) w] fconfigure $f -encoding ascii -buffersize 16 -translation crlf puts $f "abcdefghijklmnopqrstuvwxyz" @@ -262,7 +250,7 @@ test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} { # 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] fconfigure $f -encoding ascii -buffering line -translation crlf puts -nonewline $f "\n12" @@ -270,50 +258,46 @@ test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} { close $f set x } "\r\n12" -test io-3.4 {WriteChars: loop over stage buffer} -body { +test io-3.4 {WriteChars: loop over stage buffer} { # stage buffer maps to more than can be queued at once. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 16 -profile tcl8 + fconfigure $f -encoding jis0208 -buffersize 16 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] -} -cleanup { - catch {close $f} -} -result [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] -test io-3.5 {WriteChars: saved != 0} -body { +} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] +test io-3.5 {WriteChars: saved != 0} { # Bytes produced by UtfToExternal from end of last channel buffer # had to be moved to beginning of next channel buffer to preserve # requested buffersize. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 17 -profile tcl8 + fconfigure $f -encoding jis0208 -buffersize 17 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] -} -cleanup { - catch {close $f} -} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] +} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} { # One incomplete UTF-8 character at end of staging buffer. Backup # in src to the beginning of that UTF-8 character and try again. # # Translate the first 16 bytes, produce 14 bytes of output, 2 left over - # (first two bytes of Ａ in UTF-8). Given those two bytes try + # (first two bytes of \uff21 in UTF-8). Given those two bytes try # translating them again, find that no bytes are read produced, and break # to outer loop where those two bytes will have the remaining 4 bytes - # (the last byte of Ａ plus the all of Ｂ) appended. + # (the last byte of \uff21 plus the all of \uff22) appended. set f [open $path(test1) w] fconfigure $f -encoding shiftjis -buffersize 16 - puts -nonewline $f "12345678901234ＡＢ" + puts -nonewline $f "12345678901234\uff21\uff22" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] } [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"] -test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body { +test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} { # When translating UTF-8 to external, the produced bytes went past end # of the channel buffer. This is done purpose -- we then truncate the # bytes at the end of the partial character to preserve the requested @@ -321,14 +305,12 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body { # of the next channel buffer. set f [open $path(test1) w] - fconfigure $f -encoding jis0208 -buffersize 17 -profile tcl8 + fconfigure $f -encoding jis0208 -buffersize 17 puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" set x [list [contents $path(test1)]] close $f lappend x [contents $path(test1)] -} -cleanup { - catch {close $f} -} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] +} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test io-3.8 {WriteChars: reset sawLF after each buffer} { set f [open $path(test1) w] fconfigure $f -encoding ascii -buffering line -translation lf \ @@ -338,15 +320,6 @@ test io-3.8 {WriteChars: reset sawLF after each buffer} { close $f lappend x [contents $path(test1)] } [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"] -test io-3.9 {Write: flush line-buffered channels when crlf is split over two buffers} -body { - # https://core.tcl-lang.org/tcllib/tktedit?name=c9d8a52fe - set f [open $path(test1) w] - fconfigure $f -buffering line -translation crlf -buffersize 8 - puts $f "1234567" - string map {"\r" "<cr>" "\n" "<lf>"} [contents $path(test1)] -} -cleanup { - close $f -} -result "1234567<cr><lf>" test io-4.1 {TranslateOutputEOL: lf} { # search for \n @@ -402,7 +375,7 @@ test io-4.5 {TranslateOutputEOL: crlf} { test io-5.1 {CheckFlush: not full} { set f [open $path(test1) w] - fconfigure $f + fconfigure $f puts -nonewline $f "12345678901234567890" set x [list [contents $path(test1)]] close $f @@ -468,7 +441,7 @@ test io-6.3 {Tcl_GetsObj: how many have we used?} { test io-6.4 {Tcl_GetsObj: encoding == NULL} { set f [open $path(test1) w] fconfigure $f -translation binary - puts $f "\x81\x34\x00" + puts $f "\x81\u1234\0" close $f set f [open $path(test1)] fconfigure $f -translation binary @@ -479,19 +452,19 @@ test io-6.4 {Tcl_GetsObj: encoding == NULL} { test io-6.5 {Tcl_GetsObj: encoding != NULL} { set f [open $path(test1) w] fconfigure $f -translation binary - puts $f "\x88\xEA\x92\x9A" + puts $f "\x88\xea\x92\x9a" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis set x [list [gets $f line] $line] close $f set x -} [list 2 "一丁"] +} [list 2 "\u4e00\u4e01"] set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" append a $a append a $a test io-6.6 {Tcl_GetsObj: loop test} { - # if (dst >= dstEnd) + # if (dst >= dstEnd) set f [open $path(test1) w] puts $f $a @@ -502,7 +475,7 @@ test io-6.6 {Tcl_GetsObj: loop test} { close $f set x } [list 256 $a] -test io-6.7 {Tcl_GetsObj: error in input} stdio { +test io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} { # if (FilterInputBytes(chanPtr, &gs) != 0) set f [open "|[list [interpreter] $path(cat)]" w+] @@ -516,20 +489,20 @@ test io-6.7 {Tcl_GetsObj: error in input} stdio { } {-1} test io-6.8 {Tcl_GetsObj: remember if EOF is seen} { set f [open $path(test1) w] - puts $f "abcdef\x1Aghijk\nwombat" + puts $f "abcdef\x1aghijk\nwombat" close $f set f [open $path(test1)] - fconfigure $f -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a set x [list [gets $f line] $line [gets $f line] $line] close $f set x } {6 abcdef -1 {}} test io-6.9 {Tcl_GetsObj: remember if EOF is seen} { set f [open $path(test1) w] - puts $f "abcdefghijk\nwom\x1Abat" + puts $f "abcdefghijk\nwom\u001abat" close $f set f [open $path(test1)] - fconfigure $f -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a set x [list [gets $f line] $line [gets $f line] $line] close $f set x @@ -762,7 +735,7 @@ test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} { close $f set x } [list 15 "123456789012345" 15] -test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel fileevent} { +test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} { # (FilterInputBytes() != 0) set f [open "|[list [interpreter] $path(cat)]" w+] @@ -790,7 +763,7 @@ test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} } [list 15 "123456789012345" 17 3] test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} { # eol still equals dstEnd - + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\r" @@ -802,8 +775,8 @@ test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} { set x } [list 16 "123456789012345\r" 1] test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} { - # not (*eol == '\n') - + # not (*eol == '\n') + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\rabcd\r\nefg" @@ -901,7 +874,7 @@ test io-6.42 {Tcl_GetsObj: auto mode: several chars} { close $f set x } [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""] -test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel fileevent} { +test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} { # if (chanPtr->flags & INPUT_SAW_CR) set f [open "|[list [interpreter] $path(cat)]" w+] @@ -910,16 +883,16 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel fileevent} { fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 - lappend x [gets $f line] $line [testchannel queuedcr $f] + lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 - puts -nonewline $f "\nabcd\refg\x1A" + puts -nonewline $f "\nabcd\refg\x1a" lappend x [gets $f line] $line [testchannel queuedcr $f] lappend x [gets $f line] $line close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] -test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fileevent} { - # not (*eol == '\n') +test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} { + # not (*eol == '\n') set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none @@ -927,20 +900,20 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel fconfigure $f -buffersize 16 set x [list [gets $f]] fconfigure $f -blocking 0 - lappend x [gets $f line] $line [testchannel queuedcr $f] + lappend x [gets $f line] $line [testchannel queuedcr $f] fconfigure $f -blocking 1 - puts -nonewline $f "abcd\refg\x1A" + puts -nonewline $f "abcd\refg\x1a" lappend x [gets $f line] $line [testchannel queuedcr $f] lappend x [gets $f line] $line close $f set x } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] -test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel fileevent} { +test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} { # Tcl_ExternalToUtf() set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto lf} -buffering none - fconfigure $f -encoding utf-16 + fconfigure $f -encoding unicode puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" fconfigure $f -buffersize 16 gets $f @@ -952,7 +925,7 @@ test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio test close $f set x } [list 15 "123456789abcdef" 1 4 "abcd" 0] -test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel fileevent} { +test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} { # memmove() set f [open "|[list [interpreter] $path(cat)]" w+] @@ -963,7 +936,7 @@ test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {s fconfigure $f -blocking 0 set x [list [gets $f line] $line [testchannel queuedcr $f]] fconfigure $f -blocking 1 - puts -nonewline $f "\n\x1A" + puts -nonewline $f "\n\x1a" lappend x [gets $f line] $line [testchannel queuedcr $f] close $f set x @@ -980,10 +953,10 @@ test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testcha set x [list [gets $f] [testchannel inputbuffered $f]] close $f set x -} [list "123456789012345" 15] +} [list "123456789012345" 15] test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} { # PeekAhead() did not get any, so (eol >= dstEnd) - + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456789012345\r" @@ -996,7 +969,7 @@ test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testc } [list "123456789012345" 1] test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { # if (*eol == '\n') {skip++} - + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\r\n78901" @@ -1007,8 +980,8 @@ test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { set x } [list "123456" 0 8 "78901"] test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} { - # not (*eol == '\n') - + # not (*eol == '\n') + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\r78901" @@ -1020,7 +993,7 @@ test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} { } [list "123456" 0 7 "78901"] test io-6.51 {Tcl_GetsObj: auto mode: \n} { # else if (*eol == '\n') {goto gotoeol;} - + set f [open $path(test1) w] fconfigure $f -translation lf puts -nonewline $f "123456\n78901" @@ -1035,10 +1008,10 @@ test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} { set f [open $path(test1) w] fconfigure $f -translation lf - puts -nonewline $f "123456\x1Ak9012345\r" + puts -nonewline $f "123456\x1ak9012345\r" close $f set f [open $path(test1)] - fconfigure $f -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]] close $f set x @@ -1069,15 +1042,15 @@ test io-6.55 {Tcl_GetsObj: overconverted} { set f [open $path(test1) w] fconfigure $f -encoding iso2022-jp - puts $f "there一ok\n丁more bytes\nhere" + puts $f "there\u4e00ok\n\u4e01more bytes\nhere" close $f set f [open $path(test1)] fconfigure $f -encoding iso2022-jp set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line] close $f set x -} [list 8 "there一ok" 11 "丁more bytes" 4 "here"] -test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} { +} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"] +test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio openpipe fileevent} { update set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -buffering none @@ -1103,23 +1076,23 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} { set f [open $path(test1) w] fconfigure $f -encoding shiftjis - puts $f "1234567890123０１２３４\nend" + puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend" close $f set f [open $path(test1)] fconfigure $f -encoding shiftjis -buffersize 16 set x [gets $f] close $f set x -} "1234567890123０１２３４" +} "1234567890123\uff10\uff11\uff12\uff13\uff14" test io-7.2 {FilterInputBytes: split up character in middle of buffer} { # (bufPtr->nextAdded < bufPtr->bufLength) - + set f [open $path(test1) w] fconfigure $f -encoding binary - puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82" + puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82" close $f set f [open $path(test1)] - fconfigure $f -encoding shiftjis -profile tcl8 + fconfigure $f -encoding shiftjis set x [list [gets $f line] $line [eof $f]] close $f set x @@ -1127,20 +1100,20 @@ test io-7.2 {FilterInputBytes: split up character in middle of buffer} { test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} { set f [open $path(test1) w] fconfigure $f -encoding binary - puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" + puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" close $f set f [open $path(test1)] - fconfigure $f -encoding shiftjis -profile tcl8 + fconfigure $f -encoding shiftjis set x [list [gets $f line] $line] lappend x [tell $f] [testchannel inputbuffered $f] [eof $f] lappend x [gets $f line] $line close $f set x -} [list 16 "1234567890123０１\x82" 18 0 1 -1 ""] -test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} { +} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""] +test io-7.4 {FilterInputBytes: recover from split up character} {stdio openpipe fileevent} { set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -encoding binary -buffering none - puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82" + puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82" fconfigure $f -encoding shiftjis -blocking 0 fileevent $f read [namespace code "ready $f"] variable x {} @@ -1155,7 +1128,7 @@ test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent vwait [namespace which -variable x] close $f set x -} [list -1 "" 1 17 "1234567890123０１２３" 0] +} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0] test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} { # (bufPtr->nextPtr == NULL) @@ -1172,7 +1145,7 @@ test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} close $f set x } "7" -test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel fileevent} { +test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel openpipe fileevent} { # not (bufPtr->nextPtr == NULL) set f [open "|[list [interpreter] $path(cat)]" w+] @@ -1184,7 +1157,7 @@ test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testcha variable x lappend x [gets $f line] $line [testchannel inputbuffered $f] } - fconfigure $f -encoding utf-16 -buffersize 16 -blocking 0 + fconfigure $f -encoding unicode -buffersize 16 -blocking 0 vwait [namespace which -variable x] fconfigure $f -translation auto -encoding ascii -blocking 1 # here @@ -1192,7 +1165,7 @@ test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testcha close $f set x } [list -1 "" 42 15 "123456789012345" 25] -test io-8.3 {PeekAhead: no cached data available} {stdio testchannel fileevent} { +test io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} { # (bytesLeft == 0) set f [open "|[list [interpreter] $path(cat)]" w+] @@ -1222,10 +1195,10 @@ test io-8.4 {PeekAhead: cached data available in this buffer} { set x [gets $f] close $f - set x + set x } $a unset a -test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel fileevent} { +test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} { # (bufPtr->nextAdded < bufPtr->length) set f [open "|[list [interpreter] $path(cat)]" w+] @@ -1237,8 +1210,8 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel fi close $f set x } {15 abcdefghijklmno 1} -test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel fileevent} { - # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) +test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} { + # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0) set f [open "|[list [interpreter] $path(cat)]" w+] fconfigure $f -translation {auto binary} -buffersize 16 @@ -1249,7 +1222,7 @@ test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel fileeven close $f set x } {15 abcdefghijklmno 1} -test io-8.7 {PeekAhead: cleanup} {stdio testchannel fileevent} { +test io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} { # Make sure bytes are removed from buffer. set f [open "|[list [interpreter] $path(cat)]" w+] @@ -1257,7 +1230,7 @@ test io-8.7 {PeekAhead: cleanup} {stdio testchannel fileevent} { puts -nonewline $f "abcdefghijklmno\r" # here set x [list [gets $f line] $line [testchannel queuedcr $f]] - puts -nonewline $f "\x1A" + puts -nonewline $f "\x1a" lappend x [gets $f line] $line close $f set x @@ -1414,7 +1387,7 @@ test io-12.3 {ReadChars: allocate more space} { close $f set x } {abcdefghijklmnopqrstuvwxyz} -test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} { +test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} { # (srcRead == 0) set f [open "|[list [interpreter] $path(cat)]" w+] @@ -1432,19 +1405,19 @@ test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} { fconfigure $f -encoding shiftjis vwait [namespace which -variable x] fconfigure $f -encoding binary -blocking 1 - puts -nonewline $f "\x7B" + puts -nonewline $f "\x7b" after 500 ;# Give the cat process time to catch up fconfigure $f -encoding shiftjis -blocking 0 vwait [namespace which -variable x] close $f set x -} [list "123456789012345" 1 "本" 0] -test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} { +} [list "123456789012345" 1 "\u672c" 0] +test io-12.5 {ReadChars: fileevents on partial characters} {stdio openpipe fileevent} { set path(test1) [makeFile { fconfigure stdout -encoding binary -buffering none - gets stdin; puts -nonewline "\xE7" + gets stdin; puts -nonewline "\xe7" gets stdin; puts -nonewline "\x89" - gets stdin; puts -nonewline "\xA6" + gets stdin; puts -nonewline "\xa6" } test1] set f [open "|[list [interpreter] $path(test1)]" r+] fileevent $f readable [namespace code { @@ -1471,77 +1444,77 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} { vwait [namespace which -variable x] lappend x [catch {close $f} msg] $msg set x -} "{} timeout {} timeout 牦 {} eof 0 {}" +} "{} timeout {} timeout \u7266 {} eof 0 {}" test io-12.6 {ReadChars: too many chars read} { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat 뻯 20][string repeat . 20]] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat \uBEEF 20][string repeat . 20]] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 while {![eof $c]} { - read $c 15 + read $c 15 } close $c } {} test io-12.7 {ReadChars: too many chars read [bc5b790099]} { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat 뻯 10]....뻯] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat \uBEEF 10]....\uBEEF] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 while {![eof $c]} { - read $c 7 + read $c 7 } close $c } {} test io-12.8 {ReadChars: multibyte chars split} { set f [open $path(test1) w] fconfigure $f -translation binary - puts -nonewline $f [string repeat a 9]\xC2\xA0 + puts -nonewline $f [string repeat a 9]\xc2\xa0 close $f set f [open $path(test1)] fconfigure $f -encoding utf-8 -buffersize 10 @@ -1549,46 +1522,28 @@ test io-12.8 {ReadChars: multibyte chars split} { close $f scan [string index $in end] %c } 160 -test io-12.9 {ReadChars: multibyte chars split} -body { +test io-12.9 {ReadChars: multibyte chars split} { set f [open $path(test1) w] fconfigure $f -translation binary - puts -nonewline $f [string repeat a 9]\xC2 + puts -nonewline $f [string repeat a 9]\xc2 close $f set f [open $path(test1)] - fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 10 - set in [read $f] - read $f - scan [string index $in end] %c -} -cleanup { - catch {close $f} -} -result 194 -test io-12.10 {ReadChars: multibyte chars split} -body { - set f [open $path(test1) w] - fconfigure $f -translation binary - puts -nonewline $f [string repeat a 9]\xC2 - close $f - set f [open $path(test1)] - fconfigure $f -encoding utf-8 -profile strict -buffersize 10 + fconfigure $f -encoding utf-8 -buffersize 10 set in [read $f] close $f scan [string index $in end] %c -} -cleanup { - catch {close $f} -} -returnCodes 1 -match glob -result {error reading "file*":\ - invalid or incomplete multibyte or wide character} -test io-12.11 {ReadChars: multibyte chars split} -body { +} 194 +test io-12.10 {ReadChars: multibyte chars split} { set f [open $path(test1) w] fconfigure $f -translation binary - puts -nonewline $f [string repeat a 9]\xC2 + puts -nonewline $f [string repeat a 9]\xc2 close $f set f [open $path(test1)] - fconfigure $f -encoding utf-8 -profile tcl8 -buffersize 11 + fconfigure $f -encoding utf-8 -buffersize 11 set in [read $f] close $f scan [string index $in end] %c -} -cleanup { - catch {close $f} -} -result 194 +} 194 test io-13.1 {TranslateInputEOL: cr mode} {} { set f [open $path(test1) w] @@ -1613,7 +1568,7 @@ test io-13.2 {TranslateInputEOL: crlf mode} { set x } "abcd\ndef\n" test io-13.3 {TranslateInputEOL: crlf mode: naked cr} { - # (src >= srcMax) + # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf @@ -1626,7 +1581,7 @@ test io-13.3 {TranslateInputEOL: crlf mode: naked cr} { set x } "abcd\ndef\r" test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} { - # (src >= srcMax) + # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf @@ -1639,7 +1594,7 @@ test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} { set x } "abcd\ndef\rfgh" test io-13.5 {TranslateInputEOL: crlf mode: naked lf} { - # (src >= srcMax) + # (src >= srcMax) set f [open $path(test1) w] fconfigure $f -translation lf @@ -1651,7 +1606,7 @@ test io-13.5 {TranslateInputEOL: crlf mode: naked lf} { close $f set x } "abcd\ndef\nfgh" -test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel fileevent} { +test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel openpipe fileevent} { # (chanPtr->flags & INPUT_SAW_CR) # This test may fail on slower machines. @@ -1677,7 +1632,7 @@ test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testc close $f set x } [list "abcdefghj\n" 1 "01234" 0] -test io-13.7 {TranslateInputEOL: auto mode: naked \r} testchannel { +test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} { # (src >= srcMax) set f [open $path(test1) w] @@ -1754,7 +1709,7 @@ test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} { set x } "abcd\ndef" test io-13.10 {TranslateInputEOL: auto mode: \n} { - # not (*src == '\r') + # not (*src == '\r') set f [open $path(test1) w] fconfigure $f -translation lf @@ -1767,7 +1722,7 @@ test io-13.10 {TranslateInputEOL: auto mode: \n} { set x } "abcd\ndef" test io-13.11 {TranslateInputEOL: EOF char} { - # (*chanPtr->inEofChar != '\x00') + # (*chanPtr->inEofChar != '\0') set f [open $path(test1) w] fconfigure $f -translation lf @@ -1780,7 +1735,7 @@ test io-13.11 {TranslateInputEOL: EOF char} { set x } "abcd\nd" test io-13.12 {TranslateInputEOL: find EOF char in src} { - # (*chanPtr->inEofChar != '\x00') + # (*chanPtr->inEofChar != '\0') set f [open $path(test1) w] fconfigure $f -translation lf @@ -1822,7 +1777,7 @@ test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} { set l } {line line none} set path(test3) [makeFile {} test3] -test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} exec { +test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} { set f [open $path(test1) w] puts -nonewline $f { close stdin @@ -1851,8 +1806,8 @@ test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} exec { out } {err }} -# This test relies on the fact that stdout is used before stderr -test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} { +# This test relies on the fact that the smallest available fd is used first. +test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unix} { set f [open $path(test1) w] puts -nonewline $f { close stdin close stdout @@ -1877,8 +1832,8 @@ test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec} { close $f2 set result } {{ close stdin -stdout -} {stderr +file1 +} {file2 }} catch {interp delete z} test io-14.5 {Tcl_GetChannel: stdio name translation} { @@ -1912,7 +1867,7 @@ test io-14.7 {Tcl_GetChannel: stdio name translation} { set result } {{} {} {can not find channel named "stderr"}} set path(script) [makeFile {} script] -test io-14.8 {reuse of stdio special channels} stdio { +test io-14.8 {reuse of stdio special channels} {stdio openpipe} { file delete $path(script) file delete $path(test1) set f [open $path(script) w] @@ -1934,12 +1889,12 @@ test io-14.8 {reuse of stdio special channels} stdio { close $f set c } hello -test io-14.9 {reuse of stdio special channels} {stdio fileevent} { +test io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} { file delete $path(script) file delete $path(test1) set f [open $path(script) w] puts $f { - array set path [lindex $argv 0] + array set path [lindex $argv 0] set f [open $path(test1) w] puts $f hello close $f @@ -1978,11 +1933,11 @@ test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} eof stdin interp create x set l "" - lappend l [expr {[testchannel refcount stdin] - $l1}] + lappend l [expr [testchannel refcount stdin] - $l1] x eval {eof stdin} - lappend l [expr {[testchannel refcount stdin] - $l1}] + lappend l [expr [testchannel refcount stdin] - $l1] interp delete x - lappend l [expr {[testchannel refcount stdin] - $l1}] + lappend l [expr [testchannel refcount stdin] - $l1] set l } {0 1 0} test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { @@ -1990,11 +1945,11 @@ test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} eof stdin interp create x set l "" - lappend l [expr {[testchannel refcount stdout] - $l1}] + lappend l [expr [testchannel refcount stdout] - $l1] x eval {eof stdout} - lappend l [expr {[testchannel refcount stdout] - $l1}] + lappend l [expr [testchannel refcount stdout] - $l1] interp delete x - lappend l [expr {[testchannel refcount stdout] - $l1}] + lappend l [expr [testchannel refcount stdout] - $l1] set l } {0 1 0} test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { @@ -2002,11 +1957,11 @@ test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} eof stdin interp create x set l "" - lappend l [expr {[testchannel refcount stderr] - $l1}] + lappend l [expr [testchannel refcount stderr] - $l1] x eval {eof stderr} - lappend l [expr {[testchannel refcount stderr] - $l1}] + lappend l [expr [testchannel refcount stderr] - $l1] interp delete x - lappend l [expr {[testchannel refcount stderr] - $l1}] + lappend l [expr [testchannel refcount stderr] - $l1] set l } {0 1 0} @@ -2103,13 +2058,13 @@ test io-20.1 {Tcl_CreateChannel: initial settings} { encoding system $old close $a set x -} {ascii} +} {ascii} test io-20.2 {Tcl_CreateChannel: initial settings} {win} { set f [open $path(test1) w+] set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] close $f set x -} [list [list \x1A ""] {auto crlf}] +} [list [list \x1a ""] {auto crlf}] test io-20.3 {Tcl_CreateChannel: initial settings} {unix} { set f [open $path(test1) w+] set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]] @@ -2117,7 +2072,7 @@ test io-20.3 {Tcl_CreateChannel: initial settings} {unix} { set x } {{{} {}} {auto lf}} set path(stdout) [makeFile {} stdout] -test io-20.5 {Tcl_CreateChannel: install channel in empty slot} stdio { +test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} { set f [open $path(script) w] puts -nonewline $f { close stdout @@ -2191,14 +2146,14 @@ test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} { set l } {6 6 0 6} -test io-26.1 {Tcl_GetChannelInstanceData} stdio { +test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} { # "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]"] - expr {[pid $f]} + expr [pid $f] close $f -} {} +} {} # Test flushing. The functions tested here are FlushChannel. @@ -2251,7 +2206,7 @@ test io-27.4 {FlushChannel, implicit flush when buffer fills} { set l } {0 60 72} test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ - {unixOrWin} { + {unixOrPc} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf -buffersize 60 -eofchar {} @@ -2268,7 +2223,7 @@ test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \ set path(pipe) [makeFile {} pipe] set path(output) [makeFile {} output] test io-27.6 {FlushChannel, async flushing, async close} \ - {stdio asyncPipeClose notWinCI} { + {stdio asyncPipeClose openpipe} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) @@ -2286,7 +2241,7 @@ test io-27.6 {FlushChannel, async flushing, async close} \ close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { - set x "$x$x" + set x "$x$x" } set f [open $path(output) w] close $f @@ -2300,9 +2255,9 @@ test io-27.6 {FlushChannel, async flushing, async close} \ vwait [namespace which -variable counter] } if {$counter == 1000} { - set result "file size only [file size $path(output)]" + set result "file size only [file size $path(output)]" } else { - set result ok + set result ok } } ok @@ -2337,7 +2292,7 @@ test io-28.2 {CloseChannel called when all references are dropped} { set l } abcdef test io-28.3 {CloseChannel, not called before output queue is empty} \ - {stdio asyncPipeClose nonPortable} { + {stdio asyncPipeClose nonPortable openpipe} { file delete $path(pipe) file delete $path(output) set f [open $path(pipe) w] @@ -2361,7 +2316,7 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \ close $f set x 01234567890123456789012345678901 for {set i 0} {$i < 11} {incr i} { - set x "$x$x" + set x "$x$x" } set f [open $path(output) w] close $f @@ -2376,14 +2331,14 @@ test io-28.3 {CloseChannel, not called before output queue is empty} \ vwait [namespace which -variable counter] } if {$counter == 1000} { - set result probably_broken + set result probably_broken } else { - set result ok + set result ok } } ok -test io-28.4 Tcl_Close testchannel { +test io-28.4 {Tcl_Close} {testchannel} { file delete $path(test1) - set l {} + set l "" lappend l [lsort [testchannel open]] set f [open $path(test1) w] lappend l [lsort [testchannel open]] @@ -2394,7 +2349,7 @@ test io-28.4 Tcl_Close testchannel { $consoleFileNames] string compare $l $x } 0 -test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel} { +test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel openpipe} { file delete $path(script) set f [open $path(script) w] puts $f { @@ -2405,77 +2360,9 @@ test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel} { set f [open "|[list [interpreter] $path(script)]" r] set l [gets $f] close $f - lsort $l + set l } {file1 file2} - -test io-28.6 { - close channel in write event handler - - Should not produce a segmentation fault in a Tcl built with - --enable-symbols and -DPURIFY -} debugpurify { - variable done - variable res - after 0 [list coroutine c1 apply [list {} { - variable done - set chan [chan create w {apply {args { - list initialize finalize watch write configure blocking - }}}] - chan configure $chan -blocking 0 - while 1 { - chan event $chan writable [list [info coroutine]] - yield - close $chan - set done 1 - return - } - } [namespace current]]] - vwait [namespace current]::done -return success -} success - - -test io-28.7 { - close channel in read event handler - - Should not produce a segmentation fault in a Tcl built with - --enable-symbols and -DPURIFY -} debugpurify { - variable done - variable res - after 0 [list coroutine c1 apply [list {} { - variable done - set chan [chan create r {apply {{cmd chan args} { - switch $cmd { - blocking - finalize { - } - watch { - chan postevent $chan read - } - initialize { - list initialize finalize watch read write configure blocking - } - default { - error [list {unexpected command} $cmd] - } - } - }}}] - chan configure $chan -blocking 0 - while 1 { - chan event $chan readable [list [info coroutine]] - yield - close $chan - set done 1 - return - } - } [namespace current]]] - vwait [namespace current]::done -return success -} success - - - test io-29.1 {Tcl_WriteChars, channel not writable} { list [catch {puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} @@ -2601,7 +2488,7 @@ test io-29.11 {Tcl_WriteChars, no newline, implicit flush} { close $f2 file size $path(test1) } 377 -test io-29.12 {Tcl_WriteChars on a pipe} stdio { +test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] @@ -2626,7 +2513,7 @@ test io-29.12 {Tcl_WriteChars on a pipe} stdio { close $f2 set y } ok -test io-29.13 {Tcl_WriteChars to a pipe, line buffered} stdio { +test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] @@ -2677,7 +2564,7 @@ test io-29.15 {Tcl_Flush, channel not open for writing} { string compare $x \ [list 1 "channel \"$fd\" wasn't opened for writing"] } 0 -test io-29.16 {Tcl_Flush on pipe opened only for reading} stdio { +test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} { set fd [open "|[list [interpreter] cat longfile]" r] set x [list [catch {flush $fd} msg] $msg] catch {close $fd} @@ -2751,7 +2638,7 @@ test io-29.20 {Implicit flush when buffer is full} { lappend z [file size $path(test1)] set z } {4096 12288 12600} -test io-29.21 {Tcl_Flush to pipe} stdio { +test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {set x [read stdin 6]} @@ -2765,7 +2652,7 @@ test io-29.21 {Tcl_Flush to pipe} stdio { catch {close $f1} set x } "read 6 characters" -test io-29.22 {Tcl_Flush called at other end of pipe} stdio { +test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { @@ -2788,7 +2675,7 @@ test io-29.22 {Tcl_Flush called at other end of pipe} stdio { close $f1 set x } {hello hello bye} -test io-29.23 {Tcl_Flush and line buffering at end of pipe} stdio { +test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { @@ -2823,7 +2710,7 @@ test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} { close $f set x } "{} {Line 1\nLine 2}" -test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio fileevent} { +test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpipe fileevent} { file delete $path(test3) set f [open "|[list [interpreter] $path(cat) | [interpreter] $path(cat) > $path(test3)]" w] puts $f "Line 1" @@ -2835,7 +2722,7 @@ test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio fileev close $f set x } "Line 1\nLine 2\n" -test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs} { +test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs openpipe} { set f [open "|[list cat -u]" r+] puts $f "Line1" flush $f @@ -2843,7 +2730,7 @@ test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs close $f set x } {Line1} -test io-29.27 {Tcl_Flush on closed pipeline} stdio { +test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} { file delete $path(pipe) set f [open $path(pipe) w] puts $f {exit} @@ -2897,7 +2784,7 @@ test io-29.30 {Tcl_WriteChars, crlf mode} { close $f file size $path(test1) } 25 -test io-29.31 {Tcl_WriteChars, background flush} stdio { +test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) @@ -2934,13 +2821,13 @@ test io-29.31 {Tcl_WriteChars, background flush} stdio { set result ok } # allow a little time for the background process to close. - # otherwise, the following test fails on the [file delete $path(output)] + # otherwise, the following test fails on the [file delete $path(output) # on Windows because a process still has the file open. after 100 set v 1; vwait v set result } ok test io-29.32 {Tcl_WriteChars, background flush to slow reader} \ - {stdio asyncPipeClose notWinCI} { + {stdio asyncPipeClose openpipe} { # This test may fail on old Unix systems (seen on IRIX64 6.5) with # obsolete gettimeofday() calls. See Tcl Bugs 3530533, 1942197. file delete $path(pipe) @@ -2993,26 +2880,6 @@ test io-29.33 {Tcl_Flush, implicit flush on exit} {exec} { close $f set r } "hello\nbye\nstrange\n" -set path(script2) [makeFile {} script2] -test io-29.33b {TIP#398, no implicit flush of nonblocking on exit} {exec} { - set f [open $path(script) w] - puts $f { - fconfigure stdout -blocking 0 - puts -nonewline stdout [string repeat A 655360] - flush stdout - } - close $f - set f [open $path(script2) w] - puts $f {after 2000} - close $f - set t1 [clock milliseconds] - set ff [open "|[list [interpreter] $path(script2)]" w] - catch {unset ::env(TCL_FLUSH_NONBLOCKING_ON_EXIT)} - exec [interpreter] $path(script) >@ $ff - set t2 [clock milliseconds] - close $ff - expr {($t2-$t1)/2000 ? $t2-$t1 : 0} -} 0 test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} { variable c 0 variable x running @@ -3092,99 +2959,6 @@ test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotM interp delete y } "" -test io-29.36.1 {gets on translation auto with "\r" in QA communication mode, possible regression, bug [b3977d199b]} -constraints { - socket tempNotMac fileevent -} -setup { - set s [open "|[list [interpreter] << { - proc accept {so args} { - fconfigure $so -translation binary - puts -nonewline $so "who are you?\r"; flush $so - set a [gets $so] - puts -nonewline $so "really $a?\r"; flush $so - set a [gets $so] - close $so - set ::done $a - } - set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] - puts [lindex [fconfigure $s -sockname] 2] - foreach c {1 2} { - vwait ::done - puts $::done - } - }]" r] - set c {} - set result {} -} -body { - set port [gets $s] - foreach t {{cr lf} {auto lf}} { - set c [socket 127.0.0.1 $port] - fconfigure $c -buffering line -translation $t - lappend result $t - while {1} { - set q [gets $c] - switch -- $q { - "who are you?" {puts $c "client"} - "really client?" {puts $c "yes"; lappend result $q; break} - default {puts $c "wrong"; lappend result "unexpected input \"$q\""; break} - } - } - lappend result [gets $s] - close $c; set c {} - } - set result -} -cleanup { - close $s - if {$c ne {}} { close $c } - unset -nocomplain s c port t q -} -result [list {cr lf} "really client?" yes {auto lf} "really client?" yes] -test io-29.36.2 {gets on translation auto with "\r\n" in different buffers, bug [b3977d199b]} -constraints { - socket tempNotMac fileevent -} -setup { - set s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] - set c {} -} -body { - set ::cnt 0 - proc accept {so args} { - fconfigure $so -translation binary - puts -nonewline $so "1 line\r" - puts -nonewline $so "\n2 li" - flush $so - # now force separate packets - puts -nonewline $so "ne\r" - flush $so - if {$::cnt & 1} { - vwait ::cli; # simulate short delay (so client can process events, just wait for it) - } else { - # we don't have a delay, so client would get the lines as single chunk - } - # we'll try with "\r" and without "\r" (to cover both branches, where "\r" and "eof" causes exit from [gets] by 3rd line) - puts -nonewline $so "\n3 line" - if {!($::cnt % 3)} { - puts -nonewline $so "\r" - } - flush $so - close $so - } - while {$::cnt < 6} { incr ::cnt - set c [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]] - fconfigure $c -blocking 0 -buffering line -translation auto - fileevent $c readable [list apply {c { - if {[gets $c line] >= 0} { - lappend ::cli <$line> - } elseif {[eof $c]} { - set ::done 1 - } - }} $c] - vwait ::done - close $c; set c {} - } - set ::cli -} -cleanup { - close $s - if {$c ne {}} { close $c } - unset -nocomplain ::done ::cli ::cnt s c -} -result [lrepeat 6 {<1 line>} {<2 line>} {<3 line>}] - # Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read. test io-30.1 {Tcl_Write lf, Tcl_Read lf} { @@ -3257,7 +3031,7 @@ test io-30.6 {Tcl_Write cr, Tcl_Read crlf} { fconfigure $f -translation crlf set x [read $f] close $f - set x + set x } "hello\rthere\rand\rhere\r" test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} { file delete $path(test1) @@ -3358,7 +3132,7 @@ test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} { set c [read $f] close $f string length $c -} [expr {700*15+1}] +} [expr 700*15+1] test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} { file delete $path(test1) set f [open $path(test1) w] @@ -3374,7 +3148,7 @@ test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} { set c [read $f] close $f string length $c -} [expr {700*15+1}] +} [expr 700*15+1] test io-30.15 {Tcl_Write mixed, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] @@ -3395,10 +3169,10 @@ test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -translation lf - puts -nonewline $f hello\nthere\nand\rhere\n\x1A + puts -nonewline $f hello\nthere\nand\rhere\n\x1a close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto set c [read $f] close $f set c @@ -3410,11 +3184,11 @@ here test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation lf puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto set c [read $f] close $f set c @@ -3431,7 +3205,7 @@ test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] @@ -3451,7 +3225,7 @@ test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] @@ -3484,7 +3258,7 @@ test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} { lappend l [eof $f] close $f set l -} "abc def 0 \x1Aghi 0 qrs 0 {} 1" +} "abc def 0 \x1aghi 0 qrs 0 {} 1" test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} { file delete $path(test1) set f [open $path(test1) w] @@ -3496,7 +3270,7 @@ test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} { fconfigure $f -translation cr -eofchar {} set l "" set x [gets $f] - lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"] + lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] @@ -3514,7 +3288,7 @@ test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} { fconfigure $f -translation crlf -eofchar {} set l "" set x [gets $f] - lappend l [string compare $x "abc\ndef\n\x1Aghi\nqrs\n"] + lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"] lappend l [eof $f] lappend l [gets $f] lappend l [eof $f] @@ -3529,7 +3303,7 @@ test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f @@ -3543,7 +3317,7 @@ test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f @@ -3557,7 +3331,7 @@ test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f @@ -3571,7 +3345,7 @@ test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f @@ -3585,7 +3359,7 @@ test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f @@ -3599,7 +3373,7 @@ test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} { puts $f $c close $f set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a set c [string length [read $f]] set e [eof $f] close $f @@ -3847,7 +3621,7 @@ test io-31.13 {binary mode is synonym of lf mode} { } lf # # Test io-9.14 has been removed because "auto" output translation mode is -# not supported. +# not supoprted. # test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} { file delete $path(test1) @@ -3932,7 +3706,7 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] @@ -3947,11 +3721,11 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} { test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation lf puts $f hello\nthere\nand\rhere close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] @@ -3971,7 +3745,8 @@ test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a + fconfigure $f -translation auto set l "" lappend l [gets $f] lappend l [gets $f] @@ -3989,7 +3764,7 @@ test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto set l "" lappend l [gets $f] lappend l [gets $f] @@ -4020,7 +3795,7 @@ test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} { lappend l [eof $f] close $f set l -} "abc def 0 \x1Aqrs 0 tuv 0 {} 1" +} "abc def 0 \x1aqrs 0 tuv 0 {} 1" test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} { file delete $path(test1) set f [open $path(test1) w] @@ -4042,7 +3817,7 @@ test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} { lappend l [eof $f] close $f set l -} "abc def 0 \x1Aqrs 0 tuv 0 {} 1" +} "abc def 0 \x1aqrs 0 tuv 0 {} 1" test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} { file delete $path(test1) set f [open $path(test1) w] @@ -4064,7 +3839,7 @@ test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} { lappend l [eof $f] close $f set l -} "abc def 0 \x1Aqrs 0 tuv 0 {} 1" +} "abc def 0 \x1aqrs 0 tuv 0 {} 1" test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] @@ -4073,7 +3848,7 @@ test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] @@ -4091,7 +3866,7 @@ test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] @@ -4109,7 +3884,7 @@ test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] @@ -4127,7 +3902,7 @@ test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] @@ -4145,7 +3920,7 @@ test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] @@ -4163,7 +3938,7 @@ test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} { puts $f $s close $f set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a set l "" lappend l [gets $f] lappend l [gets $f] @@ -4184,14 +3959,14 @@ test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} { } close $f set f [open $path(test1) r] - fconfigure $f -translation crlf + fconfigure $f -translation crlf set c "" while {[gets $f line] >= 0} { append c $line\n } close $f string length $c -} [expr {700*15+1}] +} [expr 700*15+1] test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} { file delete $path(test1) set f [open $path(test1) w] @@ -4210,7 +3985,7 @@ test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} { } close $f string length $c -} [expr {700*15+1}] +} [expr 700*15+1] # Test Tcl_Read and buffering. @@ -4292,7 +4067,7 @@ test io-32.9 {Tcl_Read, read to end of file} { } set x } ok -test io-32.10 {Tcl_Read from a pipe} stdio { +test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {puts [gets stdin]} @@ -4304,7 +4079,7 @@ test io-32.10 {Tcl_Read from a pipe} stdio { close $f1 set x } "hello\n" -test io-32.11 {Tcl_Read from a pipe} stdio { +test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {puts [gets stdin]} @@ -4323,7 +4098,7 @@ test io-32.11 {Tcl_Read from a pipe} stdio { } {{hello } {hello }} -test io-32.11.1 {Tcl_Read from a pipe} stdio { +test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {chan configure stdout -translation crlf} @@ -4343,7 +4118,7 @@ test io-32.11.1 {Tcl_Read from a pipe} stdio { } {{hello } {hello }} -test io-32.11.2 {Tcl_Read from a pipe} stdio { +test io-32.11.2 {Tcl_Read from a pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {chan configure stdout -translation crlf} @@ -4454,7 +4229,7 @@ test io-33.2 {Tcl_Gets into variable} { close $f1 set z } ok -test io-33.3 {Tcl_Gets from pipe} stdio { +test io-33.3 {Tcl_Gets from pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {puts [gets stdin]} @@ -4484,13 +4259,6 @@ test io-33.4 {Tcl_Gets with long line} { close $f set x } {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ} -set f [open $path(test3) w] -puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" -puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" -puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" -puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" -puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" -close $f test io-33.5 {Tcl_Gets with long line} { set f [open $path(test3)] set x [gets $f y] @@ -4566,29 +4334,29 @@ test io-33.10 {Tcl_Gets, exercising double buffering} { } 300 test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) ....... - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) ....... + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] if {$n > 3} {set n 3} - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } } -body { set c [chan create read [namespace which driver]] @@ -4600,29 +4368,29 @@ test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup { } -result {{} {} {} .......} test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) ....... - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) ....... + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] if {$n > 3} {set n 3} - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } } -body { set c [chan create read [namespace which driver]] @@ -4634,30 +4402,30 @@ test io-33.12 {Tcl_GetsObj, [10dc6daa37]} -setup { } -result {{} {} {} .......} test io-33.13 {Tcl_GetsObj, [10dc6daa37]} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [string repeat \ - [string repeat . 64]\n[string repeat . 25] 2] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - if {$n > 65} {set n 65} - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [string repeat \ + [string repeat . 64]\n[string repeat . 25] 2] + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) + return + } + watch {} + read { + set n [lindex $args 1] + if {$n > 65} {set n 65} + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } } -body { set c [chan create read [namespace which driver]] @@ -4762,7 +4530,7 @@ test io-34.7 {Tcl_Seek to offset from end of file, then to current position} { close $f1 list $c1 $r1 $c2 } {44 rstuv 49} -test io-34.8 {Tcl_Seek on pipes: not supported} stdio { +test io-34.8 {Tcl_Seek on pipes: not supported} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] set x [list [catch {seek $f1 0 current} msg] $msg] close $f1 @@ -4870,13 +4638,13 @@ test io-34.15 {Tcl_Tell combined with seeking} { close $f1 list $c1 $c2 } {10 20} -test io-34.16 {Tcl_Tell on pipe: always -1} stdio { +test io-34.16 {Tcl_Tell on pipe: always -1} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] set c [tell $f1] close $f1 set c } -1 -test io-34.17 {Tcl_Tell on pipe: always -1} stdio { +test io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] puts $f1 {puts hello} flush $f1 @@ -4931,7 +4699,7 @@ test io-34.20 {Tcl_Tell combined with writing} { close $f set l } {29 39 40 447} -test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport extensive} { +test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} { file delete $path(test3) set f [open $path(test3) w] fconfigure $f -encoding binary @@ -4975,7 +4743,7 @@ test io-35.1 {Tcl_Eof} { close $f set x } {0 0 0 0 1 1} -test io-35.2 {Tcl_Eof with pipe} stdio { +test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {gets stdin} @@ -4993,7 +4761,7 @@ test io-35.2 {Tcl_Eof with pipe} stdio { close $f1 set x } {0 0 0 1} -test io-35.3 {Tcl_Eof with pipe} stdio { +test io-35.3 {Tcl_Eof with pipe} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 {gets stdin} @@ -5027,7 +4795,7 @@ test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} { close $f set l } {{} 1} -test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio { +test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio openpipe} { file delete $path(pipe) set f [open $path(pipe) w] puts $f { @@ -5044,12 +4812,12 @@ test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio { test io-35.6 {Tcl_Eof, eof char, lf write, auto read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5058,12 +4826,12 @@ test io-35.6 {Tcl_Eof, eof char, lf write, auto read} { test io-35.7 {Tcl_Eof, eof char, lf write, lf read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5072,12 +4840,12 @@ test io-35.7 {Tcl_Eof, eof char, lf write, lf read} { test io-35.8 {Tcl_Eof, eof char, cr write, auto read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5086,12 +4854,12 @@ test io-35.8 {Tcl_Eof, eof char, cr write, auto read} { test io-35.9 {Tcl_Eof, eof char, cr write, cr read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5100,12 +4868,12 @@ test io-35.9 {Tcl_Eof, eof char, cr write, cr read} { test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5114,12 +4882,12 @@ test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} { test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5134,7 +4902,7 @@ test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5149,7 +4917,7 @@ test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5164,7 +4932,7 @@ test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5179,7 +4947,7 @@ test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5194,7 +4962,7 @@ test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5209,7 +4977,7 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a set l [string length [read $f]] set e [eof $f] close $f @@ -5232,12 +5000,12 @@ test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body { test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1a puts $f abc\ndef close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5246,12 +5014,12 @@ test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body { test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1a puts $f {} close $f set s [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5280,7 +5048,7 @@ test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5295,7 +5063,7 @@ test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} { close $f set c [file size $path(test1)] set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a set l [string length [set in [read $f]]] set e [eof $f] close $f @@ -5304,7 +5072,7 @@ test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} { # Test Tcl_InputBlocked -test io-36.1 {Tcl_InputBlocked on nonblocking pipe} stdio { +test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] puts $f1 {puts hello_from_pipe} flush $f1 @@ -5323,7 +5091,7 @@ test io-36.1 {Tcl_InputBlocked on nonblocking pipe} stdio { close $f1 set x } {{} 1 hello 0 {} 1} -test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio { +test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] chan configure $f1 -encoding binary -translation lf -eofchar {} puts $f1 { @@ -5346,7 +5114,7 @@ test io-36.1.1 {Tcl_InputBlocked on nonblocking binary pipe} stdio { close $f1 set x } {{} 1 hello 0 {} 1} -test io-36.2 {Tcl_InputBlocked on blocking pipe} stdio { +test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} { set f1 [open "|[list [interpreter]]" r+] fconfigure $f1 -buffering line puts $f1 {puts hello_from_pipe} @@ -5378,8 +5146,8 @@ test io-36.3 {Tcl_InputBlocked vs files, short read} { } {0 abc 0 defghijklmnop 0 1} test io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} { proc in {f} { - variable l - variable x + variable l + variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } @@ -5414,8 +5182,8 @@ test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles } {0 abc 0 defghijklmnop 0 1} test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} { proc in {f} { - variable l - variable x + variable l + variable x lappend l [read $f 3] if {[eof $f]} {lappend l eof; close $f; set x done} } @@ -5490,7 +5258,7 @@ test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} { # This test crashes the interp if Bug #427196 is not fixed set chan [open [info script] r] - fconfigure $chan -buffersize 10 -encoding utf-8 + fconfigure $chan -buffersize 10 set var [read $chan 2] fconfigure $chan -buffersize 32 append var [read $chan] @@ -5506,6 +5274,9 @@ test io-39.1 {Tcl_GetChannelOption} { close $f1 set x } 1 +# +# Test 17.2 was removed. +# test io-39.2 {Tcl_GetChannelOption} { file delete $path(test1) set f1 [open $path(test1) w] @@ -5607,7 +5378,7 @@ test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} { close $f1 set x } {1 0 {} {} 0 1} -test io-39.10 {Tcl_SetChannelOption, blocking mode} stdio { +test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} { file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { @@ -5670,45 +5441,38 @@ test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} { test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -encoding {} - puts -nonewline $f \xE7\x89\xA6 + fconfigure $f -encoding {} + puts -nonewline $f \xe7\x89\xa6 close $f set f [open $path(test1) r] fconfigure $f -encoding utf-8 set x [read $f] close $f set x -} 牦 +} \u7266 test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} { file delete $path(test1) set f [open $path(test1) w] fconfigure $f -encoding binary - puts -nonewline $f \xE7\x89\xA6 + puts -nonewline $f \xe7\x89\xa6 close $f set f [open $path(test1) r] fconfigure $f -encoding utf-8 set x [read $f] close $f set x -} 牦 -test io-39.16 {Tcl_SetChannelOption: -encoding (shortened to "-en"), errors} -body { +} \u7266 +test io-39.16 {Tcl_SetChannelOption: -encoding, errors} { file delete $path(test1) set f [open $path(test1) w] - fconfigure $f -en foobar -} -cleanup { + set result [list [catch {fconfigure $f -encoding foobar} msg] $msg] close $f -} -returnCodes 1 -result {unknown encoding "foobar"} -test io-39.16a {Tcl_SetChannelOption: -encoding (invalid shortening to "-e"), errors} -body { - file delete $path(test1) - set f [open $path(test1) w] - fconfigure $f -e foobar -} -cleanup { - close $f -} -returnCodes 1 -match glob -result {bad option "-e": should be one of *} -test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio fileevent} { + set result +} {1 {unknown encoding "foobar"}} +test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio openpipe fileevent} { set f [open "|[list [interpreter] $path(cat)]" r+] fconfigure $f -encoding binary - puts -nonewline $f "\xE7" + puts -nonewline $f "\xe7" flush $f fconfigure $f -encoding utf-8 -blocking 0 variable x {} @@ -5726,7 +5490,7 @@ test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} vwait [namespace which -variable x] close $f set x -} "{} timeout {} timeout \xE7 timeout" +} "{} timeout {} timeout \xe7 timeout" test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \ {socket} { proc accept {s a p} {close $s} @@ -5779,32 +5543,32 @@ test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \ close $s2 set modes } {auto crlf} -test io-39.22 {Tcl_SetChannelOption, invariance} -constraints {unix} -body { +test io-39.22 {Tcl_SetChannelOption, invariance} {unix} { file delete $path(test1) set f1 [open $path(test1) w+] set l "" lappend l [fconfigure $f1 -eofchar] fconfigure $f1 -eofchar {ON GO} lappend l [fconfigure $f1 -eofchar] - fconfigure $f1 -eofchar {D D} + fconfigure $f1 -eofchar D lappend l [fconfigure $f1 -eofchar] close $f1 set l -} -result {{{} {}} {O G} {D D}} -test io-39.22a {Tcl_SetChannelOption, invariance} -body { +} {{{} {}} {O G} {D D}} +test io-39.22a {Tcl_SetChannelOption, invariance} { file delete $path(test1) set f1 [open $path(test1) w+] set l [list] fconfigure $f1 -eofchar {ON GO} lappend l [fconfigure $f1 -eofchar] - fconfigure $f1 -eofchar {D D} + fconfigure $f1 -eofchar D lappend l [fconfigure $f1 -eofchar] lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg] close $f1 set l -} -result {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} +} {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}} test io-39.23 {Tcl_GetChannelOption, server socket is not readable or - writable, it should still have valid -eofchar and -translation options } { + writeable, it should still have valid -eofchar and -translation options } { set l [list] set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation] @@ -5812,7 +5576,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or set l } {{{}} auto} test io-39.24 {Tcl_SetChannelOption, server socket is not readable or - writable so we can't change -eofchar or -translation } { + writable so we can't change -eofchar or -translation } { set l [list] set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0] fconfigure $sock -eofchar D -translation lf @@ -5836,11 +5600,11 @@ test io-40.1 {POSIX open access modes: RDWR} { close $f set x } {zzy abzzy} -test io-40.2 {POSIX open access modes: CREAT} {unix notWsl} { +test io-40.2 {POSIX open access modes: CREAT} {unix} { file delete $path(test3) 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%o" [expr $stats(mode)&0o777]] puts $f "line 1" close $f set f [open $path(test3) r] @@ -5848,14 +5612,14 @@ test io-40.2 {POSIX open access modes: CREAT} {unix notWsl} { close $f set x } {0o600 {line 1}} -test io-40.3 {POSIX open access modes: CREAT} {unix umask notWsl} { +test io-40.3 {POSIX open access modes: CREAT} {unix umask} { # This test only works if your umask is 2, like ouster's. file delete $path(test3) set f [open $path(test3) {WRONLY CREAT}] close $f file stat $path(test3) stats - format 0o%03o [expr {$stats(mode)&0o777}] -} [format 0o%03o [expr {0o666 & ~ $umaskValue}]] + format "0%o" [expr $stats(mode)&0o777] +} [format %04o [expr {0o666 & ~ $umaskValue}]] test io-40.4 {POSIX open access modes: CREAT} { file delete $path(test3) set f [open $path(test3) w] @@ -6029,11 +5793,11 @@ test io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} { } {{first script} {new script} {yet another} {}} test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} { set result {} - fileevent $f r "first scr\x00ipt" + fileevent $f r "first scr\0ipt" lappend result [string length [fileevent $f readable]] - fileevent $f r "new scr\x00ipt" + fileevent $f r "new scr\0ipt" lappend result [string length [fileevent $f readable]] - fileevent $f r "yet ano\x00ther" + fileevent $f r "yet ano\0ther" lappend result [string length [fileevent $f readable]] fileevent $f r "" lappend result [fileevent $f readable] @@ -6054,7 +5818,7 @@ test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs f test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] -} -constraints {stdio unixExecs fileevent} -body { +} -constraints {stdio unixExecs fileevent openpipe} -body { set result {} lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r] fileevent $f r "read f" @@ -6075,7 +5839,7 @@ test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup { test io-44.1 {FileEventProc procedure: normal read event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] -} -constraints {stdio unixExecs fileevent} -body { +} -constraints {stdio unixExecs fileevent openpipe} -body { fileevent $f2 readable [namespace code { set x [gets $f2]; fileevent $f2 readable {} }] @@ -6088,7 +5852,7 @@ test io-44.1 {FileEventProc procedure: normal read event} -setup { catch {close $f3} } -result {text} test io-44.2 {FileEventProc procedure: error in read event} -constraints { - stdio unixExecs fileevent + stdio unixExecs fileevent openpipe } -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] @@ -6111,7 +5875,7 @@ test io-44.2 {FileEventProc procedure: error in read event} -constraints { test io-44.3 {FileEventProc procedure: normal write event} -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] -} -constraints {stdio unixExecs fileevent} -body { +} -constraints {stdio unixExecs fileevent openpipe} -body { fileevent $f2 writable [namespace code { lappend x "triggered" incr count -1 @@ -6130,7 +5894,7 @@ test io-44.3 {FileEventProc procedure: normal write event} -setup { catch {close $f3} } -result {initial triggered triggered triggered} test io-44.4 {FileEventProc procedure: eror in write event} -constraints { - stdio unixExecs fileevent + stdio unixExecs fileevent openpipe } -setup { set f2 [open "|[list cat -u]" r+] set f3 [open "|[list cat -u]" r+] @@ -6149,9 +5913,7 @@ test io-44.4 {FileEventProc procedure: eror in write event} -constraints { catch {close $f2} catch {close $f3} } -result {bad-write {}} -test io-44.5 {FileEventProc procedure: end of file} -constraints { - stdio unixExecs fileevent -} -body { +test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} { set f4 [open "|[list [interpreter] $path(cat) << foo]" r] fileevent $f4 readable [namespace code { if {[gets $f4 line] < 0} { @@ -6164,76 +5926,11 @@ test io-44.5 {FileEventProc procedure: end of file} -constraints { variable x initial vwait [namespace which -variable x] vwait [namespace which -variable x] - set x -} -cleanup { close $f4 -} -result {initial foo eof} + set x +} {initial foo eof} close $f - -test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup { -} -constraints {stdio fileevent openpipe} -body { - - namespace eval refchan { - namespace ensemble create - namespace export * - - - proc finalize {chan args} { - namespace delete c_$chan - } - - proc initialize {chan args} { - namespace eval c_$chan {} - namespace upvar c_$chan watching watching - set watching {} - list finalize initialize seek watch write - } - - - proc watch {chan args} { - namespace upvar c_$chan watching watching - foreach arg $args { - switch $arg { - write { - if {$arg ni $watching} { - lappend watching $arg - } - chan postevent $chan $arg - } - } - } - } - - - proc write {chan args} { - chan postevent $chan write - return 1 - } - } - set f [chan create w [namespace which refchan]] - chan configure $f -blocking 0 - set data "some data" - set x 0 - chan event $f writable [namespace code { - puts $f $data - incr count [string length $data] - if {$count > 262144} { - chan event $f writable {} - set x done - } - }] - set token [after 10000 [namespace code { - set x timeout - }]] - vwait [namespace which -variable x] - return $x -} -cleanup { - after cancel $token - catch {chan close $f} -} -result done - - makeFile "foo bar" foo test io-45.1 {DeleteFileEvent, cleanup on close} {fileevent} { @@ -6290,7 +5987,7 @@ test io-45.3 {DeleteFileEvent, cleanup on close} {fileevent} { # Execute these tests only if the "testfevent" command is present. -test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent notOSX} { +test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} { testfevent create set script "set f \[[list open $path(foo) r]]\n" append script { @@ -6300,33 +5997,32 @@ test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent not fileevent $f readable {} }] } - set timer [after 10 lappend x timeout] testfevent cmd $script - vwait x - after cancel $timer + after 1 ;# We must delay because Windows takes a little time to notice + update testfevent cmd {close $f} list [testfevent cmd {set x}] [testfevent cmd {info commands after}] } {{f triggered: foo bar} after} test io-46.2 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { - variable x 0 - after 100 {set x triggered} - vwait [namespace which -variable x] - set x + variable x 0 + after 100 {set x triggered} + vwait [namespace which -variable x] + set x } } {triggered} test io-46.3 {Tcl event loop vs multiple interpreters} testfevent { testfevent create testfevent cmd { - set x 0 - after 10 {lappend x timer} - after 30 - set result $x - update idletasks - lappend result $x - update - lappend result $x + set x 0 + after 10 {lappend x timer} + after 30 + set result $x + update idletasks + lappend result $x + update + lappend result $x } } {0 0 {0 timer}} @@ -6343,7 +6039,7 @@ test io-47.1 {fileevent vs multiple interpreters} {testfevent fileevent} { lappend x [fileevent $f2 readable] testfevent delete lappend x [fileevent $f readable] [fileevent $f2 readable] \ - [fileevent $f3 readable] + [fileevent $f3 readable] close $f close $f2 close $f3 @@ -6359,11 +6055,11 @@ test io-47.2 {deleting fileevent on interpreter delete} {testfevent fileevent} { testfevent share $f2 testfevent share $f3 testfevent cmd "fileevent $f2 readable {script 2} - fileevent $f3 readable {script 3}" + fileevent $f3 readable {script 3}" fileevent $f4 readable {script 4} testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ - [fileevent $f3 readable] [fileevent $f4 readable]] + [fileevent $f3 readable] [fileevent $f4 readable]] close $f close $f2 close $f3 @@ -6381,10 +6077,10 @@ test io-47.3 {deleting fileevent on interpreter delete} {testfevent fileevent} { fileevent $f readable {script 1} fileevent $f2 readable {script 2} testfevent cmd "fileevent $f3 readable {script 3} - fileevent $f4 readable {script 4}" + fileevent $f4 readable {script 4}" testfevent delete set x [list [fileevent $f readable] [fileevent $f2 readable] \ - [fileevent $f3 readable] [fileevent $f4 readable]] + [fileevent $f3 readable] [fileevent $f4 readable]] close $f close $f2 close $f3 @@ -6400,8 +6096,8 @@ test io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent $f readable {script 2} fileevent $f2 readable {script 3} set x [list [fileevent $f2 readable] \ - [testfevent cmd "fileevent $f readable"] \ - [fileevent $f readable]] + [testfevent cmd "fileevent $f readable"] \ + [fileevent $f readable]] testfevent delete close $f close $f2 @@ -6415,7 +6111,7 @@ test io-47.5 {file events on shared files, deleting file events} {testfevent fil fileevent $f readable {script 2} testfevent cmd "fileevent $f readable {}" set x [list [testfevent cmd "fileevent $f readable"] \ - [fileevent $f readable]] + [fileevent $f readable]] testfevent delete close $f set x @@ -6428,13 +6124,11 @@ test io-47.6 {file events on shared files, deleting file events} {testfevent fil fileevent $f readable {script 2} fileevent $f readable {} set x [list [testfevent cmd "fileevent $f readable"] \ - [fileevent $f readable]] + [fileevent $f readable]] testfevent delete close $f set x } {{script 1} {}} -unset path(foo) -removeFile foo set path(bar) [makeFile {} bar] @@ -6492,7 +6186,7 @@ test io-48.2 {testing readability conditions} {nonBlockFiles fileevent} { list $x $l } {done {called called called called called called called}} set path(my_script) [makeFile {} my_script] -test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles fileevent} { +test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles openpipe fileevent} { set f [open $path(bar) w] puts $f abcdefg puts $f abcdefg @@ -6537,9 +6231,6 @@ test io-48.3 {testing readability conditions} {stdio unix nonBlockFiles fileeven close $f list $x $l } {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}} -unset path(bar) -removeFile bar - test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} { file delete $path(test1) set f [open $path(test1) w] @@ -6562,7 +6253,7 @@ test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6590,7 +6281,7 @@ test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {file set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6618,7 +6309,7 @@ test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6646,7 +6337,7 @@ test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {file set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6674,7 +6365,7 @@ test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} { set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -translation auto -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6702,7 +6393,7 @@ test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fi set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation auto -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation auto fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6730,7 +6421,7 @@ test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation lf fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6758,7 +6449,7 @@ test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fil set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation lf -eofchar "\x1A \x1A" + fconfigure $f -translation lf -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6786,7 +6477,7 @@ test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation cr fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6814,7 +6505,7 @@ test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fil set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation cr -eofchar "\x1A \x1A" + fconfigure $f -translation cr -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6842,7 +6533,7 @@ test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {f set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -eofchar \x1a -translation crlf fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6870,7 +6561,7 @@ test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {filee set c 0 set l "" set f [open $path(test1) r] - fconfigure $f -translation crlf -eofchar "\x1A \x1A" + fconfigure $f -translation crlf -eofchar \x1a fileevent $f readable [namespace code [list consume $f]] variable x vwait [namespace which -variable x] @@ -6990,57 +6681,47 @@ test io-49.5 {testing crlf reading, leftover cr disgorgment} { set l } [list 7 a\rb\rc 7 {} 7 1] -test io-50.1 {testing handler deletion} -constraints {testchannelevent testservicemode} -setup { +test io-50.1 {testing handler deletion} {testchannelevent} { file delete $path(test1) -} -body { set f [open $path(test1) w] close $f - update + 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 delete 0 } set z not_called - set timer [after 50 lappend z timeout] - testservicemode 0 - set f [open $path(test1) r] - testchannelevent $f add readable [namespace code [list delhandler $f]] - testservicemode 1 - vwait z - after cancel $timer - set z -} -cleanup { + update close $f -} -result called -test io-50.2 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup { + set z +} called +test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} { file delete $path(test1) -} -body { set f [open $path(test1) w] close $f + set f [open $path(test1) r] + testchannelevent $f add readable [namespace code [list delhandler $f 1]] + testchannelevent $f add readable [namespace code [list delhandler $f 0]] proc delhandler {f i} { variable z - lappend z "called delhandler $i" + lappend z "called delhandler $f $i" testchannelevent $f delete 0 } set z "" - testservicemode 0 - set f [open $path(test1) r] - testchannelevent $f add readable [namespace code [list delhandler $f 1]] - testchannelevent $f add readable [namespace code [list delhandler $f 0]] - testservicemode 1 - set timer [after 50 lappend z timeout] - vwait z - after cancel $timer - set z -} -cleanup { + update close $f -} -result {{called delhandler 0} {called delhandler 1}} -test io-50.3 {testing handler deletion with multiple handlers} -constraints {testchannelevent testservicemode} -setup { + string compare [string tolower $z] \ + [list [list called delhandler $f 0] [list called delhandler $f 1]] +} 0 +test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} { file delete $path(test1) -} -body { set f [open $path(test1) w] close $f + set f [open $path(test1) r] + testchannelevent $f add readable [namespace code [list notcalled $f 1]] + testchannelevent $f add readable [namespace code [list delhandler $f 0]] set z "" proc notcalled {f i} { variable z @@ -7049,30 +6730,23 @@ test io-50.3 {testing handler deletion with multiple handlers} -constraints {tes proc delhandler {f i} { variable z testchannelevent $f delete 1 - lappend z "delhandler $i called" + lappend z "delhandler $f $i called" testchannelevent $f delete 0 - lappend z "delhandler $i deleted myself" + lappend z "delhandler $f $i deleted myself" } set z "" - testservicemode 0 - set f [open $path(test1) r] - testchannelevent $f add readable [namespace code [list notcalled $f 1]] - testchannelevent $f add readable [namespace code [list delhandler $f 0]] - testservicemode 1 - set timer [after 50 lappend z timeout] - vwait z - after cancel $timer - set z -} -cleanup { + update close $f -} -result {{delhandler 0 called} {delhandler 0 deleted myself}} -test io-50.4 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup { + string compare [string tolower $z] \ + [list [list delhandler $f 0 called] \ + [list delhandler $f 0 deleted myself]] +} 0 +test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} { file delete $path(test1) - update -} -body { set f [open $path(test1) w] close $f - update + set f [open $path(test1) r] + testchannelevent $f add readable [namespace code [list delrecursive $f]] proc delrecursive {f} { variable z variable u @@ -7087,22 +6761,18 @@ test io-50.4 {testing handler deletion vs reentrant calls} -constraints {testcha } variable u toplevel variable z "" - testservicemode 0 - set f [open $path(test1) r] - testchannelevent $f add readable [namespace code [list delrecursive $f]] - testservicemode 1 - set timer [after 50 lappend z timeout] - vwait z - after cancel $timer - set z -} -cleanup { + update close $f -} -result {{delrecursive calling recursive} {delrecursive deleting recursive}} -test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode notOSX} -setup { + string compare [string tolower $z] \ + {{delrecursive calling recursive} {delrecursive deleting recursive}} +} 0 +test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} { file delete $path(test1) -} -body { set f [open $path(test1) w] close $f + set f [open $path(test1) r] + testchannelevent $f add readable [namespace code [list notcalled $f]] + testchannelevent $f add readable [namespace code [list del $f]] proc notcalled {f} { variable z lappend z "notcalled was called!! $f" @@ -7112,50 +6782,39 @@ test io-50.5 {testing handler deletion vs reentrant calls} -constraints {testcha variable z if {"$u" == "recursive"} { testchannelevent $f delete 1 - lappend z "del deleted notcalled" testchannelevent $f delete 0 + lappend z "del deleted notcalled" lappend z "del deleted myself" } else { set u recursive lappend z "del calling recursive" - set timer [after 50 lappend z timeout] - vwait z - after cancel $timer - lappend z "del after recursive" + update + lappend z "del after update" } } set z "" set u toplevel - testservicemode 0 - set f [open $path(test1) r] - testchannelevent $f add readable [namespace code [list notcalled $f]] - testchannelevent $f add readable [namespace code [list del $f]] - testservicemode 1 - set timer [after 50 set z timeout] - vwait z - after cancel $timer - set z -} -cleanup { + update close $f -} -result [list {del calling recursive} {del deleted notcalled} \ - {del deleted myself} {del after recursive}] -test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testchannelevent testservicemode} -setup { + string compare [string tolower $z] \ + [list {del calling recursive} {del deleted notcalled} \ + {del deleted myself} {del after update}] +} 0 +test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} { file delete $path(test1) -} -body { set f [open $path(test1) w] close $f + set f [open $path(test1) r] + testchannelevent $f add readable [namespace code [list second $f]] + testchannelevent $f add readable [namespace code [list first $f]] proc first {f} { variable u variable z - variable done if {"$u" == "toplevel"} { lappend z "first called" set u first - set timer [after 50 lappend z timeout] - vwait z - after cancel $timer - lappend z "first after toplevel" - set done 1 + update + lappend z "first after update" } else { lappend z "first called not toplevel" } @@ -7177,24 +6836,14 @@ test io-50.6 {testing handler deletion vs reentrant calls} -constraints {testcha } set z "" set u toplevel - set done 0 - testservicemode 0 - set f [open $path(test1) r] - testchannelevent $f add readable [namespace code [list second $f]] - testchannelevent $f add readable [namespace code [list first $f]] - testservicemode 1 update - if {!$done} { - set timer2 [after 200 set done 1] - vwait done - after cancel $timer2 - } - set z -} -cleanup { close $f -} -result [list {first called} {first called not toplevel} \ - {second called, first time} {second called, second time} \ - {first after toplevel}] + string compare [string tolower $z] \ + [list {first called} {first called not toplevel} \ + {second called, first time} {second called, second time} \ + {first after update}] +} 0 + test io-51.1 {Test old socket deletion on Macintosh} {socket} { set x 0 set result "" @@ -7262,8 +6911,8 @@ test io-52.3 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 - fconfigure $f2 -translation cr -encoding iso8859-1 -blocking 0 + fconfigure $f1 -translation lf -blocking 0 + fconfigure $f2 -translation cr -blocking 0 set s0 [fcopy $f1 $f2] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 @@ -7271,7 +6920,7 @@ test io-52.3 {TclCopyChannel} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7303,8 +6952,8 @@ test io-52.5 {TclCopyChannel, all} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 - fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f1 -translation lf -blocking 0 + fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified. set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 @@ -7312,7 +6961,7 @@ test io-52.5 {TclCopyChannel, all} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7320,8 +6969,8 @@ test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 - fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f1 -translation lf -blocking 0 + fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 @@ -7329,16 +6978,16 @@ test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} -test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} { +test io-52.5b {TclCopyChannel, all, wrapped to negative value} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 - fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f1 -translation lf -blocking 0 + fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 @@ -7346,7 +6995,7 @@ test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7354,16 +7003,16 @@ test io-52.6 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 - fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 - set s0 [fcopy $f1 $f2 -size [expr {[file size $thisScript] + 5}]] + fconfigure $f1 -translation lf -blocking 0 + fconfigure $f2 -translation lf -blocking 0 + set s0 [fcopy $f1 $f2 -size [expr [file size $thisScript] + 5]] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] close $f1 close $f2 set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { - lappend result ok + lappend result ok } set result } {0 0 ok} @@ -7371,8 +7020,8 @@ test io-52.7 {TclCopyChannel} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 - fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0 + fconfigure $f1 -translation lf -blocking 0 + fconfigure $f2 -translation lf -blocking 0 fcopy $f1 $f2 set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] set s1 [file size $thisScript] @@ -7380,11 +7029,11 @@ test io-52.7 {TclCopyChannel} {fcopy} { close $f1 close $f2 if {"$s1" == "$s2"} { - lappend result ok + lappend result ok } set result } {0 0 ok} -test io-52.8 {TclCopyChannel} {stdio fcopy} { +test io-52.8 {TclCopyChannel} {stdio openpipe fcopy} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] @@ -7417,7 +7066,7 @@ set path(utf8-rp.txt) [makeFile {} utf8-rp.txt] # Create kyrillic file, use lf translation to avoid os eol issues set out [open $path(kyrillic.txt) w] fconfigure $out -encoding koi8-r -translation lf -puts $out "АА" +puts $out "\u0410\u0410" close $out test io-52.9 {TclCopyChannel & encodings} {fcopy} { # Copy kyrillic to UTF-8, using fcopy. @@ -7449,7 +7098,7 @@ test io-52.9 {TclCopyChannel & encodings} {fcopy} { [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} -test io-52.10 {TclCopyChannel & encodings} -constraints {fcopy notWinCI} -body { +test io-52.10 {TclCopyChannel & encodings} {fcopy} { # encoding to binary (=> implies that the # internal utf-8 is written) @@ -7461,18 +7110,12 @@ test io-52.10 {TclCopyChannel & encodings} -constraints {fcopy notWinCI} -body { fconfigure $out -translation binary fcopy $in $out - - file size $path(utf8-fcopy.txt) -} -cleanup { close $in close $out -} -result 5 -test io-52.11 {TclCopyChannel & encodings} -setup { - set out [open $path(utf8-fcopy.txt) w] - fconfigure $out -encoding utf-8 -translation lf - puts $out "АА" - close $out -} -constraints {fcopy} -body { + + file size $path(utf8-fcopy.txt) +} 5 +test io-52.11 {TclCopyChannel & encodings} {fcopy} { # binary to encoding => the input has to be # in utf-8 to make sense to the encoder @@ -7488,7 +7131,7 @@ test io-52.11 {TclCopyChannel & encodings} -setup { close $out file size $path(kyrillic.txt) -} -result 3 +} 3 test io-52.12 {coverage of -translation auto} { file delete $path(test1) $path(test2) @@ -7633,155 +7276,6 @@ test io-52.19 {coverage of eofChar handling} { close $out file size $path(test2) } 8 -test io-52.20 {TclCopyChannel & encodings} -setup { - set out [open $path(utf8-fcopy.txt) w] - fconfigure $out -encoding utf-8 -translation lf - puts $out "Á" - close $out -} -constraints {fcopy} -body { - # binary to encoding => the input has to be - # in utf-8 to make sense to the encoder - - set in [open $path(utf8-fcopy.txt) r] - set out [open $path(kyrillic.txt) w] - - # Using "-encoding ascii" means reading the "Á" gives an error - fconfigure $in -encoding ascii -profile strict - fconfigure $out -encoding koi8-r -translation lf - - fcopy $in $out -} -cleanup { - close $in - close $out -} -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character} - -test io-52.20.2 {TclCopyChannel & encoding error on same encoding} -setup { - set out [open $path(utf8-fcopy.txt) w] - fconfigure $out -encoding utf-8 -translation lf - puts $out "AÁ" - close $out -} -constraints {fcopy} -body { - # binary to encoding => the input has to be - # in utf-8 to make sense to the encoder - - set in [open $path(utf8-fcopy.txt) r] - set out [open $path(kyrillic.txt) w] - - # Using "-encoding ascii" means reading the "Á" gives an error - fconfigure $in -encoding ascii -profile strict - fconfigure $out -encoding ascii -translation lf - - fcopy $in $out -} -cleanup { - close $in - close $out -} -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character} - -test io-52.21 {TclCopyChannel & encodings} -setup { - set out [open $path(utf8-fcopy.txt) w] - fconfigure $out -encoding utf-8 -translation lf - puts $out "Á" - close $out -} -constraints {fcopy} -body { - # binary to encoding => the input has to be - # in utf-8 to make sense to the encoder - - set in [open $path(utf8-fcopy.txt) r] - set out [open $path(kyrillic.txt) w] - - # Using "-encoding ascii" means writing the "Á" gives an error - fconfigure $in -encoding utf-8 - fconfigure $out -encoding ascii -translation lf -profile strict - - fcopy $in $out -} -cleanup { - close $in - close $out -} -returnCodes 1 -match glob -result {error writing "file*": invalid or incomplete multibyte or wide character} - -test io-52.22 {TclCopyChannel & encodings} -setup { - set out [open $path(utf8-fcopy.txt) w] - fconfigure $out -encoding utf-8 -translation lf - puts $out "Á" - close $out -} -constraints {fcopy} -body { - # binary to encoding => the input has to be - # in utf-8 to make sense to the encoder - - set in [open $path(utf8-fcopy.txt) r] - set out [open $path(kyrillic.txt) w] - - # Using "-encoding ascii" means reading the "Á" gives an error - fconfigure $in -encoding ascii -profile strict - fconfigure $out -encoding koi8-r -translation lf - proc ::xxx args { - set ::s0 $args - } - - fcopy $in $out -command ::xxx - vwait ::s0 - set ::s0 -} -cleanup { - close $in - close $out - unset ::s0 -} -match glob -result {0 {error reading "file*": invalid or incomplete multibyte or wide character}} - -test io-52.22.1 {TclCopyChannel & encodings & tell position} -setup { - set out [open $path(utf8-fcopy.txt) w] - fconfigure $out -encoding utf-8 -translation lf - puts $out "AÁ" - close $out -} -constraints {fcopy} -body { - # binary to encoding => the input has to be - # in utf-8 to make sense to the encoder - - set in [open $path(utf8-fcopy.txt) r] - set out [open $path(kyrillic.txt) w] - - # Using "-encoding ascii" means reading the "Á" gives an error - fconfigure $in -encoding ascii -profile strict - fconfigure $out -encoding koi8-r -translation lf - proc ::xxx args { - set ::s0 $args - } - - fcopy $in $out -command ::xxx - vwait ::s0 - list [tell $in] [tell $out] {*}[set ::s0] -} -cleanup { - close $in - close $out - unset ::s0 -} -match glob -result {1 1 1 {error reading "file*": invalid or incomplete multibyte or wide character}} - -test io-52.23 {TclCopyChannel & encodings} -setup { - set out [open $path(utf8-fcopy.txt) w] - fconfigure $out -encoding utf-8 -translation lf - puts $out "Á" - close $out -} -constraints {fcopy} -body { - # binary to encoding => the input has to be - # in utf-8 to make sense to the encoder - - set in [open $path(utf8-fcopy.txt) r] - set out [open $path(kyrillic.txt) w] - - # Using "-encoding ascii" means writing the "Á" gives an error - fconfigure $in -encoding utf-8 - fconfigure $out -encoding ascii -translation lf -profile strict - proc ::xxx args { - set ::s0 $args - } - - fcopy $in $out -command ::xxx - vwait ::s0 - set ::s0 -} -cleanup { - close $in - close $out - unset ::s0 -} -match glob -result {0 {error writing "file*": invalid or incomplete multibyte or wide character}} test io-53.1 {CopyData} {fcopy} { file delete $path(test1) @@ -7799,8 +7293,8 @@ test io-53.2 {CopyData} {fcopy} { file delete $path(test1) set f1 [open $thisScript] set f2 [open $path(test1) w] - fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0 - fconfigure $f2 -translation cr -encoding iso8859-1 -blocking 0 + fconfigure $f1 -translation lf -blocking 0 + fconfigure $f2 -translation cr -blocking 0 fcopy $f1 $f2 -command [namespace code {set s0}] set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]] variable s0 @@ -7810,11 +7304,11 @@ test io-53.2 {CopyData} {fcopy} { set s1 [file size $thisScript] set s2 [file size $path(test1)] if {("$s1" == "$s2") && ($s0 == $s1)} { - lappend result ok + lappend result ok } set result } {0 0 ok} -test io-53.3 {CopyData: background read underflow} {stdio unix fcopy} { +test io-53.3 {CopyData: background read underflow} {stdio unix openpipe fcopy} { file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] @@ -7846,18 +7340,23 @@ test io-53.3 {CopyData: background read underflow} {stdio unix fcopy} { close $f set result } "ready line1 line2 {done\n}" -test io-53.4 {CopyData: background write overflow} {stdio fileevent fcopy} { +test io-53.4 {CopyData: background write overflow} {stdio unix openpipe fileevent fcopy} { set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n variable x for {set x 0} {$x < 12} {incr x} { append big $big } +# file delete $path(test1) file delete $path(pipe) set f1 [open $path(pipe) w] puts $f1 { puts ready fcopy stdin stdout -command { set x } vwait x +# set f [open $path(test1) w] +# fconfigure $f -translation lf +# puts $f "done" +# close $f } close $f1 set f1 [open "|[list [interpreter] $path(pipe)]" r+] @@ -7865,6 +7364,7 @@ test io-53.4 {CopyData: background write overflow} {stdio fileevent fcopy} { fconfigure $f1 -blocking 0 puts $f1 $big flush $f1 + after 500 set result "" fileevent $f1 read [namespace code { append result [read $f1 1024] @@ -7928,18 +7428,16 @@ test io-53.5 {CopyData: error during fcopy} {socket fcopy} { set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]] catch {unset fcopyTestDone} close $listen ;# This means the socket open never really succeeds - fconfigure $in -encoding utf-8 - fconfigure $out -encoding utf-8 fcopy $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. } close $in close $out set fcopyTestDone ;# 1 for error condition } 1 -test io-53.6 {CopyData: error during fcopy} {stdio fcopy} { +test io-53.6 {CopyData: error during fcopy} {stdio openpipe fcopy} { variable fcopyTestDone file delete $path(pipe) file delete $path(test1) @@ -7951,7 +7449,7 @@ test io-53.6 {CopyData: error during fcopy} {stdio fcopy} { set out [open $path(test1) w] fcopy $in $out -command [namespace code FcopyTestDone] variable fcopyTestDone - if {![info exists fcopyTestDone]} { + if ![info exists fcopyTestDone] { vwait [namespace which -variable fcopyTestDone] } catch {close $in} @@ -7967,12 +7465,12 @@ proc doFcopy {in out {bytes 0} {error {}}} { } elseif {[eof $in]} { set fcopyTestDone 0 } else { - # Delay next fcopy to wait for size>0 input bytes - after 100 [list fcopy $in $out -size 1000 \ + # Delay next fcopy to wait for size>0 input bytes + after 100 [list fcopy $in $out -size 1000 \ -command [namespace code [list doFcopy $in $out]]] } } -test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} { +test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} { variable fcopyTestDone file delete $path(pipe) catch {unset fcopyTestDone} @@ -7983,9 +7481,9 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} { proc Write {count} { puts -nonewline "1234567890" if {[incr count -1]} { - after 10 [list Write $count] + after 10 [list Write $count] } else { - set ::ready 1 + set ::ready 1 } } fconfigure stdout -buffering none @@ -7998,13 +7496,13 @@ test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio fcopy} { set out [open $path(test1) w] doFcopy $in $out variable fcopyTestDone - if {![info exists fcopyTestDone]} { + if ![info exists fcopyTestDone] { vwait [namespace which -variable fcopyTestDone] } catch {close $in} close $out # -1=error 0=script error N=number of bytes - expr {($fcopyTestDone == 0) ? $fcopyTestCount : -1} + expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1 } {3450} test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { # copy progress callback. errors out intentionally @@ -8024,7 +7522,7 @@ test io-53.8 {CopyData: async callback and error handling, Bug 1932639} -setup { # Channels to copy between set f [open $foo r] ; fconfigure $f -translation binary set g [open $bar w] ; fconfigure $g -translation binary -buffering none -} -constraints {stdio fcopy} -body { +} -constraints {stdio openpipe fcopy} -body { # Record input size, so that result is always defined lappend ::RES [file size $bar] # Run the copy. Should not invoke -command now. @@ -8065,7 +7563,7 @@ test io-53.8a {CopyData: async callback and error handling, Bug 1932639, at eof} # Channels to copy between set f [open $foo r] ; fconfigure $f -translation binary set g [open $bar w] ; fconfigure $g -translation binary -buffering none -} -constraints {stdio fcopy} -body { +} -constraints {stdio openpipe fcopy} -body { # Initialize and force eof on the input. seek $f 0 end ; read $f 1 set ::RES [eof $f] @@ -8105,7 +7603,7 @@ test io-53.8b {CopyData: async callback and -size 0} -setup { # Channels to copy between set f [open $foo r] ; fconfigure $f -translation binary set g [open $bar w] ; fconfigure $g -translation binary -buffering none -} -constraints {stdio fcopy} -body { +} -constraints {stdio openpipe fcopy} -body { set ::RES {} # Run the copy. Should not invoke -command now. fcopy $f $g -size 0 -command ::cmd @@ -8162,7 +7660,7 @@ test io-53.9 {CopyData: -size and event interaction, Bug 780533} -setup { } set ::forever {} set out [open $out w] -} -constraints {stdio fcopy} -body { +} -constraints {stdio openpipe fcopy} -body { fcopy $pipe $out -size 6 -command ::done set token [after 5000 { set ::forever {fcopy hangs} @@ -8212,28 +7710,27 @@ test io-53.10 {Bug 1350564, multi-directional fcopy} -setup { } puts stderr SRV set l {} - set srv [socket -server new -myaddr 127.0.0.1 0] - set port [lindex [fconfigure $srv -sockname] 2] + set srv [socket -server new 9999] puts stderr WAITING fileevent stdin readable bye - puts "OK $port" + puts OK vwait forever } # wait for OK from server. - lassign [gets $pipe] ok port + gets $pipe # Now the two clients. proc ::done {sock} { if {[eof $sock]} { close $sock ; return } lappend ::forever [gets $sock] return } - set a [socket 127.0.0.1 $port] - set b [socket 127.0.0.1 $port] + set a [socket 127.0.0.1 9999] + set b [socket 127.0.0.1 9999] fconfigure $a -translation binary -buffering none fconfigure $b -translation binary -buffering none fileevent $a readable [list ::done $a] fileevent $b readable [list ::done $b] -} -constraints {stdio fcopy} -body { +} -constraints {stdio openpipe fcopy} -body { # Now pass data through the server in both directions. set ::forever {} puts $a AB @@ -8281,68 +7778,26 @@ test io-53.11 {Bug 2895565} -setup { removeFile out removeFile in } -result {40 bytes copied} -test io-53.12.0 {CopyData: foreground short reads, aka bug 3096275} {stdio unix fcopy} { - file delete $path(pipe) - set f1 [open $path(pipe) w] - puts -nonewline $f1 { - fconfigure stdin -translation binary -blocking 0 - fconfigure stdout -buffering none -translation binary - fcopy stdin stdout - } - close $f1 - set f1 [open "|[list [interpreter] $path(pipe)]" r+] - fconfigure $f1 -translation binary -buffering none - puts -nonewline $f1 A - after 2000 {set ::done timeout} - fileevent $f1 readable {set ::done ok} - vwait ::done - set ch [read $f1 1] - close $f1 - list $::done $ch -} {ok A} -test io-53.12.1 { - Issue 9ca87e6286262a62. - CopyData: foreground short reads via ReadChars(). - Related to report 3096275 for ReadBytes(). - - Prior to the fix this test waited forever for read() to return. -} {stdio unix fcopy} { - file delete $path(output) - set f1 [open $path(output) w] - puts -nonewline $f1 { - chan configure stdin -encoding iso8859-1 -translation lf -buffering none - fcopy stdin stdout - } - close $f1 - set f1 [open "|[list [info nameofexecutable] $path(output)]" r+] - try { - chan configure $f1 -encoding utf-8 -buffering none - puts -nonewline $f1 A - set ch [read $f1 1] - } finally { - if {$f1 in [chan names]} { - close $f1 - } - } - lindex $ch -} A + +# test io-53.12 not backported. Tests feature only in 8.6+ + test io-53.13 {TclCopyChannel: read error reporting} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - return {initialize finalize watch read} - } - finalize { - return - } - watch {} - read { - error FAIL - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + return {initialize finalize watch read} + } + finalize { + return + } + watch {} + read { + error FAIL + } + } } set outFile [makeFile {} out] } -body { @@ -8355,24 +7810,24 @@ test io-53.13 {TclCopyChannel: read error reporting} -setup { catch {close $out} removeFile out rename driver {} -} -result {error reading "rc*": *} -returnCodes error -match glob +} -result {error reading "*": *} -returnCodes error -match glob test io-53.14 {TclCopyChannel: write error reporting} -setup { proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - return {initialize finalize watch write} - } - finalize { - return - } - watch {} - write { - error FAIL - } - } + variable buffer + variable index + set chan [lindex $args 0] + switch -- $cmd { + initialize { + return {initialize finalize watch write} + } + finalize { + return + } + watch {} + write { + error FAIL + } + } } set inFile [makeFile {aaa} in] } -body { @@ -8388,35 +7843,35 @@ test io-53.14 {TclCopyChannel: write error reporting} -setup { } -result {error writing "*": *} -returnCodes error -match glob test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup { proc driver {cmd args} { - variable buffer - variable index - variable blocked - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat a 100]] - set blocked($chan) 1 - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) blocked($chan) - return - } - watch {} - read { - if {$blocked($chan)} { - set blocked($chan) [expr {!$blocked($chan)}] - return -code error EAGAIN - } - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } + variable buffer + variable index + variable blocked + set chan [lindex $args 0] + switch -- $cmd { + initialize { + set index($chan) 0 + set buffer($chan) [encoding convertto utf-8 \ + [string repeat a 100]] + set blocked($chan) 1 + return {initialize finalize watch read} + } + finalize { + unset index($chan) buffer($chan) blocked($chan) + return + } + watch {} + read { + if {$blocked($chan)} { + set blocked($chan) [expr {!$blocked($chan)}] + return -code error EAGAIN + } + set n [lindex $args 1] + set new [expr {$index($chan) + $n}] + set result [string range $buffer($chan) $index($chan) $new-1] + set index($chan) $new + return $result + } + } } set c [chan create read [namespace which driver]] chan configure $c -encoding utf-8 @@ -8430,90 +7885,8 @@ test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup { close $c removeFile out } -result 100 -test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup { - proc driver {cmd args} { - variable buffer - variable index - variable blocked - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - [string repeat a 100]] - set blocked($chan) 1 - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) blocked($chan) - return - } - watch {} - read { - if {$blocked($chan)} { - set blocked($chan) [expr {!$blocked($chan)}] - return -code error EAGAIN - } - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } - } - set c [chan create read [namespace which driver]] - chan configure $c -encoding utf-8 -translation lf - set out [makeFile {} out] - set outChan [open $out w] - chan configure $outChan -encoding utf-8 -translation lf -} -body { - chan copy $c $outChan -} -cleanup { - close $outChan - close $c - removeFile out -} -result 100 -test io-53.17 {[7c187a3773] MBWrite: proper inQueueTail handling} -setup { - proc driver {cmd args} { - variable buffer - variable index - set chan [lindex $args 0] - switch -- $cmd { - initialize { - set index($chan) 0 - set buffer($chan) [encoding convertto utf-8 \ - line\n[string repeat a 100]line\n] - return {initialize finalize watch read} - } - finalize { - unset index($chan) buffer($chan) - return - } - watch {} - read { - set n [lindex $args 1] - set new [expr {$index($chan) + $n}] - set result [string range $buffer($chan) $index($chan) $new-1] - set index($chan) $new - return $result - } - } - } - set c [chan create read [namespace which driver]] - chan configure $c -encoding utf-8 -translation lf -buffersize 107 - set out [makeFile {} out] - set outChan [open $out w] - chan configure $outChan -encoding utf-8 -translation lf -} -body { - list [gets $c] [chan copy $c $outChan -size 100] [gets $c] -} -cleanup { - close $outChan - close $c - removeFile out -} -result {line 100 line} -test io-54.1 {Recursive channel events} {socket fileevent notWinCI} { +test io-54.1 {Recursive channel events} {socket fileevent} { # This test checks to see if file events are delivered during recursive # event loops when there is buffered data on the channel. @@ -8722,7 +8095,7 @@ test io-57.2 {buffered data and file events, read} {fileevent} { set result } {1 readable 234567890 timer} -test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrWin fileevent} { +test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} { set out [open $path(script) w] puts $out { puts "normal message from pipe" @@ -8754,7 +8127,7 @@ test io-59.1 {Thread reference of channels} {testmainthread testchannel} { # More complicated tests (like that the reference changes as a # channel is moved from thread to thread) can be done only in the # extension which fully implements the moving of channels between - # threads, i.e. 'Threads'. + # threads, i.e. 'Threads'. Or we have to extend [testthread] as well. set f [open $path(longfile) r] set result [testchannel mthread $f] @@ -8762,13 +8135,12 @@ test io-59.1 {Thread reference of channels} {testmainthread testchannel} { string equal $result [testmainthread] } {1} -test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} { +test io-60.1 {writing illegal utf sequences} {openpipe fileevent} { # This test will hang in older revisions of the core. set out [open $path(script) w] - puts $out "catch {load $::tcltestlib Tcltest}" puts $out { - puts ABC[testbytestring \xE2] + puts [encoding convertfrom identity \xe2] exit 1 } proc readit {pipe} { @@ -8792,7 +8164,7 @@ test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} { # cut of the remainder of the error stack, especially the filename set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]] list $x $result -} {1 {gets ABC catch {error writing "stdout": invalid or incomplete multibyte or wide character}}} +} {1 {gets {} catch {error writing "stdout": invalid argument}}} test io-61.1 {Reset eof state after changing the eof char} -setup { set datafile [makeFile {} eofchar] @@ -8822,7 +8194,7 @@ test io-61.1 {Reset eof state after changing the eof char} -setup { } -result {77 = 23431} -# Test the cutting and splicing of channels, this is incidentally the +# Test the cutting and splicing of channels, this is incidentially the # attach/detach facility of package Thread, but __without any # safeguards__. It can also be used to emulate transfer of channels # between threads, and is used for that here. @@ -8847,7 +8219,25 @@ test io-70.0 {Cutting & Splicing channels} {testchannel} { } {0 1 0} -test io-70.1 {Transfer channel} {testchannel thread} { +# Duplicate of code in "thread.test". Find a better way of doing this +# without duplication. Maybe placement into a proc which transforms to +# nop after the first call, and placement of its defintion in a +# central location. + +if {[testConstraint testthread]} { + testthread errorproc ThreadError + + proc ThreadError {id info} { + global threadError + set threadError $info + } + + proc ThreadNullError {id info} { + # ignore + } +} + +test io-70.1 {Transfer channel} {testchannel testthread} { set f [makeFile {... dummy ...} cutsplice] set c [open $f r] @@ -8856,17 +8246,16 @@ test io-70.1 {Transfer channel} {testchannel thread} { testchannel cut $c lappend res [catch {seek $c 0 start}] - set tid [thread::create -preserved] - thread::send $tid [list set c $c] - thread::send $tid {load {} Tcltest} - lappend res [thread::send $tid { + set tid [testthread create] + testthread send $tid [list set c $c] + lappend res [testthread send $tid { testchannel splice $c set res [catch {seek $c 0 start}] close $c set res }] - thread::release $tid + tcltest::threadReap removeFile cutsplice set res @@ -9065,18 +8454,15 @@ test io-73.1 {channel Tcl_Obj SetChannelFromAny} {} { catch {close [lreplace [list a] 0 end]} } {1} -test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} -setup { - # Invalidate internalrep of 'channel' Tcl_Obj when transiting between interpreters. - set f [open [info script] r] -} -body { +test io-73.2 {channel Tcl_Obj SetChannelFromAny, bug 2407783} {} { + # Invalidate intrep of 'channel' Tcl_Obj when transiting between interpreters. interp create foo + set f [open [info script] r] seek $f 0 set code [catch {interp eval foo [list seek $f 0]} msg] # The string map converts the changing channel handle to a fixed string list $code [string map [list $f @@] $msg] -} -cleanup { - close $f -} -result {1 {can not find channel named "@@"}} +} {1 {can not find channel named "@@"}} test io-73.3 {[5adc350683] [gets] after EOF} -setup { set fn [makeFile {} io-73.3] @@ -9126,7 +8512,7 @@ test io-73.5 {effect of eof on encoding end flags} -setup { read $rfd } -body { set result [eof $rfd] - puts -nonewline $wfd more\xC2\xA0data + puts -nonewline $wfd "more\u00c2\u00a0data" lappend result [eof $rfd] lappend result [read $rfd] lappend result [eof $rfd] @@ -9134,592 +8520,12 @@ test io-73.5 {effect of eof on encoding end flags} -setup { close $wfd close $rfd removeFile io-73.5 -} -result [list 1 1 more\xA0data 1] - -test io-74.1 {[104f2885bb] improper cache validity check} -setup { - set fn [makeFile {} io-74.1] - set rfd [open $fn r] - testobj freeallvars - interp create child -} -constraints testobj -body { - teststringobj set 1 [string range $rfd 0 end] - read [teststringobj get 1] - testobj duplicate 1 2 - interp transfer {} $rfd child - catch {read [teststringobj get 1]} - read [teststringobj get 2] -} -cleanup { - interp delete child - testobj freeallvars - removeFile io-74.1 -} -returnCodes error -match glob -result {can not find channel named "*"} - -test io-75.1 {multibyte encoding error read results in raw bytes (-profile tcl8)} -setup { - set fn [makeFile {} io-75.1] - set f [open $fn w+] - fconfigure $f -encoding binary - # In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed - # by a byte > 0x7F. This is violated to get an invalid sequence. - puts -nonewline $f A\xC0\x40 - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -profile tcl8 -buffering none -} -body { - set d [read $f] - binary scan $d H* hd - set hd -} -cleanup { - close $f - removeFile io-75.1 -} -result 41c040 - -test io-75.2 {unrepresentable character write passes and is replaced by ? (-profile tcl8)} -setup { - set fn [makeFile {} io-75.2] - set f [open $fn w+] - fconfigure $f -encoding iso8859-1 -profile tcl8 -} -body { - puts -nonewline $f A\u2022 - flush $f - seek $f 0 - read $f -} -cleanup { - close $f - removeFile io-75.2 -} -result A? - -# Incomplete sequence test. -# This error may IMHO only be detected with the close. -# But the read already returns the incomplete sequence. -test io-75.3 {incomplete multibyte encoding read is ignored (-profile tcl8)} -setup { - set fn [makeFile {} io-75.3] - set f [open $fn w+] - fconfigure $f -encoding binary - puts -nonewline $f "A\xC0" - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -profile tcl8 -} -body { - set d [read $f] - binary scan $d H* hd - set hd -} -cleanup { - close $f - removeFile io-75.3 -} -result 41c0 - -# As utf-8 has a special treatment in multi-byte decoding, also test another -# one. -test io-75.4 {shiftjis encoding error read results in raw bytes (-profile tcl8)} -setup { - set fn [makeFile {} io-75.4] - set f [open $fn w+] - fconfigure $f -encoding binary - # In shiftjis, \x81 starts a two-byte sequence. - # But 2nd byte \xFF is not allowed - puts -nonewline $f A\x81\xFFA - flush $f - seek $f 0 - fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -profile tcl8 -} -body { - set d [read $f] - binary scan $d H* hd - set hd -} -cleanup { - close $f - removeFile io-75.4 -} -result 4181ff41 - -test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup { - set fn [makeFile {} io-75.5] - set f [open $fn w+] - fconfigure $f -encoding binary - puts -nonewline $f A\x81 - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -profile tcl8 -} -body { - set d [read $f] - binary scan $d H* hd - set hd -} -cleanup { - close $f - removeFile io-75.5 -} -result 4181 - -test io-75.6 {incomplete utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup { - set fn [makeFile {} io-75.6] - set f [open $fn w+] - fconfigure $f -encoding binary - # \x81 is an incomplete byte sequence in utf-8 - puts -nonewline $f A\x81 - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar {} \ - -translation lf -profile strict -} -body { - gets $f -} -cleanup { - close $f - removeFile io-75.6 -} -match glob -returnCodes 1 -result {error reading "file*":\ - invalid or incomplete multibyte or wide character} - -test io-75.6.1 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict)} -setup { - set fn [makeFile {} io-75.6.1] - set f [open $fn w+] - fconfigure $f -encoding binary - # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered - puts -nonewline $f A\xC3B - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar {} \ - -translation lf -profile strict -} -body { - gets $f -} -cleanup { - close $f - removeFile io-75.6.1 -} -match glob -returnCodes 1 -result {error reading "file*":\ - invalid or incomplete multibyte or wide character} - -test io-75.6.2 {invalid utf-8 encoding, blocking gets is not ignored (-profile strict), recover functionality} -setup { - set fn [makeFile {} io-75.6.2] - set f [open $fn w+] - fconfigure $f -encoding binary - # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered - puts -nonewline $f A\xC3B - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar {} \ - -translation lf -profile strict -} -body { - set l {} - lappend l [catch {gets $f}] - lappend l [tell $f] - fconfigure $f -encoding binary - lappend l [expr {[gets $f] eq "A\xC3B"}] -} -cleanup { - close $f - removeFile io-75.6.2 -} -match glob -returnCodes 0 -result {1 0 1} - -# TCL ticket c4eb46a196: non blocking case had endless loop, so test it -test io-75.6.3 {invalid utf-8 encoding, non blocking gets is not ignored (-profile strict)} -setup { - set fn [makeFile {} io-75.6.3] - set f [open $fn w+] - fconfigure $f -encoding binary - # utf-8: \xC3 requires a 2nd byte > x80, but <x80 is delivered - puts -nonewline $f A\xC3B - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar {} \ - -translation lf -profile strict -blocking 0 -} -body { - gets $f -} -cleanup { - close $f - removeFile io-75.6.3 -} -match glob -returnCodes 1 -result {error reading "file*":\ - invalid or incomplete multibyte or wide character} - -test io-75.6.4 {incomplete utf-8 encoding, non blocking gets is not ignored (-profile strict)} -setup { - set fn [makeFile {} io-75.6.4] - set f [open $fn w+] - fconfigure $f -encoding binary - # \x81 is an incomplete byte sequence in utf-8 - puts -nonewline $f A\x81 - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar {} \ - -translation lf -profile strict -blocking 0 -} -body { - gets $f - # only the 2nd gets returns the error - gets $f -} -cleanup { - close $f - removeFile io-75.6.4 -} -match glob -returnCodes 1 -result {error reading "file*":\ - invalid or incomplete multibyte or wide character} - -test io-75.7 { - invalid utf-8 encoding read is not ignored (-profile strict) -} -setup { - set fn [makeFile {} io-75.7] - set f [open $fn w+] - fconfigure $f -encoding binary - # \x81 is invalid in utf-8 - puts -nonewline $f A\x81 - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf \ - -profile strict -} -body { - list [catch {read $f} msg data] $msg [dict get $data -data] -} -cleanup { - close $f - removeFile io-75.7 - unset msg data f fn -} -match glob -result {1 {error reading "file*":\ - invalid or incomplete multibyte or wide character} A} - -test io-75.8 {invalid utf-8 encoding eof first handling (-profile strict)} -setup { - set fn [makeFile {} io-75.8] - set f [open $fn w+] - fconfigure $f -encoding binary - # \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes - # precedence. - puts -nonewline $f A\x1A\x81 - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \ - -translation lf -profile strict -} -body { - set d [read $f] - binary scan $d H* hd - lappend hd [eof $f] - lappend hd [read $f] - set hd -} -cleanup { - close $f - removeFile io-75.8 - unset f d hd -} -result {41 1 {}} - -test io-75.8.eoflater {invalid utf-8 encoding eof after handling (-profile strict)} -setup { - set fn [makeFile {} io-75.8] - set f [open $fn w+] - # This also configures the channel encoding profile as strict. - fconfigure $f -encoding binary - # \x81 is invalid in utf-8. -eofchar is not detected, because it comes later. - puts -nonewline $f A\x81\x81\x1A - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \ - -translation lf -profile strict -} -body { - set res [list [catch {read $f} msg data] [eof $f] [dict get $data -data]] - chan configure $f -encoding iso8859-1 - lappend res [read $f 1] - chan configure $f -encoding utf-8 - lappend res [catch {read $f 1} msg data] $msg [dict get $data -data] -} -cleanup { - close $f - removeFile io-75.8 - unset res msg data fn f -} -match glob -result "1 0 A \x81 1 {error reading \"*\":\ - invalid or incomplete multibyte or wide character} {}" - - -test io-strict-multibyte-eof { - incomplete utf-8 sequence immediately prior to eof character - - See issue 25cdcb7e8fb381fb -} -setup { - set chan [file tempfile]; - fconfigure $chan -encoding binary - puts -nonewline $chan \x81\x1A - flush $chan - seek $chan 0 - chan configure $chan -encoding utf-8 -profile strict -} -body { - list [catch {read $chan 1} msg data] $msg [dict get $data -data] -} -cleanup { - close $chan - unset msg chan data -} -match glob -result {1 {error reading "*":\ - invalid or incomplete multibyte or wide character} {}} - -test io-75.9 {unrepresentable character write throws error in strict profile} -setup { - set fn [makeFile {} io-75.9] - set f [open $fn w+] - fconfigure $f -encoding iso8859-1 -profile strict -} -body { - catch {puts -nonewline $f "A\u2022"} msg - flush $f - seek $f 0 - list [read $f] $msg -} -cleanup { - close $f - removeFile io-75.9 - unset f -} -match glob -result [list {A} {error writing "*":\ - invalid or incomplete multibyte or wide character}] - -# Incomplete sequence test. -# This error may IMHO only be detected with the close. -# But the read already returns the incomplete sequence. -test io-75.10 {incomplete multibyte encoding read is ignored} -setup { - set fn [makeFile {} io-75.10] - set f [open $fn w+] - fconfigure $f -encoding binary - puts -nonewline $f A\xC0 - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -} -body { - set d [read $f] - binary scan $d H* hd - set hd -} -cleanup { - close $f - removeFile io-75.10 - unset d hd -} -result 41c0 -# The current result returns the orphan byte as byte. -# This may be expected due to special utf-8 handling. - -# As utf-8 has a special treatment in multi-byte decoding, also test another -# one. -test io-75.11 {shiftjis encoding error read results in error (strict profile)} -setup { - set fn [makeFile {} io-75.11] - set f [open $fn w+] - fconfigure $f -encoding binary - # In shiftjis, \x81 starts a two-byte sequence. - # But 2nd byte \xFF is not allowed - puts -nonewline $f A\x81\xFFA - flush $f - seek $f 0 - fconfigure $f -encoding shiftjis -blocking 0 -eofchar {} -translation lf \ - -profile strict -} -body { - set d [read $f] - binary scan $d H* hd - lappend hd [catch {set d [read $f]} msg data] $msg [dict exists $data -data] -} -cleanup { - close $f - removeFile io-75.11 - unset d hd msg data f -} -match glob -result {41 1 {error reading "file*":\ - invalid or incomplete multibyte or wide character} 0} - -test io-75.12 {invalid utf-8 encoding read is ignored} -setup { - set fn [makeFile {} io-75.12] - set f [open $fn w+] - fconfigure $f -encoding binary - puts -nonewline $f A\x81 - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf -} -body { - set d [read $f] - binary scan $d H* hd - set hd -} -cleanup { - close $f - removeFile io-75.12 -} -result 4181 -test io-75.13 { - In nonblocking mode when there is an encoding error the data that has been - successfully read so far is returned first and then the error is returned - on the next call to [read]. -} -setup { - set fn [makeFile {} io-75.13] - set f [open $fn w+] - fconfigure $f -encoding binary - # \x81 is invalid in utf-8 - puts -nonewline $f A\x81 - flush $f - seek $f 0 - fconfigure $f -encoding utf-8 -blocking 0 -eofchar {} -translation lf \ - -profile strict -} -body { - set d [read $f] - binary scan $d H* hd - lappend hd [catch {read $f} msg data] $msg [dict exists $data -data] -} -cleanup { - close $f - removeFile io-75.13 - unset d hd msg data f fn -} -match glob -result {41 1 {error reading "file*":\ - invalid or incomplete multibyte or wide character} 0} - -test io-75.14 { - [gets] succesfully returns lines prior to error - - invalid utf-8 encoding [gets] continues in non-strict mode after error -} -setup { - set chan [file tempfile] - fconfigure $chan -encoding binary - # \xC0\n is an invalid utf-8 sequence - puts -nonewline $chan a\nb\nc\xC0\nd\n - flush $chan - seek $chan 0 - fconfigure $chan -encoding utf-8 -buffering none -eofchar {} \ - -translation auto -profile strict -} -body { - set res [gets $chan] - lappend res [gets $chan] - lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data] - chan configure $chan -profile tcl8 - lappend res [gets $chan] - lappend res [gets $chan] - return $res -} -cleanup { - close $chan - unset chan res msg data -} -match glob -result {a b 1 {error reading "*":\ - invalid or incomplete multibyte or wide character} 0 cÀ d} - -test io-75.15 { - invalid utf-8 encoding strict - gets does not hang - gets succeeds for the first two lines -} -setup { - set res {} - set chan [file tempfile] - fconfigure $chan -encoding binary - # \xC0\x40 is an invalid utf-8 sequence - puts $chan hello\nAB\nCD\xC0\x40EF\nGHI - seek $chan 0 -} -body { - #Now try to read it with [gets] - fconfigure $chan -encoding utf-8 -profile strict - lappend res [gets $chan] - lappend res [gets $chan] - lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data] - lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data] - chan configure $chan -translation binary - set data [read $chan 4] - foreach char [split $data {}] { - scan $char %c ord - lappend res [format %x $ord] - } - fconfigure $chan -encoding utf-8 -profile strict -translation auto - lappend res [gets $chan] - lappend res [gets $chan] - return $res -} -cleanup { - close $chan - unset chan res msg data -} -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\ - 0 1 {error reading "*": invalid or incomplete multibyte or wide character} 0 43 44 c0 40 EF GHI} +} -result [list 1 1 more\u00a0data 1] # ### ### ### ######### ######### ######### - - -test io-76.0 {channel modes} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile r] -} -constraints testchannel -body { - testchannel mode $f -} -cleanup { - close $f - removeFile dummy -} -result {read {}} - -test io-76.1 {channel modes} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile w] -} -constraints testchannel -body { - testchannel mode $f -} -cleanup { - close $f - removeFile dummy -} -result {{} write} - -test io-76.2 {channel modes} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile r+] -} -constraints testchannel -body { - testchannel mode $f -} -cleanup { - close $f - removeFile dummy -} -result {read write} - -test io-76.3 {channel mode dropping} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile r] -} -constraints testchannel -body { - testchannel mremove-wr $f - list [testchannel mode $f] [testchannel maxmode $f] -} -cleanup { - close $f - removeFile dummy -} -result {{read {}} {read {}}} - -test io-76.4 {channel mode dropping} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile r] -} -constraints testchannel -body { - testchannel mremove-rd $f -} -returnCodes error -cleanup { - close $f - removeFile dummy -} -match glob -result {Tcl_RemoveChannelMode error:\ - Bad mode, would make channel inacessible. Channel: "*"} - -test io-76.5 {channel mode dropping} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile w] -} -constraints testchannel -body { - testchannel mremove-rd $f - list [testchannel mode $f] [testchannel maxmode $f] -} -cleanup { - close $f - removeFile dummy -} -result {{{} write} {{} write}} - -test io-76.6 {channel mode dropping} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile w] -} -constraints testchannel -body { - testchannel mremove-wr $f -} -returnCodes error -cleanup { - close $f - removeFile dummy -} -match glob -result {Tcl_RemoveChannelMode error:\ - Bad mode, would make channel inacessible. Channel: "*"} - -test io-76.7 {channel mode dropping} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile r+] -} -constraints testchannel -body { - testchannel mremove-rd $f - list [testchannel mode $f] [testchannel maxmode $f] -} -cleanup { - close $f - removeFile dummy -} -result {{{} write} {read write}} - -test io-76.8 {channel mode dropping} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile r+] -} -constraints testchannel -body { - testchannel mremove-wr $f - list [testchannel mode $f] [testchannel maxmode $f] -} -cleanup { - close $f - removeFile dummy -} -result {{read {}} {read write}} - -test io-76.9 {channel mode dropping} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile r+] -} -constraints testchannel -body { - testchannel mremove-wr $f - testchannel mremove-rd $f -} -returnCodes error -cleanup { - close $f - removeFile dummy -} -match glob -result {Tcl_RemoveChannelMode error:\ - Bad mode, would make channel inacessible. Channel: "*"} - -test io-76.10 {channel mode dropping} -setup { - set datafile [makeFile {some characters} dummy] - set f [open $datafile r+] -} -constraints testchannel -body { - testchannel mremove-rd $f - testchannel mremove-wr $f -} -returnCodes error -cleanup { - close $f - removeFile dummy -} -match glob -result {Tcl_RemoveChannelMode error:\ - Bad mode, would make channel inacessible. Channel: "*"} - # cleanup -foreach file [list fooBar longfile script script2 output test1 pipe my_script \ +foreach file [list fooBar longfile script output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file } |