# -*- tcl -*-

 # Functionality covered: operation of all IO commands, and all procedures

 # defined in generic/tclIO.c.

 #

 # This file contains a collection of tests for one or more of the Tcl

 # built-in commands.  Sourcing this file into Tcl runs the tests and

 # generates output for errors.  No output means no errors were found.

 #

 # 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.

 #

 # RCS: @(#) $Id: io.test,v 1.40.2.12 2007/02/12 19:25:42 andreas_kupries Exp $

 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::cleanupTests

     namespace import ::tcltest::interpreter

     namespace import ::tcltest::makeFile

     namespace import ::tcltest::removeFile

     namespace import ::tcltest::test

     namespace import ::tcltest::testConstraint

     namespace import ::tcltest::viewFile

 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]]

 # You need a *very* special environment to do some tests.  In

 # particular, many file systems do not support large-files...

 testConstraint largefileSupport 0

 # set up a long data file for some of the following tests

 set path(longfile) [makeFile {} longfile]

 set f [open $path(longfile) w]

 fconfigure $f -eofchar {} -translation lf

 for { set i 0 } { $i < 100 } { incr i} {

     puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef

 \#123456789abcdef01

 \#"

     }

 close $f

 set path(cat) [makeFile {

     set f stdin

     if {$argv != ""} {

 	set f [open [lindex $argv 0]]

     }

     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} {

 	set x [read $f]

 	catch {puts -nonewline $x}

 	if {[eof $f]} {

 	    close $f

 	    exit 0

 	}

     }

     vwait forever

 } cat]

 set thisScript [file join [pwd] [info script]]

 proc contents {file} {

     set f [open $file]

     fconfigure $f -translation binary

     set a [read $f]

     close $f

     return $a

 }

 test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {

     # no test, need to cause an async error.

 } {}

 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\u4e4d\0"

     close $f

     contents $path(test1)

 } "a\x4d\x00"

 test io-1.7 {Tcl_WriteChars: WriteChars} {

     set f [open $path(test1) w]

     fconfigure $f -encoding shiftjis

     puts -nonewline $f "a\u4e4d\0"

     close $f

     contents $path(test1)

 } "a\x93\xe1\x00"

 set path(test2) [makeFile {} test2]

 test io-1.8 {Tcl_WriteChars: WriteChars} {

     # This test written for SF bug #506297.

     #

     # Executing this test without the fix for the referenced bug

     # 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 

     contents $path(test2)

 } "    \x1b\$B\$O\x1b(B"

 test io-1.9 {Tcl_WriteChars: WriteChars} {

     # When closing a channel with an encoding that appends

     # escape bytes, check for the case where the escape

     # bytes overflow the current IO buffer. The bytes

     # should be moved into a new buffer.

     set data "1234567890 [format %c 12399]"

     set sizes [list]

     # With default buffer size

     set f [open $path(test2) w]

     fconfigure      $f -encoding iso2022-jp

     puts -nonewline $f $data

     close           $f

     lappend sizes [file size $path(test2)]

     # With buffer size equal to the length

     # of the data, the escape bytes would

     # go into the next buffer.

     set f [open $path(test2) w]

     fconfigure      $f -encoding iso2022-jp -buffersize 16

     puts -nonewline $f $data

     close           $f

     lappend sizes [file size $path(test2)]

     # With buffer size that is large enough

     # to hold 1 byte of escaped data, but

     # not all 3. This should not write

     # the escape bytes to the first buffer

     # and then again to the second buffer.

     set f [open $path(test2) w]

     fconfigure      $f -encoding iso2022-jp -buffersize 17

     puts -nonewline $f $data

     close           $f

     lappend sizes [file size $path(test2)]

     # With buffer size that can hold 2 out of

     # 3 bytes of escaped data.

     set f [open $path(test2) w]

     fconfigure      $f -encoding iso2022-jp -buffersize 18

     puts -nonewline $f $data

     close           $f

     lappend sizes [file size $path(test2)]

     # With buffer size that can hold all the

     # data and escape bytes.

     set f [open $path(test2) w]

     fconfigure      $f -encoding iso2022-jp -buffersize 19

     puts -nonewline $f $data

     close           $f

     lappend sizes [file size $path(test2)]

     set sizes

 } {19 19 19 19 19}

 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"

     close $f

     contents $path(test1)

 } "abcdefghijklmnopqrstuvwxyz\r\n"

 test io-2.2 {WriteBytes: savedLF > 0} {

     # After flushing buffer, there was a \n left over from the last

     # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.

     set f [open $path(test1) w]

     fconfigure $f -encoding binary -buffersize 16 -translation crlf

     puts -nonewline $f "123456789012345\n12"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "123456789012345\r" "123456789012345\r\n12"]

 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"

     set x [contents $path(test1)]

     close $f

     set x

 } "\r\n12"

 test io-2.4 {WriteBytes: reset sawLF after each buffer} {

     set f [open $path(test1) w]

      fconfigure $f -encoding binary -buffering line -translation lf \

 	     -buffersize 16

     puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]

 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"

     close $f

     contents $path(test1)

 } "abcdefghijklmnopqrstuvwxyz\r\n"

 test io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {

     # After flushing buffer, there was a \n left over from the last

     # \n -> \r\n expansion.  It gets stuck at beginning of this buffer.

     set f [open $path(test1) w]

     fconfigure $f -encoding ascii -buffersize 16 -translation crlf

     puts -nonewline $f "123456789012345\n12"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "123456789012345\r" "123456789012345\r\n12"]

 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"

     set x [contents $path(test1)]

     close $f

     set x

 } "\r\n12"

 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 

     puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [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 

     puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [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 \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 \uff21 plus the all of \uff22) appended.

     set f [open $path(test1) w]

     fconfigure $f -encoding shiftjis -buffersize 16

     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)} {

     # 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

     # blocksize on flush.  The truncated bytes are moved to the beginning

     # of the next channel buffer.

     set f [open $path(test1) w]

     fconfigure $f -encoding jis0208 -buffersize 17 

     puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [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 \

 	     -buffersize 16

     puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]

 test io-4.1 {TranslateOutputEOL: lf} {

     # search for \n

     set f [open $path(test1) w]

     fconfigure $f -buffering line -translation lf

     puts $f "abcde"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "abcde\n" "abcde\n"]

 test io-4.2 {TranslateOutputEOL: cr} {

     # search for \n, replace with \r

     set f [open $path(test1) w]

     fconfigure $f -buffering line -translation cr

     puts $f "abcde"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "abcde\r" "abcde\r"]

 test io-4.3 {TranslateOutputEOL: crlf} {

     # simple case: search for \n, replace with \r

     set f [open $path(test1) w]

     fconfigure $f -buffering line -translation crlf

     puts $f "abcde"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "abcde\r\n" "abcde\r\n"]

 test io-4.4 {TranslateOutputEOL: crlf} {

     # keep storing more bytes in output buffer until output buffer is full.

     # We have 13 bytes initially that would turn into 18 bytes.  Fill

     # dest buffer while (dstEnd < dstMax).

     set f [open $path(test1) w]

     fconfigure $f -translation crlf -buffersize 16

     puts -nonewline $f "1234567\n\n\n\n\nA"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"]

 test io-4.5 {TranslateOutputEOL: crlf} {

     # Check for overflow of the destination buffer

     set f [open $path(test1) w]

     fconfigure $f -translation crlf -buffersize 12

     puts -nonewline $f "12345678901\n456789012345678901234"

     close $f

     set x [contents $path(test1)]

 } "12345678901\r\n456789012345678901234"

 test io-5.1 {CheckFlush: not full} {

     set f [open $path(test1) w]

     fconfigure $f 

     puts -nonewline $f "12345678901234567890"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "" "12345678901234567890"]

 test io-5.2 {CheckFlush: full} {

     set f [open $path(test1) w]

     fconfigure $f -buffersize 16

     puts -nonewline $f "12345678901234567890"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "1234567890123456" "12345678901234567890"]

 test io-5.3 {CheckFlush: not line} {

     set f [open $path(test1) w]

     fconfigure $f -buffering line

     puts -nonewline $f "12345678901234567890"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "" "12345678901234567890"]

 test io-5.4 {CheckFlush: line} {

     set f [open $path(test1) w]

     fconfigure $f -buffering line -translation lf -encoding ascii

     puts -nonewline $f "1234567890\n1234567890"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "1234567890\n1234567890" "1234567890\n1234567890"]

 test io-5.5 {CheckFlush: none} {

     set f [open $path(test1) w]

     fconfigure $f -buffering none

     puts -nonewline $f "1234567890"

     set x [list [contents $path(test1)]]

     close $f

     lappend x [contents $path(test1)]

 } [list "1234567890" "1234567890"]

 test io-6.1 {Tcl_GetsObj: working} {

     set f [open $path(test1) w]

     puts $f "foo\nboo"

     close $f

     set f [open $path(test1)]

     set x [gets $f]

     close $f

     set x

 } {foo}

 test io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} {

     # no test, need to cause an async error.

 } {}

 test io-6.3 {Tcl_GetsObj: how many have we used?} {

     # if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved}

     set f [open $path(test1) w]

     fconfigure $f -translation crlf

     puts $f "abc\ndefg"

     close $f

     set f [open $path(test1)]

     set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line]

     close $f

     set x

 } {0 3 5 4 defg}

 test io-6.4 {Tcl_GetsObj: encoding == NULL} {

     set f [open $path(test1) w]

     fconfigure $f -translation binary

     puts $f "\x81\u1234\0"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation binary

     set x [list [gets $f line] $line]

     close $f

     set x

 } [list 3 "\x81\x34\x00"]

 test io-6.5 {Tcl_GetsObj: encoding != NULL} {

     set f [open $path(test1) w]

     fconfigure $f -translation binary

     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 "\u4e00\u4e01"]

 set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"

 append a $a

 append a $a

 test io-6.6 {Tcl_GetsObj: loop test} {

     # if (dst >= dstEnd) 

     set f [open $path(test1) w]

     puts $f $a

     puts $f hi

     close $f

     set f [open $path(test1)]

     set x [list [gets $f line] $line]

     close $f

     set x

 } [list 256 $a]

 test io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} {

     # if (FilterInputBytes(chanPtr, &gs) != 0)

     set f [open "|[list [interpreter] $path(cat)]" w+]

     puts -nonewline $f "hi\nwould"

     flush $f

     gets $f

     fconfigure $f -blocking 0

     set x [gets $f line]

     close $f

     set x

 } {-1}

 test io-6.8 {Tcl_GetsObj: remember if EOF is seen} {

     set f [open $path(test1) w]

     puts $f "abcdef\x1aghijk\nwombat"

     close $f

     set f [open $path(test1)]

     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\u001abat"

     close $f

     set f [open $path(test1)]

     fconfigure $f -eofchar \x1a

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {11 abcdefghijk 3 wom}

 # Comprehensive tests

 test io-6.10 {Tcl_GetsObj: lf mode: no chars} {

     set f [open $path(test1) w]

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation lf

     set x [list [gets $f line] $line]

     close $f

     set x

 } {-1 {}}

 test io-6.11 {Tcl_GetsObj: lf mode: lone \n} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation lf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {0 {} -1 {}}

 test io-6.12 {Tcl_GetsObj: lf mode: lone \r} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation lf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 1 "\r" -1 ""]

 test io-6.13 {Tcl_GetsObj: lf mode: 1 char} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f a

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation lf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {1 a -1 {}}

 test io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "a\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation lf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {1 a -1 {}}

 test io-6.15 {Tcl_GetsObj: lf mode: several chars} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation lf

     set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]

 test io-6.16 {Tcl_GetsObj: cr mode: no chars} {

     set f [open $path(test1) w]

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation cr

     set x [list [gets $f line] $line]

     close $f

     set x

 } {-1 {}}

 test io-6.17 {Tcl_GetsObj: cr mode: lone \n} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation cr

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 1 "\n" -1 ""]

 test io-6.18 {Tcl_GetsObj: cr mode: lone \r} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation cr

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {0 {} -1 {}}

 test io-6.19 {Tcl_GetsObj: cr mode: 1 char} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f a

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation cr

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {1 a -1 {}}

 test io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "a\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation cr

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {1 a -1 {}}

 test io-6.21 {Tcl_GetsObj: cr mode: several chars} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation cr

     set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]

 test io-6.22 {Tcl_GetsObj: crlf mode: no chars} {

     set f [open $path(test1) w]

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [list [gets $f line] $line]

     close $f

     set x

 } {-1 {}}

 test io-6.23 {Tcl_GetsObj: crlf mode: lone \n} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 1 "\n" -1 ""]

 test io-6.24 {Tcl_GetsObj: crlf mode: lone \r} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 1 "\r" -1 ""]

 test io-6.25 {Tcl_GetsObj: crlf mode: \r\r} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\r\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 2 "\r\r" -1 ""]

 test io-6.26 {Tcl_GetsObj: crlf mode: \r\n} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\r\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 0 "" -1 ""]

 test io-6.27 {Tcl_GetsObj: crlf mode: 1 char} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f a

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {1 a -1 {}}

 test io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "a\r\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {1 a -1 {}}

 test io-6.29 {Tcl_GetsObj: crlf mode: several chars} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]

 test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {

     # if (eol >= dstEnd)

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf -buffersize 16

     set x [list [gets $f line] $line [testchannel inputbuffered $f]]

     close $f

     set x

 } [list 15 "123456789012345" 15]

 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+]

     fconfigure $f -translation {crlf lf} -buffering none

     puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"

     fconfigure $f -buffersize 16

     set x [gets $f]

     fconfigure $f -blocking 0

     lappend x [gets $f line] $line [fblocked $f] [testchannel inputbuffered $f]

     close $f

     set x

 } [list "bbbbbbbbbbbbbb" -1 "" 1 16]

 test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} {

     # not (FilterInputBytes() != 0)

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "123456789012345\r\n123"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf -buffersize 16

     set x [list [gets $f line] $line [tell $f] [testchannel inputbuffered $f]]

     close $f

     set x

 } [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"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf -buffersize 16

     set x [list [gets $f line] $line [eof $f]]

     close $f

     set x

 } [list 16 "123456789012345\r" 1]

 test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {

     # not (*eol == '\n') 

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "123456789012345\rabcd\r\nefg"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf -buffersize 16

     set x [list [gets $f line] $line [tell $f]]

     close $f

     set x

 } [list 20 "123456789012345\rabcd" 22]

 test io-6.35 {Tcl_GetsObj: auto mode: no chars} {

     set f [open $path(test1) w]

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [list [gets $f line] $line]

     close $f

     set x

 } {-1 {}}

 test io-6.36 {Tcl_GetsObj: auto mode: lone \n} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 0 "" -1 ""]

 test io-6.37 {Tcl_GetsObj: auto mode: lone \r} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 0 "" -1 ""]

 test io-6.38 {Tcl_GetsObj: auto mode: \r\r} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\r\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 0 "" 0 "" -1 ""]

 test io-6.39 {Tcl_GetsObj: auto mode: \r\n} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\r\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } [list 0 "" -1 ""]

 test io-6.40 {Tcl_GetsObj: auto mode: 1 char} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f a

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {1 a -1 {}}

 test io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "a\r\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [list [gets $f line] $line [gets $f line] $line]

     close $f

     set x

 } {1 a -1 {}}

 test io-6.42 {Tcl_GetsObj: auto mode: several chars} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [list [gets $f line] $line [gets $f line] $line]

     lappend x [gets $f line] $line [gets $f line] $line [gets $f line] $line

     close $f

     set x

 } [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]

 test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} {

     # if (chanPtr->flags & INPUT_SAW_CR)

     set f [open "|[list [interpreter] $path(cat)]" w+]

     fconfigure $f -translation {auto lf} -buffering none

     puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"

     fconfigure $f -buffersize 16

     set x [list [gets $f]]

     fconfigure $f -blocking 0

     lappend x [gets $f line] $line [testchannel queuedcr $f] 

     fconfigure $f -blocking 1

     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 openpipe fileevent} {

     # not (*eol == '\n') 

     set f [open "|[list [interpreter] $path(cat)]" w+]

     fconfigure $f -translation {auto lf} -buffering none

     puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"

     fconfigure $f -buffersize 16

     set x [list [gets $f]]

     fconfigure $f -blocking 0

     lappend x [gets $f line] $line [testchannel queuedcr $f] 

     fconfigure $f -blocking 1

     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 openpipe fileevent} {

     # Tcl_ExternalToUtf()

     set f [open "|[list [interpreter] $path(cat)]" w+]

     fconfigure $f -translation {auto lf} -buffering none

     fconfigure $f -encoding unicode

     puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"

     fconfigure $f -buffersize 16

     gets $f

     fconfigure $f -blocking 0

     set x [list [gets $f line] $line [testchannel queuedcr $f]]

     fconfigure $f -blocking 1

     puts -nonewline $f "\nabcd\refg"

     lappend x [gets $f line] $line [testchannel queuedcr $f]

     close $f

     set x

 } [list 15 "123456789abcdef" 1 4 "abcd" 0]

 test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} {

     # memmove()

     set f [open "|[list [interpreter] $path(cat)]" w+]

     fconfigure $f -translation {auto lf} -buffering none

     puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"

     fconfigure $f -buffersize 16

     gets $f

     fconfigure $f -blocking 0

     set x [list [gets $f line] $line [testchannel queuedcr $f]]

     fconfigure $f -blocking 1

     puts -nonewline $f "\n\x1a"

     lappend x [gets $f line] $line [testchannel queuedcr $f]

     close $f

     set x

 } [list 15 "123456789abcdef" 1 -1 "" 0]

 test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} {

     # (eol == dstEnd)

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto -buffersize 16

     set x [list [gets $f] [testchannel inputbuffered $f]]

     close $f

     set x

 } [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"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto -buffersize 16

     set x [list [gets $f] [testchannel queuedcr $f]]

     close $f

     set x

 } [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"

     close $f

     set f [open $path(test1)]

     set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]

     close $f

     set x

 } [list "123456" 0 8 "78901"]

 test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {

     # not (*eol == '\n') 

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "123456\r78901"

     close $f

     set f [open $path(test1)]

     set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]

     close $f

     set x

 } [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"

     close $f

     set f [open $path(test1)]

     set x [list [gets $f] [tell $f] [gets $f]]

     close $f

     set x

 } [list "123456" 7 "78901"]

 test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} {

     # if (eof != NULL)

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "123456\x1ak9012345\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -eofchar \x1a

     set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]

     close $f

     set x

 } [list "123456" 0 6 ""]

 test io-6.53 {Tcl_GetsObj: device EOF} {

     # didn't produce any bytes

     set f [open $path(test1) w]

     close $f

     set f [open $path(test1)]

     set x [list [gets $f line] $line [eof $f]]

     close $f

     set x

 } {-1 {} 1}

 test io-6.54 {Tcl_GetsObj: device EOF} {

     # got some bytes before EOF.

     set f [open $path(test1) w]

     puts -nonewline $f abc

     close $f

     set f [open $path(test1)]

     set x [list [gets $f line] $line [eof $f]]

     close $f

     set x

 } {3 abc 1}

 test io-6.55 {Tcl_GetsObj: overconverted} {

     # Tcl_ExternalToUtf(), make sure state updated

     set f [open $path(test1) w]

     fconfigure $f -encoding iso2022-jp

     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\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

     puts -nonewline $f "foobar"

     fconfigure $f -blocking 0

     variable x {}

     after 500 [namespace code { lappend x timeout }]

     fileevent $f readable [namespace code { lappend x [gets $f] }]

     vwait [namespace which -variable x]

     vwait [namespace which -variable x]

     fconfigure $f -blocking 1

     puts -nonewline $f "baz\n"

     after 500 [namespace code { lappend x timeout }]

     fconfigure $f -blocking 0

     vwait [namespace which -variable x]

     vwait [namespace which -variable x]

     close $f

     set x

 } {{} timeout foobarbaz timeout}

 test io-7.1 {FilterInputBytes: split up character at end of buffer} {

     # (result == TCL_CONVERT_MULTIBYTE)

     set f [open $path(test1) w]

     fconfigure $f -encoding shiftjis

     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\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"

     close $f

     set f [open $path(test1)]

     fconfigure $f -encoding shiftjis

     set x [list [gets $f line] $line [eof $f]]

     close $f

     set x

 } [list 10 "1234567890" 0]

 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"

     close $f

     set f [open $path(test1)]

     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 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"

     fconfigure $f -encoding shiftjis -blocking 0

     fileevent $f read [namespace code "ready $f"]

     variable x {}

     proc ready {f} {

 	variable x

 	lappend x [gets $f line] $line [fblocked $f]

     }

     vwait [namespace which -variable x]

     fconfigure $f -encoding binary -blocking 1

     puts $f "\x51\x82\x52"

     fconfigure $f -encoding shiftjis

     vwait [namespace which -variable x]

     close $f

     set x

 } [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)

     set f [open $path(test1) w]

     fconfigure $f -encoding ascii -translation lf

     puts -nonewline $f "123456789012345\r\n2345678"

     close $f

     set f [open $path(test1)]

     fconfigure $f -encoding ascii -translation auto -buffersize 16

     # here

     gets $f

     set x [testchannel inputbuffered $f]

     close $f

     set x

 } "7"

 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+]

     fconfigure $f -translation lf -encoding ascii -buffering none

     puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"

     variable x {}

     fileevent $f read [namespace code "ready $f"]

     proc ready {f} {

 	variable x

 	lappend x [gets $f line] $line [testchannel inputbuffered $f]

     }

     fconfigure $f -encoding unicode -buffersize 16 -blocking 0

     vwait [namespace which -variable x]

     fconfigure $f -translation auto -encoding ascii -blocking 1

     # here

     vwait [namespace which -variable x]

     close $f

     set x

 } [list -1 "" 42 15 "123456789012345" 25]

 test io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} {

     # (bytesLeft == 0)

     set f [open "|[list [interpreter] $path(cat)]" w+]

     fconfigure $f -translation {auto binary}

     puts -nonewline $f "abcdefghijklmno\r"

     flush $f

     set x [list [gets $f line] $line [testchannel queuedcr $f]]

     close $f

     set x

 } [list 15 "abcdefghijklmno" 1]

 set a "123456789012345678901234567890"

 append a "123456789012345678901234567890"

 append a "1234567890123456789012345678901"

 test io-8.4 {PeekAhead: cached data available in this buffer} {

     # not (bytesLeft == 0)

     set f [open $path(test1) w+]

     fconfigure $f -translation binary

     puts $f "${a}\r\nabcdef"

     close $f

     set f [open $path(test1)]

     fconfigure $f -encoding binary -translation auto

     # "${a}\r" was converted in one operation (because ENCODING_LINESIZE

     # is 30).  To check if "\n" follows, calls PeekAhead and determines

     # that cached data is available in buffer w/o having to call driver.

     set x [gets $f]

     close $f

     set x    

 } $a

 unset a

 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+]

     fconfigure $f -translation {auto binary}

     puts -nonewline $f "abcdefghijklmno\r"

     flush $f

     # here

     set x [list [gets $f line] $line [testchannel queuedcr $f]]

     close $f

     set x

 } {15 abcdefghijklmno 1}

 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

     puts -nonewline $f "abcdefghijklmno\r"

     flush $f

     # here

     set x [list [gets $f line] $line [testchannel queuedcr $f]]

     close $f

     set x

 } {15 abcdefghijklmno 1}

 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+]

     fconfigure $f -translation {auto binary} -buffering none

     puts -nonewline $f "abcdefghijklmno\r"

     # here

     set x [list [gets $f line] $line [testchannel queuedcr $f]]

     puts -nonewline $f "\x1a"

     lappend x [gets $f line] $line

     close $f

     set x

 } {15 abcdefghijklmno 1 -1 {}}

 test io-9.1 {CommonGetsCleanup} {

 } {}

 test io-10.1 {Tcl_ReadChars: CheckChannelErrors} {

     # no test, need to cause an async error.

 } {}

 test io-10.2 {Tcl_ReadChars: loop until enough copied} {

     # one time

     # for (copied = 0; (unsigned) toRead > 0; )

     set f [open $path(test1) w]

     puts $f abcdefghijklmnop

     close $f

     set f [open $path(test1)]

     set x [read $f 5]

     close $f

     set x

 } {abcde}

 test io-10.3 {Tcl_ReadChars: loop until enough copied} {

     # multiple times

     # for (copied = 0; (unsigned) toRead > 0; )

     set f [open $path(test1) w]

     puts $f abcdefghijklmnopqrstuvwxyz

     close $f

     set f [open $path(test1)]

     fconfigure $f -buffersize 16

     # here

     set x [read $f 19]

     close $f

     set x

 } {abcdefghijklmnopqrs}

 test io-10.4 {Tcl_ReadChars: no more in channel buffer} {

     # (copiedNow < 0)

     set f [open $path(test1) w]

     puts -nonewline $f abcdefghijkl

     close $f

     set f [open $path(test1)]

     # here

     set x [read $f 1000]

     close $f

     set x

 } {abcdefghijkl}

 test io-10.5 {Tcl_ReadChars: stop on EOF} {

     # (chanPtr->flags & CHANNEL_EOF)

     set f [open $path(test1) w]

     puts -nonewline $f abcdefghijkl

     close $f

     set f [open $path(test1)]

     # here

     set x [read $f 1000]

     close $f

     set x

 } {abcdefghijkl}

 test io-11.1 {ReadBytes: want to read a lot} {

     # ((unsigned) toRead > (unsigned) srcLen)

     set f [open $path(test1) w]

     puts -nonewline $f abcdefghijkl

     close $f

     set f [open $path(test1)]

     fconfigure $f -encoding binary

     # here

     set x [read $f 1000]

     close $f

     set x

 } {abcdefghijkl}

 test io-11.2 {ReadBytes: want to read all} {

     # ((unsigned) toRead > (unsigned) srcLen)

     set f [open $path(test1) w]

     puts -nonewline $f abcdefghijkl

     close $f

     set f [open $path(test1)]

     fconfigure $f -encoding binary

     # here

     set x [read $f]

     close $f

     set x

 } {abcdefghijkl}

 test io-11.3 {ReadBytes: allocate more space} {

     # (toRead > length - offset - 1)

     set f [open $path(test1) w]

     puts -nonewline $f abcdefghijklmnopqrstuvwxyz

     close $f

     set f [open $path(test1)]

     fconfigure $f -buffersize 16 -encoding binary

     # here

     set x [read $f]

     close $f

     set x

 } {abcdefghijklmnopqrstuvwxyz}

 test io-11.4 {ReadBytes: EOF char found} {

     # (TranslateInputEOL() != 0)

     set f [open $path(test1) w]

     puts $f abcdefghijklmnopqrstuvwxyz

     close $f

     set f [open $path(test1)]

     fconfigure $f -eofchar m -encoding binary

     # here

     set x [list [read $f] [eof $f] [read $f] [eof $f]]

     close $f

     set x

 } [list "abcdefghijkl" 1 "" 1]

 test io-12.1 {ReadChars: want to read a lot} {

     # ((unsigned) toRead > (unsigned) srcLen)

     set f [open $path(test1) w]

     puts -nonewline $f abcdefghijkl

     close $f

     set f [open $path(test1)]

     # here

     set x [read $f 1000]

     close $f

     set x

 } {abcdefghijkl}

 test io-12.2 {ReadChars: want to read all} {

     # ((unsigned) toRead > (unsigned) srcLen)

     set f [open $path(test1) w]

     puts -nonewline $f abcdefghijkl

     close $f

     set f [open $path(test1)]

     # here

     set x [read $f]

     close $f

     set x

 } {abcdefghijkl}

 test io-12.3 {ReadChars: allocate more space} {

     # (toRead > length - offset - 1)

     set f [open $path(test1) w]

     puts -nonewline $f abcdefghijklmnopqrstuvwxyz

     close $f

     set f [open $path(test1)]

     fconfigure $f -buffersize 16

     # here

     set x [read $f]

     close $f

     set x

 } {abcdefghijklmnopqrstuvwxyz}

 test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {

     # (srcRead == 0)

     set f [open "|[list [interpreter] $path(cat)]" w+]

     fconfigure $f -encoding binary -buffering none -buffersize 16

     puts -nonewline $f "123456789012345\x96"

     fconfigure $f -encoding shiftjis -blocking 0

     fileevent $f read [namespace code "ready $f"]

     proc ready {f} {

 	variable x

 	lappend x [read $f] [testchannel inputbuffered $f]

     }

     variable x {}

     fconfigure $f -encoding shiftjis

     vwait [namespace which -variable x]

     fconfigure $f -encoding binary -blocking 1

     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 "\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 "\x89"

 	gets stdin; puts -nonewline "\xa6"

     } test1]

     set f [open "|[list [interpreter] $path(test1)]" r+]

     fileevent $f readable [namespace code {

 	lappend x [read $f]

 	if {[eof $f]} {

 	    lappend x eof

 	}

     }]

     puts $f "go1"

     flush $f

     fconfigure $f -blocking 0 -encoding utf-8

     variable x {}

     vwait [namespace which -variable x]

     after 500 [namespace code { lappend x timeout }]

     vwait [namespace which -variable x]

     puts $f "go2"

     flush $f

     vwait [namespace which -variable x]

     after 500 [namespace code { lappend x timeout }]

     vwait [namespace which -variable x]

     puts $f "go3"

     flush $f

     vwait [namespace which -variable x]

     vwait [namespace which -variable x]

     lappend x [catch {close $f} msg] $msg

     set x

 } "{} timeout {} timeout \u7266 {} eof 0 {}"

 test io-13.1 {TranslateInputEOL: cr mode} {} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\rdef\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation cr

     set x [read $f]

     close $f

     set x

 } "abcd\ndef\n"

 test io-13.2 {TranslateInputEOL: crlf mode} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\r\ndef\r\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [read $f]

     close $f

     set x

 } "abcd\ndef\n"

 test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {

     # (src >= srcMax) 

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\r\ndef\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [read $f]

     close $f

     set x

 } "abcd\ndef\r"

 test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {

     # (src >= srcMax) 

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\r\ndef\rfgh"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [read $f]

     close $f

     set x

 } "abcd\ndef\rfgh"

 test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {

     # (src >= srcMax) 

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\r\ndef\nfgh"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation crlf

     set x [read $f]

     close $f

     set x

 } "abcd\ndef\nfgh"

 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.

     set f [open "|[list [interpreter] $path(cat)]" w+]

     fconfigure $f -blocking 0 -buffering none -translation {auto lf}

     fileevent $f read [namespace code "ready $f"]

     proc ready {f} {

 	variable x

 	lappend x [read $f] [testchannel queuedcr $f]

     }

     variable x {}

     variable y {}

     puts -nonewline $f "abcdefghj\r"

     after 500 [namespace code {set y ok}]

     vwait [namespace which -variable y]

     puts -nonewline $f "\n01234"

     after 500 [namespace code {set y ok}]

     vwait [namespace which -variable y]

     close $f

     set x

 } [list "abcdefghj\n" 1 "01234" 0]

 test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} {

     # (src >= srcMax)

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\r"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [list [read $f] [testchannel queuedcr $f]]

     close $f

     set x

 } [list "abcd\n" 1]

 test io-13.8 {TranslateInputEOL: auto mode: \r\n} {

     # (*src == '\n')

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\r\ndef"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [read $f]

     close $f

     set x

 } "abcd\ndef"

 test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\rdef"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [read $f]

     close $f

     set x

 } "abcd\ndef"

 test io-13.10 {TranslateInputEOL: auto mode: \n} {

     # not (*src == '\r') 

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\ndef"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto

     set x [read $f]

     close $f

     set x

 } "abcd\ndef"

 test io-13.11 {TranslateInputEOL: EOF char} {

     # (*chanPtr->inEofChar != '\0')

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "abcd\ndefgh"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto -eofchar e

     set x [read $f]

     close $f

     set x

 } "abcd\nd"

 test io-13.12 {TranslateInputEOL: find EOF char in src} {

     # (*chanPtr->inEofChar != '\0')

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"

     close $f

     set f [open $path(test1)]

     fconfigure $f -translation auto -eofchar e

     set x [read $f]

     close $f

     set x

 } "\n\n\nab\n\nd"

 # Test standard handle management. The functions tested are

 # Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are

 # also testing channel table management.

 if {[info commands testchannel] != ""} {

     if {$tcl_platform(platform) == "macintosh"} {

 	set consoleFileNames [list console0 console1 console2]

     } else {

 	set consoleFileNames [lsort [testchannel open]]

     }

 } else {

     # just to avoid an error

     set consoleFileNames [list]

 }

 test io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} {

     set l ""

     lappend l [fconfigure stdin -buffering]

     lappend l [fconfigure stdout -buffering]

     lappend l [fconfigure stderr -buffering]

     lappend l [lsort [testchannel open]]

     set l

 } [list line line none $consoleFileNames]

 test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {

     interp create x

     set l ""

     lappend l [x eval {fconfigure stdin -buffering}]

     lappend l [x eval {fconfigure stdout -buffering}]

     lappend l [x eval {fconfigure stderr -buffering}]

     interp delete x

     set l

 } {line line none}

 set path(test3) [makeFile {} test3]

 test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {

     set f [open $path(test1) w]

     puts -nonewline $f {

 	close stdin

 	close stdout

 	close stderr

 	set f  [}

     puts $f [list open $path(test1) r]]

     puts $f "set f2 \[[list open $path(test2) w]]"

     puts $f "set f3 \[[list open $path(test3) w]]"

     puts $f {	puts stdout [gets stdin]

 	puts stdout out

 	puts stderr err

 	close $f

 	close $f2

 	close $f3

     }

     close $f

     set result [exec [interpreter] $path(test1)]

     set f  [open $path(test2) r]

     set f2 [open $path(test3) r]

     lappend result [read $f] [read $f2]

     close $f

     close $f2

     set result

 } {{

 out

 } {err

 }}

 # This test relies on the fact that the smallest available fd is used first.

 test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unixOnly} {

     set f [open $path(test1) w]

     puts -nonewline $f { close stdin

 	close stdout

 	close stderr

 	set f  [}

     puts $f [list open $path(test1) r]]

     puts $f "set f2 \[[list open $path(test2) w]]"

     puts $f "set f3 \[[list open $path(test3) w]]"

     puts $f {	puts stdout [gets stdin]

 	puts stdout $f2

 	puts stderr $f3

 	close $f

 	close $f2

 	close $f3

     }

     close $f

     set result [exec [interpreter] $path(test1)]

     set f  [open $path(test2) r]

     set f2 [open $path(test3) r]

     lappend result [read $f] [read $f2]

     close $f

     close $f2

     set result

 } {{ close stdin

 file1

 } {file2

 }}

 catch {interp delete z}

 test io-14.5 {Tcl_GetChannel: stdio name translation} {

     interp create z

     eof stdin

     catch {z eval flush stdin} msg1

     catch {z eval close stdin} msg2

     catch {z eval flush stdin} msg3

     set result [list $msg1 $msg2 $msg3]

     interp delete z

     set result

 } {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}

 test io-14.6 {Tcl_GetChannel: stdio name translation} {

     interp create z

     eof stdout

     catch {z eval flush stdout} msg1

     catch {z eval close stdout} msg2

     catch {z eval flush stdout} msg3

     set result [list $msg1 $msg2 $msg3]

     interp delete z

     set result

 } {{} {} {can not find channel named "stdout"}}

 test io-14.7 {Tcl_GetChannel: stdio name translation} {

     interp create z

     eof stderr

     catch {z eval flush stderr} msg1

     catch {z eval close stderr} msg2

     catch {z eval flush stderr} msg3

     set result [list $msg1 $msg2 $msg3]

     interp delete z

     set result

 } {{} {} {can not find channel named "stderr"}}

 set path(script) [makeFile {} script]

 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]

     puts -nonewline $f {

 	close stderr

 	set f [}

     puts $f [list open $path(test1) w]]

     puts -nonewline $f {

 	puts stderr hello

 	close $f

 	set f [}

     puts $f [list open $path(test1) r]]

     puts $f {

 	puts [gets $f]

     }

     close $f

     set f [open "|[list [interpreter] $path(script)]" r]

     set c [gets $f]

     close $f

     set c

 } hello

 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]

 	set f [open $path(test1) w]

 	puts $f hello

 	close $f

 	close stderr

 	set f [open "|[list [info nameofexecutable] $path(cat) $path(test1)]" r]

 	puts [gets $f]

     }

     close $f

     set f [open "|[list [interpreter] $path(script) [array get path]]" r]

     set c [gets $f]

     close $f

     # Added delay to give Windows time to stop the spawned process and clean

     # up its grip on the file test1. Added delete as proper test cleanup.

     # The failing tests were 18.1 and 18.2 as first re-users of file "test1".

     after 10000

     file delete $path(script)

     file delete $path(test1)

     set c

 } hello

 test io-15.1 {Tcl_CreateCloseHandler} {

 } {}

 test io-16.1 {Tcl_DeleteCloseHandler} {

 } {}

 # Test channel table management. The functions tested are

 # GetChannelTable, DeleteChannelTable, Tcl_RegisterChannel,

 # Tcl_UnregisterChannel, Tcl_GetChannel and Tcl_CreateChannel.

 #

 # These functions use "eof stdin" to ensure that the standard

 # channels are added to the channel table of the interpreter.

 test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {

     set l1 [testchannel refcount stdin]

     eof stdin

     interp create x

     set l ""

     lappend l [expr [testchannel refcount stdin] - $l1]

     x eval {eof stdin}

     lappend l [expr [testchannel refcount stdin] - $l1]

     interp delete x

     lappend l [expr [testchannel refcount stdin] - $l1]

     set l

 } {0 1 0}

 test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {

     set l1 [testchannel refcount stdout]

     eof stdin

     interp create x

     set l ""

     lappend l [expr [testchannel refcount stdout] - $l1]

     x eval {eof stdout}

     lappend l [expr [testchannel refcount stdout] - $l1]

     interp delete x

     lappend l [expr [testchannel refcount stdout] - $l1]

     set l

 } {0 1 0}

 test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {

     set l1 [testchannel refcount stderr]

     eof stdin

     interp create x

     set l ""

     lappend l [expr [testchannel refcount stderr] - $l1]

     x eval {eof stderr}

     lappend l [expr [testchannel refcount stderr] - $l1]

     interp delete x

     lappend l [expr [testchannel refcount stderr] - $l1]

     set l

 } {0 1 0}

 test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {

     file delete $path(test1)

     set l ""

     set f [open $path(test1) w]

     lappend l [lindex [testchannel info $f] 15]

     close $f

     if {[catch {lindex [testchannel info $f] 15} msg]} {

 	lappend l $msg

     } else {

 	lappend l "very broken: $f found after being closed"

     }

     string compare [string tolower $l] \

 	[list 1 [format "can not find channel named \"%s\"" $f]]

 } 0

 test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {

     file delete $path(test1)

     set l ""

     set f [open $path(test1) w]

     lappend l [lindex [testchannel info $f] 15]

     interp create x

     interp share "" $f x

     lappend l [lindex [testchannel info $f] 15]

     x eval close $f

     lappend l [lindex [testchannel info $f] 15]

     interp delete x

     lappend l [lindex [testchannel info $f] 15]

     close $f

     if {[catch {lindex [testchannel info $f] 15} msg]} {

 	lappend l $msg

     } else {

 	lappend l "very broken: $f found after being closed"

     }

     string compare [string tolower $l] \

 	[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]

 } 0

 test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {

     file delete $path(test1)

     set l ""

     set f [open $path(test1) w]

     lappend l [lindex [testchannel info $f] 15]

     interp create x

     interp share "" $f x

     lappend l [lindex [testchannel info $f] 15]

     interp delete x

     lappend l [lindex [testchannel info $f] 15]

     close $f

     if {[catch {lindex [testchannel info $f] 15} msg]} {

 	lappend l $msg

     } else {

 	lappend l "very broken: $f found after being closed"

     }

     string compare [string tolower $l] \

 	[list 1 2 1 [format "can not find channel named \"%s\"" $f]]

 } 0

 test io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {

     eof stdin

 } 0

 test io-19.2 {testing Tcl_GetChannel, user opened handle} {

     file delete $path(test1)

     set f [open $path(test1) w]

     set x [eof $f]

     close $f

     set x

 } 0

 test io-19.3 {Tcl_GetChannel, channel not found} {

     list [catch {eof file34} msg] $msg

 } {1 {can not find channel named "file34"}}

 test io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     set l ""

     lappend l [eof $f]

     close $f

     if {[catch {lindex [testchannel info $f] 15} msg]} {

 	lappend l $msg

     } else {

 	lappend l "very broken: $f found after being closed"

     }

     string compare [string tolower $l] \

 	[list 0 [format "can not find channel named \"%s\"" $f]]

 } 0

 test io-20.1 {Tcl_CreateChannel: initial settings} {

 	set a [open $path(test2) w]

     set old [encoding system]

     encoding system ascii

     set f [open $path(test1) w]

     set x [fconfigure $f -encoding]

     close $f

     encoding system $old

 	close $a

     set x

 } {ascii}    

 test io-20.2 {Tcl_CreateChannel: initial settings} {pcOnly} {

     set f [open $path(test1) w+]

     set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]

     close $f

     set x

 } [list [list \x1a ""] {auto crlf}]

 test io-20.3 {Tcl_CreateChannel: initial settings} {unixOnly} {

     set f [open $path(test1) w+]

     set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]

     close $f

     set x

 } {{{} {}} {auto lf}}

 test io-20.4 {Tcl_CreateChannel: initial settings} {macOnly} {

     set f [open $path(test1) w+]

     set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]

     close $f

     set x

 } {{{} {}} {auto cr}}

 set path(stdout) [makeFile {} stdout]

 test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} {

     set f [open $path(script) w]

     puts -nonewline $f {

 	close stdout

 	set f1 [}

     puts $f [list open $path(stdout) w]]

     puts $f {

 	fconfigure $f1 -buffersize 777

 	puts stderr [fconfigure stdout -buffersize]

     }

     close $f

     set f [open "|[list [interpreter] $path(script)]"]

     catch {close $f} msg

     set msg

 } {777}

 test io-21.1 {CloseChannelsOnExit} {

 } {}

 # Test management of attributes associated with a channel, such as

 # its default translation, its name and type, etc. The functions

 # tested in this group are Tcl_GetChannelName,

 # Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData

 # not tested because files do not use the instance data.

 test io-22.1 {Tcl_GetChannelMode} {

     # Not used anywhere in Tcl.

 } {}

 test io-23.1 {Tcl_GetChannelName} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     set n [testchannel name $f]

     close $f

     string compare $n $f

 } 0

 test io-24.1 {Tcl_GetChannelType} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     set t [testchannel type $f]

     close $f

     string compare $t file

 } 0

 test io-25.1 {Tcl_GetChannelHandle, input} {testchannel} {

     set f [open $path(test1) w]

     fconfigure $f -translation lf -eofchar {}

     puts $f "1234567890\n098765432"

     close $f

     set f [open $path(test1) r]

     gets $f

     set l ""

     lappend l [testchannel inputbuffered $f]

     lappend l [tell $f]

     close $f

     set l

 } {10 11}

 test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf

     puts $f hello

     set l ""

     lappend l [testchannel outputbuffered $f]

     lappend l [tell $f]

     flush $f

     lappend l [testchannel outputbuffered $f]

     lappend l [tell $f]

     close $f

     file delete $path(test1)

     set l

 } {6 6 0 6}

 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]

     close $f

 } {}    

 # Test flushing. The functions tested here are FlushChannel.

 test io-27.1 {FlushChannel, no output buffered} {

     file delete $path(test1)

     set f [open $path(test1) w]

     flush $f

     set s [file size $path(test1)]

     close $f

     set s

 } 0

 test io-27.2 {FlushChannel, some output buffered} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -eofchar {}

     set l ""

     puts $f hello

     lappend l [file size $path(test1)]

     flush $f

     lappend l [file size $path(test1)]

     close $f

     lappend l [file size $path(test1)]

     set l

 } {0 6 6}

 test io-27.3 {FlushChannel, implicit flush on close} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -eofchar {}

     set l ""

     puts $f hello

     lappend l [file size $path(test1)]

     close $f

     lappend l [file size $path(test1)]

     set l

 } {0 6}

 test io-27.4 {FlushChannel, implicit flush when buffer fills} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -eofchar {}

     fconfigure $f -buffersize 60

     set l ""

     lappend l [file size $path(test1)]

     for {set i 0} {$i < 12} {incr i} {

 	puts $f hello

     }

     lappend l [file size $path(test1)]

     flush $f

     lappend l [file size $path(test1)]

     close $f

     set l

 } {0 60 72}

 test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \

 	{unixOrPc} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -buffersize 60 -eofchar {}

     set l ""

     lappend l [file size $path(test1)]

     for {set i 0} {$i < 12} {incr i} {

 	puts $f hello

     }

     lappend l [file size $path(test1)]

     close $f

     lappend l [file size $path(test1)]

     set l

 } {0 60 72}

 set path(pipe)   [makeFile {} pipe]

 set path(output) [makeFile {} output]

 test io-27.6 {FlushChannel, async flushing, async close} \

 	{stdio asyncPipeClose openpipe} {

     file delete $path(pipe)

     file delete $path(output)

     set f [open $path(pipe) w]

     puts $f "set f \[[list open $path(output) w]]"

     puts $f {

 	fconfigure $f -translation lf -buffering none -eofchar {}

 	while {![eof stdin]} {

 	    after 20

 	    puts -nonewline $f [read stdin 1024]

 	}

 	close $f

     }

     close $f

     set x 01234567890123456789012345678901

     for {set i 0} {$i < 11} {incr i} {

         set x "$x$x"

     }

     set f [open $path(output) w]

     close $f

     set f [open "|[list [interpreter] $path(pipe)]" w]

     fconfigure $f -blocking off

     puts -nonewline $f $x

     close $f

     set counter 0

     while {([file size $path(output)] < 65536) && ($counter < 1000)} {

         incr counter

         after 20

         update

     }

     if {$counter == 1000} {

         set result "file size only [file size $path(output)]"

     } else {

         set result ok

     }

 } ok

 # Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.

 test io-28.1 {CloseChannel called when all references are dropped} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     interp create x

     interp share "" $f x

     set l ""

     lappend l [testchannel refcount $f]

     x eval close $f

     interp delete x

     lappend l [testchannel refcount $f]

     close $f

     set l

 } {2 1}

 test io-28.2 {CloseChannel called when all references are dropped} {

     file delete $path(test1)

     set f [open $path(test1) w]

     interp create x

     interp share "" $f x

     puts -nonewline $f abc

     close $f

     x eval puts $f def

     x eval close $f

     interp delete x

     set f [open $path(test1) r]

     set l [gets $f]

     close $f

     set l

 } abcdef

 test io-28.3 {CloseChannel, not called before output queue is empty} \

 	{stdio asyncPipeClose nonPortable openpipe} {

     file delete $path(pipe)

     file delete $path(output)

     set f [open $path(pipe) w]

     puts $f {

 	# Need to not have eof char appended on close, because the other

 	# side of the pipe already closed, so that writing would cause an

 	# error "invalid file".

 	fconfigure stdout -eofchar {}

 	fconfigure stderr -eofchar {}

 	set f [open $path(output) w]

 	fconfigure $f -translation lf -buffering none

 	for {set x 0} {$x < 20} {incr x} {

 	    after 20

 	    puts -nonewline $f [read stdin 1024]

 	}

 	close $f

     }

     close $f

     set x 01234567890123456789012345678901

     for {set i 0} {$i < 11} {incr i} {

         set x "$x$x"

     }

     set f [open $path(output) w]

     close $f

     set f [open "|[list [interpreter] pipe]" r+]

     fconfigure $f -blocking off -eofchar {}

     puts -nonewline $f $x

     close $f

     set counter 0

     while {([file size $path(output)] < 20480) && ($counter < 1000)} {

         incr counter

         after 20

         update

     }

     if {$counter == 1000} {

         set result probably_broken

     } else {

         set result ok

     }

 } ok

 test io-28.4 {Tcl_Close} {testchannel} {

     file delete $path(test1)

     set l ""

     lappend l [lsort [testchannel open]]

     set f [open $path(test1) w]

     lappend l [lsort [testchannel open]]

     close $f

     lappend l [lsort [testchannel open]]

     set x [list $consoleFileNames \

 		[lsort [eval list $consoleFileNames $f]] \

 		$consoleFileNames]

     string compare $l $x

 } 0

 test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly testchannel openpipe} {

     file delete $path(script)

     set f [open $path(script) w]

     puts $f {

 	close stdin

 	puts [testchannel open]

     }

     close $f

     set f [open "|[list [interpreter] $path(script)]" r]

     set l [gets $f]

     close $f

     set l

 } {file1 file2}

 test io-29.1 {Tcl_WriteChars, channel not writable} {

     list [catch {puts stdin hello} msg] $msg

 } {1 {channel "stdin" wasn't opened for writing}}

 test io-29.2 {Tcl_WriteChars, empty string} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -eofchar {}

     puts -nonewline $f ""

     close $f

     file size $path(test1)

 } 0

 test io-29.3 {Tcl_WriteChars, nonempty string} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -eofchar {}

     puts -nonewline $f hello

     close $f

     file size $path(test1)

 } 5

 test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -buffering full -eofchar {}

     puts $f hello

     set l ""

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     flush $f

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     close $f

     set l

 } {6 0 0 6}

 test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -buffering line -eofchar {}

     puts -nonewline $f hello

     set l ""

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     puts $f hello

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     close $f

     set l

 } {5 0 0 11}

 test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -buffering none -eofchar {}

     puts -nonewline $f hello

     set l ""

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     puts $f hello

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     close $f

     set l

 } {0 5 0 11}

 test io-29.7 {Tcl_Flush, full buffering} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -buffering full -eofchar {}

     puts -nonewline $f hello

     set l ""

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     puts $f hello

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     flush $f

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     close $f

     set l

 } {5 0 11 0 0 11}

 test io-29.8 {Tcl_Flush, full buffering} {testchannel} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -buffering line

     puts -nonewline $f hello

     set l ""

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     flush $f

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     puts $f hello

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     flush $f

     lappend l [testchannel outputbuffered $f]

     lappend l [file size $path(test1)]

     close $f

     set l

 } {5 0 0 5 0 11 0 11}

 test io-29.9 {Tcl_Flush, channel not writable} {

     list [catch {flush stdin} msg] $msg

 } {1 {channel "stdin" wasn't opened for writing}}

 test io-29.10 {Tcl_WriteChars, looping and buffering} {

     file delete $path(test1)

     set f1 [open $path(test1) w]

     fconfigure $f1 -translation lf -eofchar {}

     set f2 [open $path(longfile) r]

     for {set x 0} {$x < 10} {incr x} {

 	puts $f1 [gets $f2]

     }

     close $f2

     close $f1

     file size $path(test1)

 } 387

 test io-29.11 {Tcl_WriteChars, no newline, implicit flush} {

     file delete $path(test1)

     set f1 [open $path(test1) w]

     fconfigure $f1 -eofchar {}

     set f2 [open $path(longfile) r]

     for {set x 0} {$x < 10} {incr x} {

 	puts -nonewline $f1 [gets $f2]

     }

     close $f1

     close $f2

     file size $path(test1)

 } 377

 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]

     puts $f1 "set f1 \[[list open $path(longfile) r]]"

     puts $f1 {

 	for {set x 0} {$x < 10} {incr x} {

 	    puts [gets $f1]

 	}

     }

     close $f1

     set f1 [open "|[list [interpreter] $path(pipe)]" r]

     set f2 [open $path(longfile) r]

     set y ok

     for {set x 0} {$x < 10} {incr x} {

 	set l1 [gets $f1]

 	set l2 [gets $f2]

 	if {"$l1" != "$l2"} {

 	    set y broken

 	}

     }

     close $f1

     close $f2

     set y

 } ok

 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]

     puts $f1 {

 	puts [gets stdin]

 	puts [gets stdin]

     }

     close $f1

     set y ok

     set f1 [open "|[list [interpreter] $path(pipe)]" r+]

     fconfigure $f1 -buffering line

     set f2 [open $path(longfile) r]

     set line [gets $f2]

     puts $f1 $line

     set backline [gets $f1]

     if {"$line" != "$backline"} {

 	set y broken

     }

     set line [gets $f2]

     puts $f1 $line

     set backline [gets $f1]

     if {"$line" != "$backline"} {

 	set y broken

     }

     close $f1

     close $f2

     set y

 } ok

 test io-29.14 {Tcl_WriteChars, buffering and implicit flush at close} {

     file delete $path(test3)

     set f [open $path(test3) w]

     puts -nonewline $f "Text1"

     puts -nonewline $f " Text 2"

     puts $f " Text 3"

     close $f

     set f [open $path(test3) r]

     set x [gets $f]

     close $f

     set x

 } {Text1 Text 2 Text 3}

 test io-29.15 {Tcl_Flush, channel not open for writing} {

     file delete $path(test1)

     set fd [open $path(test1) w]

     close $fd

     set fd [open $path(test1) r]

     set x [list [catch {flush $fd} msg] $msg]

     close $fd

     string compare $x \

 	[list 1 "channel \"$fd\" wasn't opened for writing"]

 } 0

 test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} {

     set fd [open "|[list [interpreter] cat longfile]" r]

     set x [list [catch {flush $fd} msg] $msg]

     catch {close $fd}

     string compare $x \

 	[list 1 "channel \"$fd\" wasn't opened for writing"]

 } 0

 test io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} {

     file delete $path(test1)

     set f1 [open $path(test1) w]

     fconfigure $f1 -translation lf

     puts $f1 hello

     puts $f1 hello

     puts $f1 hello

     flush $f1

     set x [file size $path(test1)]

     close $f1

     set x

 } 18

 test io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} {

     file delete $path(test1)

     set x ""

     set f1 [open $path(test1) w]

     fconfigure $f1 -translation lf

     puts $f1 hello

     puts $f1 hello

     puts $f1 hello

     flush $f1

     lappend x [file size $path(test1)]

     puts $f1 hello

     flush $f1

     lappend x [file size $path(test1)]

     puts $f1 hello

     flush $f1

     lappend x [file size $path(test1)]

     close $f1

     set x

 } {18 24 30}

 test io-29.19 {Explicit and implicit flushes} {

     file delete $path(test1)

     set f1 [open $path(test1) w]

     fconfigure $f1 -translation lf -eofchar {}

     set x ""

     puts $f1 hello

     puts $f1 hello

     puts $f1 hello

     flush $f1

     lappend x [file size $path(test1)]

     puts $f1 hello

     flush $f1

     lappend x [file size $path(test1)]

     puts $f1 hello

     close $f1

     lappend x [file size $path(test1)]

     set x

 } {18 24 30}

 test io-29.20 {Implicit flush when buffer is full} {

     file delete $path(test1)

     set f1 [open $path(test1) w]

     fconfigure $f1 -translation lf -eofchar {}

     set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"

     for {set x 0} {$x < 100} {incr x} {

       puts $f1 $line

     }

     set z ""

     lappend z [file size $path(test1)]

     for {set x 0} {$x < 100} {incr x} {

 	puts $f1 $line

     }

     lappend z [file size $path(test1)]

     close $f1

     lappend z [file size $path(test1)]

     set z

 } {4096 12288 12600}

 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]}

     puts $f1 {set cnt [string length $x]}

     puts $f1 {puts "read $cnt characters"}

     close $f1

     set f1 [open "|[list [interpreter] $path(pipe)]" r+]

     puts $f1 hello

     flush $f1

     set x [gets $f1]

     catch {close $f1}

     set x

 } "read 6 characters"

 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 {

 	fconfigure stdout -buffering full

 	puts hello

 	puts hello

 	flush stdout

 	gets stdin

 	puts bye

 	flush stdout

     }

     close $f1

     set f1 [open "|[list [interpreter] $path(pipe)]" r+]

     set x ""

     lappend x [gets $f1]

     lappend x [gets $f1]

     puts $f1 hello

     flush $f1

     lappend x [gets $f1]

     close $f1

     set x

 } {hello hello bye}

 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 {

 	puts hello

 	puts hello

 	gets stdin

 	puts bye

     }

     close $f1

     set f1 [open "|[list [interpreter] $path(pipe)]" r+]

     set x ""

     lappend x [gets $f1]

     lappend x [gets $f1]

     puts $f1 hello

     flush $f1

     lappend x [gets $f1]

     close $f1

     set x

 } {hello hello bye}

 test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {

     set f [open $path(test3) w]

     puts $f "Line 1"

     puts $f "Line 2"

     set f2 [open $path(test3)]

     set x {}

     lappend x [read -nonewline $f2]

     close $f2

     flush $f

     set f2 [open $path(test3)]

     lappend x [read -nonewline $f2]

     close $f2

     close $f

     set x

 } "{} {Line 1\nLine 2}"

 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"

     puts $f "Line 2"

     close $f

     after 100

     set f [open $path(test3) r]

     set x [read $f]

     close $f

     set x

 } "Line 1\nLine 2\n"

 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

     set x [gets $f]

     close $f

     set x

 } {Line1}

 test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} {

     file delete $path(pipe)

     set f [open $path(pipe) w]

     puts $f {exit}

     close $f

     set f [open "|[list [interpreter] $path(pipe)]" r+]

     gets $f

     puts $f output

     after 50

     #

     # The flush below will get a SIGPIPE. This is an expected part of

     # test and indicates that the test operates correctly. If you run

     # this test under a debugger, the signal will by intercepted unless

     # you disable the debugger's signal interception.

     #

     if {[catch {flush $f} msg]} {

 	set x [list 1 $msg $errorCode]

 	catch {close $f}

     } else {

 	if {[catch {close $f} msg]} {

 	    set x [list 1 $msg $errorCode]

 	} else {

 	    set x {this was supposed to fail and did not}

 	}

     }

     regsub {".*":} $x {"":} x

     string tolower $x

 } {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}

 test io-29.28 {Tcl_WriteChars, lf mode} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation lf -eofchar {}

     puts $f hello\nthere\nand\nhere

     flush $f

     set s [file size $path(test1)]

     close $f

     set s

 } 21

 test io-29.29 {Tcl_WriteChars, cr mode} {

     file delete $path(test1)

     set f [open $path(test1) w]

     fconfigure $f -translation cr -eofchar {}

     puts $f hello\nthere\nand\nhere