diff options
| -rw-r--r-- | tests/chanio.test | 322 |
1 files changed, 80 insertions, 242 deletions
diff --git a/tests/chanio.test b/tests/chanio.test index 7e0bda4..5ac00cb 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -2,18 +2,18 @@ # 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. +# 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. +# See the file "license.terms" for information on usage and redistribution of +# this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: chanio.test,v 1.17 2008/12/18 09:43:44 ferrieux Exp $ +# RCS: @(#) $Id: chanio.test,v 1.18 2008/12/18 11:48:58 dkf Exp $ if {[catch {package require tcltest 2}]} { chan puts stderr "Skipping tests in [info script]. tcltest 2 required." @@ -92,7 +92,7 @@ namespace eval ::tcl::test::io { chan close $f return $a } - + test chan-io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} { # no test, need to cause an async error. } {} @@ -115,68 +115,49 @@ set path(test2) [makeFile {} test2] test chan-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. - + # 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] chan configure $f -encoding iso2022-jp chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399] chan close $f contents $path(test2) } " \x1b\$B\$O\x1b(B" - test chan-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. - + # 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] chan configure $f -encoding iso2022-jp chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] - - # With buffer size equal to the length - # of the data, the escape bytes would + # 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] chan configure $f -encoding iso2022-jp -buffersize 16 chan puts -nonewline $f $data chan 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. - + # 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] chan configure $f -encoding iso2022-jp -buffersize 17 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] - - # With buffer size that can hold 2 out of - # 3 bytes of escaped data. - + # With buffer size that can hold 2 out of 3 bytes of escaped data. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 18 chan puts -nonewline $f $data chan close $f lappend sizes [file size $path(test2)] - - # With buffer size that can hold all the - # data and escape bytes. - + # With buffer size that can hold all the data and escape bytes. set f [open $path(test2) w] chan configure $f -encoding iso2022-jp -buffersize 19 chan puts -nonewline $f $data @@ -186,7 +167,6 @@ test chan-io-1.9 {Tcl_WriteChars: WriteChars} { test chan-io-2.1 {WriteBytes} { # loop until all bytes are written - set f [open $path(test1) w] chan configure $f -encoding binary -buffersize 16 -translation crlf chan puts $f "abcdefghijklmnopqrstuvwxyz" @@ -196,7 +176,6 @@ test chan-io-2.1 {WriteBytes} { test chan-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] chan configure $f -encoding binary -buffersize 16 -translation crlf chan puts -nonewline $f "123456789012345\n12" @@ -208,7 +187,6 @@ test chan-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] chan configure $f -encoding binary -buffering line -translation crlf chan puts -nonewline $f "\n12" @@ -228,7 +206,6 @@ test chan-io-2.4 {WriteBytes: reset sawLF after each buffer} { test chan-io-3.1 {WriteChars: compatibility with WriteBytes} { # loop until all bytes are written - set f [open $path(test1) w] chan configure $f -encoding ascii -buffersize 16 -translation crlf chan puts $f "abcdefghijklmnopqrstuvwxyz" @@ -238,7 +215,6 @@ test chan-io-3.1 {WriteChars: compatibility with WriteBytes} { test chan-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] chan configure $f -encoding ascii -buffersize 16 -translation crlf chan puts -nonewline $f "123456789012345\n12" @@ -250,7 +226,6 @@ test chan-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] chan configure $f -encoding ascii -buffering line -translation crlf chan puts -nonewline $f "\n12" @@ -260,7 +235,6 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} { } "\r\n12" test chan-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] chan configure $f -encoding jis0208 -buffersize 16 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" @@ -269,10 +243,9 @@ test chan-io-3.4 {WriteChars: loop over stage buffer} { lappend x [contents $path(test1)] } [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test chan-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. - + # 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] chan configure $f -encoding jis0208 -buffersize 17 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" @@ -281,15 +254,14 @@ test chan-io-3.5 {WriteChars: saved != 0} { lappend x [contents $path(test1)] } [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"] test chan-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. + # 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 + # (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. - + # 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] chan configure $f -encoding shiftjis -buffersize 16 chan puts -nonewline $f "12345678901234\uff21\uff22" @@ -298,12 +270,11 @@ test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} { lappend x [contents $path(test1)] } [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"] test chan-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. - + # When translating UTF-8 to external, the produced bytes went past end of + # the channel buffer. This is done on 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] chan configure $f -encoding jis0208 -buffersize 17 chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\" @@ -323,7 +294,6 @@ test chan-io-3.8 {WriteChars: reset sawLF after each buffer} { test chan-io-4.1 {TranslateOutputEOL: lf} { # search for \n - set f [open $path(test1) w] chan configure $f -buffering line -translation lf chan puts $f "abcde" @@ -333,7 +303,6 @@ test chan-io-4.1 {TranslateOutputEOL: lf} { } [list "abcde\n" "abcde\n"] test chan-io-4.2 {TranslateOutputEOL: cr} { # search for \n, replace with \r - set f [open $path(test1) w] chan configure $f -buffering line -translation cr chan puts $f "abcde" @@ -343,7 +312,6 @@ test chan-io-4.2 {TranslateOutputEOL: cr} { } [list "abcde\r" "abcde\r"] test chan-io-4.3 {TranslateOutputEOL: crlf} { # simple case: search for \n, replace with \r - set f [open $path(test1) w] chan configure $f -buffering line -translation crlf chan puts $f "abcde" @@ -352,10 +320,9 @@ test chan-io-4.3 {TranslateOutputEOL: crlf} { lappend x [contents $path(test1)] } [list "abcde\r\n" "abcde\r\n"] test chan-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). - + # 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] chan configure $f -translation crlf -buffersize 16 chan puts -nonewline $f "1234567\n\n\n\n\nA" @@ -365,7 +332,6 @@ test chan-io-4.4 {TranslateOutputEOL: crlf} { } [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"] test chan-io-4.5 {TranslateOutputEOL: crlf} { # Check for overflow of the destination buffer - set f [open $path(test1) w] chan configure $f -translation crlf -buffersize 12 chan puts -nonewline $f "12345678901\n456789012345678901234" @@ -428,7 +394,6 @@ test chan-io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} emptyTest { } {} test chan-io-6.3 {Tcl_GetsObj: how many have we used?} { # if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved} - set f [open $path(test1) w] chan configure $f -translation crlf chan puts $f "abc\ndefg" @@ -465,7 +430,6 @@ append a $a append a $a test chan-io-6.6 {Tcl_GetsObj: loop test} { # if (dst >= dstEnd) - set f [open $path(test1) w] chan puts $f $a chan puts $f hi @@ -477,7 +441,6 @@ test chan-io-6.6 {Tcl_GetsObj: loop test} { } [list 256 $a] test chan-io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} { # if (FilterInputBytes(chanPtr, &gs) != 0) - set f [open "|[list [interpreter] $path(cat)]" w+] chan puts -nonewline $f "hi\nwould" chan flush $f @@ -724,7 +687,6 @@ test chan-io-6.29 {Tcl_GetsObj: crlf mode: several chars} { } [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""] test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} { # if (eol >= dstEnd) - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz" @@ -737,7 +699,6 @@ test chan-io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} { } [list 15 "123456789012345" 15] test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} { # (FilterInputBytes() != 0) - set f [open "|[list [interpreter] $path(cat)]" w+] chan configure $f -translation {crlf lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r" @@ -750,7 +711,6 @@ test chan-io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio tes } [list "bbbbbbbbbbbbbb" -1 "" 1 16] test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} { # not (FilterInputBytes() != 0) - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r\n123" @@ -763,7 +723,6 @@ test chan-io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testcha } [list 15 "123456789012345" 17 3] test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} { # eol still equals dstEnd - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r" @@ -776,7 +735,6 @@ test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} { } [list 16 "123456789012345\r" 1] test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} { # not (*eol == '\n') - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\rabcd\r\nefg" @@ -876,7 +834,6 @@ test chan-io-6.42 {Tcl_GetsObj: auto mode: several chars} { } [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""] test chan-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+] chan configure $f -translation {auto lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" @@ -893,7 +850,6 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileev } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test chan-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+] chan configure $f -translation {auto lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" @@ -910,7 +866,6 @@ test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testcha } [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"] test chan-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+] chan configure $f -translation {auto lf} -buffering none chan configure $f -encoding unicode @@ -927,7 +882,6 @@ test chan-io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio } [list 15 "123456789abcdef" 1 4 "abcd" 0] test chan-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+] chan configure $f -translation {auto lf} -buffering none chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r" @@ -943,7 +897,6 @@ test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eo } [list 15 "123456789abcdef" 1 -1 "" 0] test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} { # (eol == dstEnd) - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq" @@ -956,7 +909,6 @@ test chan-io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {te } [list "123456789012345" 15] test chan-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] chan configure $f -translation lf chan puts -nonewline $f "123456789012345\r" @@ -969,7 +921,6 @@ test chan-io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} { } [list "123456789012345" 1] test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { # if (*eol == '\n') {skip++} - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\r\n78901" @@ -981,7 +932,6 @@ test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} { } [list "123456" 0 8 "78901"] test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} { # not (*eol == '\n') - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\r78901" @@ -993,7 +943,6 @@ test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} } [list "123456" 0 7 "78901"] test chan-io-6.51 {Tcl_GetsObj: auto mode: \n} { # else if (*eol == '\n') {goto gotoeol;} - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\n78901" @@ -1005,7 +954,6 @@ test chan-io-6.51 {Tcl_GetsObj: auto mode: \n} { } [list "123456" 7 "78901"] test chan-io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} { # if (eof != NULL) - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "123456\x1ak9012345\r" @@ -1018,7 +966,6 @@ test chan-io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} { } [list "123456" 0 6 ""] test chan-io-6.53 {Tcl_GetsObj: device EOF} { # didn't produce any bytes - set f [open $path(test1) w] chan close $f set f [open $path(test1)] @@ -1028,7 +975,6 @@ test chan-io-6.53 {Tcl_GetsObj: device EOF} { } {-1 {} 1} test chan-io-6.54 {Tcl_GetsObj: device EOF} { # got some bytes before EOF. - set f [open $path(test1) w] chan puts -nonewline $f abc chan close $f @@ -1039,7 +985,6 @@ test chan-io-6.54 {Tcl_GetsObj: device EOF} { } {3 abc 1} test chan-io-6.55 {Tcl_GetsObj: overconverted} { # Tcl_ExternalToUtf(), make sure state updated - set f [open $path(test1) w] chan configure $f -encoding iso2022-jp chan puts $f "there\u4e00ok\n\u4e01more bytes\nhere" @@ -1073,7 +1018,6 @@ test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {st test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} { # (result == TCL_CONVERT_MULTIBYTE) - set f [open $path(test1) w] chan configure $f -encoding shiftjis chan puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend" @@ -1086,7 +1030,6 @@ test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} { } "1234567890123\uff10\uff11\uff12\uff13\uff14" test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} { # (bufPtr->nextAdded < bufPtr->bufLength) - set f [open $path(test1) w] chan configure $f -encoding binary chan puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82" @@ -1132,7 +1075,6 @@ test chan-io-7.4 {FilterInputBytes: recover from split up character} {stdio open test chan-io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} { # (bufPtr->nextPtr == NULL) - set f [open $path(test1) w] chan configure $f -encoding ascii -translation lf chan puts -nonewline $f "123456789012345\r\n2345678" @@ -1147,7 +1089,6 @@ test chan-io-8.1 {PeekAhead: only go to device if no more cached data} {testchan } "7" test chan-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+] chan configure $f -translation lf -encoding ascii -buffering none chan puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz" @@ -1167,7 +1108,6 @@ test chan-io-8.2 {PeekAhead: only go to device if no more cached data} {stdio te } [list -1 "" 42 15 "123456789012345" 25] test chan-io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} { # (bytesLeft == 0) - set f [open "|[list [interpreter] $path(cat)]" w+] chan configure $f -translation {auto binary} chan puts -nonewline $f "abcdefghijklmno\r" @@ -1181,18 +1121,15 @@ append a "123456789012345678901234567890" append a "1234567890123456789012345678901" test chan-io-8.4 {PeekAhead: cached data available in this buffer} { # not (bytesLeft == 0) - set f [open $path(test1) w+] chan configure $f -translation binary chan puts $f "${a}\r\nabcdef" chan close $f set f [open $path(test1)] chan configure $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. - + # "${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 [chan gets $f] chan close $f set x @@ -1200,7 +1137,6 @@ test chan-io-8.4 {PeekAhead: cached data available in this buffer} { unset a test chan-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+] chan configure $f -translation {auto binary} chan puts -nonewline $f "abcdefghijklmno\r" @@ -1212,7 +1148,6 @@ test chan-io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchann } {15 abcdefghijklmno 1} test chan-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+] chan configure $f -translation {auto binary} -buffersize 16 chan puts -nonewline $f "abcdefghijklmno\r" @@ -1224,7 +1159,6 @@ test chan-io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel ope } {15 abcdefghijklmno 1} test chan-io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} { # Make sure bytes are removed from buffer. - set f [open "|[list [interpreter] $path(cat)]" w+] chan configure $f -translation {auto binary} -buffering none chan puts -nonewline $f "abcdefghijklmno\r" @@ -1245,11 +1179,9 @@ test chan-io-10.1 {Tcl_ReadChars: CheckChannelErrors} emptyTest { test chan-io-10.2 {Tcl_ReadChars: loop until enough copied} { # one time # for (copied = 0; (unsigned) toRead > 0; ) - set f [open $path(test1) w] chan puts $f abcdefghijklmnop chan close $f - set f [open $path(test1)] set x [chan read $f 5] chan close $f @@ -1258,11 +1190,9 @@ test chan-io-10.2 {Tcl_ReadChars: loop until enough copied} { test chan-io-10.3 {Tcl_ReadChars: loop until enough copied} { # multiple times # for (copied = 0; (unsigned) toRead > 0; ) - set f [open $path(test1) w] chan puts $f abcdefghijklmnopqrstuvwxyz chan close $f - set f [open $path(test1)] chan configure $f -buffersize 16 # here @@ -1272,11 +1202,9 @@ test chan-io-10.3 {Tcl_ReadChars: loop until enough copied} { } {abcdefghijklmnopqrs} test chan-io-10.4 {Tcl_ReadChars: no more in channel buffer} { # (copiedNow < 0) - set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f - set f [open $path(test1)] # here set x [chan read $f 1000] @@ -1285,11 +1213,9 @@ test chan-io-10.4 {Tcl_ReadChars: no more in channel buffer} { } {abcdefghijkl} test chan-io-10.5 {Tcl_ReadChars: stop on EOF} { # (chanPtr->flags & CHANNEL_EOF) - set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f - set f [open $path(test1)] # here set x [chan read $f 1000] @@ -1299,7 +1225,6 @@ test chan-io-10.5 {Tcl_ReadChars: stop on EOF} { test chan-io-11.1 {ReadBytes: want to read a lot} { # ((unsigned) toRead > (unsigned) srcLen) - set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f @@ -1312,7 +1237,6 @@ test chan-io-11.1 {ReadBytes: want to read a lot} { } {abcdefghijkl} test chan-io-11.2 {ReadBytes: want to read all} { # ((unsigned) toRead > (unsigned) srcLen) - set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f @@ -1325,7 +1249,6 @@ test chan-io-11.2 {ReadBytes: want to read all} { } {abcdefghijkl} test chan-io-11.3 {ReadBytes: allocate more space} { # (toRead > length - offset - 1) - set f [open $path(test1) w] chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz chan close $f @@ -1338,7 +1261,6 @@ test chan-io-11.3 {ReadBytes: allocate more space} { } {abcdefghijklmnopqrstuvwxyz} test chan-io-11.4 {ReadBytes: EOF char found} { # (TranslateInputEOL() != 0) - set f [open $path(test1) w] chan puts $f abcdefghijklmnopqrstuvwxyz chan close $f @@ -1352,7 +1274,6 @@ test chan-io-11.4 {ReadBytes: EOF char found} { test chan-io-12.1 {ReadChars: want to read a lot} { # ((unsigned) toRead > (unsigned) srcLen) - set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f @@ -1364,7 +1285,6 @@ test chan-io-12.1 {ReadChars: want to read a lot} { } {abcdefghijkl} test chan-io-12.2 {ReadChars: want to read all} { # ((unsigned) toRead > (unsigned) srcLen) - set f [open $path(test1) w] chan puts -nonewline $f abcdefghijkl chan close $f @@ -1376,7 +1296,6 @@ test chan-io-12.2 {ReadChars: want to read all} { } {abcdefghijkl} test chan-io-12.3 {ReadChars: allocate more space} { # (toRead > length - offset - 1) - set f [open $path(test1) w] chan puts -nonewline $f abcdefghijklmnopqrstuvwxyz chan close $f @@ -1389,19 +1308,16 @@ test chan-io-12.3 {ReadChars: allocate more space} { } {abcdefghijklmnopqrstuvwxyz} test chan-io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} { # (srcRead == 0) - set f [open "|[list [interpreter] $path(cat)]" w+] chan configure $f -encoding binary -buffering none -buffersize 16 chan puts -nonewline $f "123456789012345\x96" chan configure $f -encoding shiftjis -blocking 0 - chan event $f read [namespace code "ready $f"] proc ready {f} { variable x lappend x [chan read $f] [testchannel inputbuffered $f] } variable x {} - chan configure $f -encoding shiftjis vwait [namespace which -variable x] chan configure $f -encoding binary -blocking 1 @@ -1470,7 +1386,6 @@ test chan-io-13.2 {TranslateInputEOL: crlf mode} { } "abcd\ndef\n" test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} { # (src >= srcMax) - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r\ndef\r" @@ -1483,7 +1398,6 @@ test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} { } "abcd\ndef\r" test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} { # (src >= srcMax) - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r\ndef\rfgh" @@ -1496,7 +1410,6 @@ test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} { } "abcd\ndef\rfgh" test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} { # (src >= srcMax) - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r\ndef\nfgh" @@ -1510,10 +1423,8 @@ test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} { test chan-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+] chan configure $f -blocking 0 -buffering none -translation {auto lf} - chan event $f read [namespace code "ready $f"] proc ready {f} { variable x @@ -1521,21 +1432,17 @@ test chan-io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio } variable x {} variable y {} - chan puts -nonewline $f "abcdefghj\r" after 500 [namespace code {set y ok}] vwait [namespace which -variable y] - chan puts -nonewline $f "\n01234" after 500 [namespace code {set y ok}] vwait [namespace which -variable y] - chan close $f set x } [list "abcdefghj\n" 1 "01234" 0] test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} { # (src >= srcMax) - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r" @@ -1548,7 +1455,6 @@ test chan-io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe } [list "abcd\n" 1] test chan-io-13.8 {TranslateInputEOL: auto mode: \r\n} { # (*src == '\n') - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\r\ndef" @@ -1572,7 +1478,6 @@ test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} { } "abcd\ndef" test chan-io-13.10 {TranslateInputEOL: auto mode: \n} { # not (*src == '\r') - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\ndef" @@ -1585,7 +1490,6 @@ test chan-io-13.10 {TranslateInputEOL: auto mode: \n} { } "abcd\ndef" test chan-io-13.11 {TranslateInputEOL: EOF char} { # (*chanPtr->inEofChar != '\0') - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "abcd\ndefgh" @@ -1598,7 +1502,6 @@ test chan-io-13.11 {TranslateInputEOL: EOF char} { } "abcd\nd" test chan-io-13.12 {TranslateInputEOL: find EOF char in src} { # (*chanPtr->inEofChar != '\0') - set f [open $path(test1) w] chan configure $f -translation lf chan puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n" @@ -1610,11 +1513,11 @@ test chan-io-13.12 {TranslateInputEOL: find EOF char in src} { 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. +# 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 {[info commands testchannel] ne ""} { set consoleFileNames [lsort [testchannel open]] } else { # just to avoid an error @@ -1789,12 +1692,12 @@ test chan-io-15.1 {Tcl_CreateChan CloseHandler} emptyTest { test chan-io-16.1 {Tcl_DeleteChan CloseHandler} emptyTest { } {} -# Test channel table management. The functions tested are -# GetChannelTable, DeleteChannelTable, Tcl_RegisterChannel, -# Tcl_UnregisterChannel, Tcl_GetChannel and Tcl_CreateChannel. +# 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. +# These functions use "eof stdin" to ensure that the standard channels are +# added to the channel table of the interpreter. test chan-io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} { set l1 [testchannel refcount stdin] @@ -1960,11 +1863,11 @@ test chan-io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio open test chan-io-21.1 {Chan CloseChannelsOnExit} emptyTest { } {} -# 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 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 chan-io-22.1 {Tcl_GetChannelMode} emptyTest { # Not used anywhere in Tcl. @@ -2018,7 +1921,6 @@ test chan-io-25.2 {Tcl_GetChannelHandle, output} {testchannel} { test chan-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] chan close $f @@ -2128,7 +2030,8 @@ test chan-io-27.6 {FlushChannel, async flushing, async chan close} \ } } ok -# Tests closing a channel. The functions tested are Chan CloseChannel and Tcl_Chan Close. +# Tests closing a channel. The functions tested are Chan CloseChannel and +# Tcl_Chan Close. test chan-io-28.1 {Chan CloseChannel called when all references are dropped} {testchannel} { file delete $path(test1) @@ -2164,14 +2067,11 @@ test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} \ file delete $path(output) set f [open $path(pipe) w] chan puts $f { - # Need to not have eof char appended on chan close, because the other # side of the pipe already chan closed, so that writing would cause an # error "invalid file". - chan configure stdout -eofchar {} chan configure stderr -eofchar {} - set f [open $path(output) w] chan configure $f -translation lf -buffering none for {set x 0} {$x < 20} {incr x} { @@ -2189,7 +2089,6 @@ test chan-io-28.3 {Chan CloseChannel, not called before output queue is empty} \ chan close $f set f [open "|[list [interpreter] pipe]" r+] chan configure $f -blocking off -eofchar {} - chan puts -nonewline $f $x chan close $f set counter 0 @@ -2229,7 +2128,7 @@ test chan-io-28.5 {Tcl_Chan Close vs standard handles} {stdio unix testchannel o chan close $f set l } {file1 file2} -if {0} {test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} { +test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} knownBug { set cat [makeFile { fconfigure stdout -buffering line while {[gets stdin line]>=0} {puts $line} @@ -2249,8 +2148,8 @@ if {0} {test chan-io-28.6 {Tcl_CloseEx (half-close) pipe} { vwait ::done close $::ff r list $::done $::acc -} {Succeeded {Hey DONE}}} -if {0} {test chan-io-28.7 {Tcl_CloseEx (half-close) socket} { +} {Succeeded {Hey DONE}} +test chan-io-28.7 {Tcl_CloseEx (half-close) socket} knownBug { set echo [makeFile { proc accept {s args} {set ::sok $s} set s [socket -server accept 0] @@ -2278,7 +2177,8 @@ if {0} {test chan-io-28.7 {Tcl_CloseEx (half-close) socket} { close $::s r close $::ff list $::done $::acc -} {Succeeded {Hey DONE}}} +} {Succeeded {Hey DONE}} + test chan-io-29.1 {Tcl_WriteChars, channel not writable} { list [catch {chan puts stdin hello} msg] $msg } {1 {channel "stdin" wasn't opened for writing}} @@ -2811,7 +2711,6 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {s variable c variable x set l [chan gets $s] - if {[chan eof $s]} { chan close $s set x done @@ -2830,9 +2729,8 @@ test chan-io-29.34 {Tcl_Chan Close, async flush on chan close, using sockets} {s set c } 2000 test chan-io-29.35 {Tcl_Chan Close vs chan event vs multiple interpreters} {socket tempNotMac fileevent} { - # On Mac, this test screws up sockets such that subsequent tests using port 2828 - # either cause errors or panic(). - + # On Mac, this test screws up sockets such that subsequent tests using + # port 2828 either cause errors or panic(). catch {interp delete x} catch {interp delete y} interp create x @@ -4915,7 +4813,6 @@ test chan-io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} { } {4096 10000 1 1 1 100000 1048576} test chan-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] chan configure $chan -buffersize 10 set var [chan read $chan 2] @@ -6516,25 +6413,21 @@ test chan-io-51.1 {Test old socket deletion on Macintosh} {socket} { } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] set port [lindex [chan configure $ss -sockname] 2] - variable wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] chan close $cs - set wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] chan close $cs - set wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] lappend result [chan gets $cs] chan close $cs - set wait "" set cs [socket 127.0.0.1 $port] vwait [namespace which -variable wait] @@ -6717,66 +6610,48 @@ chan puts $out "\u0410\u0410" chan close $out test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} { # Copy kyrillic to UTF-8, using chan copy. - set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] - chan configure $in -encoding koi8-r -translation lf chan configure $out -encoding utf-8 -translation lf - chan copy $in $out chan close $in chan close $out - # Do the same again, but differently (read/chan puts). - set in [open $path(kyrillic.txt) r] set out [open $path(utf8-rp.txt) w] - chan configure $in -encoding koi8-r -translation lf chan configure $out -encoding utf-8 -translation lf - chan puts -nonewline $out [chan read $in] - chan close $in chan close $out - list [file size $path(kyrillic.txt)] \ [file size $path(utf8-fcopy.txt)] \ [file size $path(utf8-rp.txt)] } {3 5 5} test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} { - # encoding to binary (=> implies that the - # internal utf-8 is written) - + # encoding to binary (=> implies that the internal utf-8 is written) set in [open $path(kyrillic.txt) r] set out [open $path(utf8-fcopy.txt) w] - chan configure $in -encoding koi8-r -translation lf # -translation binary is also -encoding binary chan configure $out -translation binary - chan copy $in $out chan close $in chan close $out - file size $path(utf8-fcopy.txt) } 5 test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} { - # binary to encoding => the input has to be - # in utf-8 to make sense to the encoder - + # 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] - # -translation binary is also -encoding binary chan configure $in -translation binary chan configure $out -encoding koi8-r -translation lf - chan copy $in $out chan close $in chan close $out - file size $path(kyrillic.txt) } 3 @@ -7185,7 +7060,6 @@ test chan-io-53.10 {Bug 1350564, multi-directional fcopy} -setup { test chan-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. - proc accept {s a p} { variable as chan configure $s -translation lf @@ -7204,10 +7078,8 @@ test chan-io-54.1 {Recursive channel events} {socket fileevent} { incr x } set ss [socket -server [namespace code accept] -myaddr 127.0.0.1 0] - - # We need to delay on some systems until the creation of the - # server socket completes. - + # We need to delay on some systems until the creation of the server socket + # completes. set done 0 for {set i 0} {$i < 10} {incr i} { if {![catch {set cs [socket 127.0.0.1 [lindex [chan configure $ss -sockname] 2]]}]} { @@ -7241,18 +7113,14 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fi set after {} variable s [socket -server [namespace code accept] -myaddr 127.0.0.1 0] proc accept {s a p} { - variable counter - variable accept - - set accept $s - set counter 0 + variable counter 0 + variable accept $s chan configure $s -blocking off -buffering line -translation lf chan event $s readable [namespace code "doit $s"] } proc doit {s} { variable counter variable after - incr counter set l [chan gets $s] if {"$l" == ""} { @@ -7263,7 +7131,6 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fi proc doit1 {s} { variable counter variable accept - incr counter set l [chan gets $s] chan close $s @@ -7272,7 +7139,6 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fi proc producer {} { variable s variable writer - set writer [socket 127.0.0.1 [lindex [chan configure $s -sockname] 2]] chan configure $writer -buffering line chan puts -nonewline $writer hello @@ -7281,7 +7147,6 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fi proc newline {} { variable done variable writer - chan puts $writer hello chan flush $writer set done 1 @@ -7292,7 +7157,7 @@ test chan-io-54.2 {Testing for busy-wait in recursive channel events} {socket fi chan close $writer chan close $s after cancel $after - if {$accept != {}} {chan close $accept} + if {$accept ne {}} {chan close $accept} set counter } 1 @@ -7420,11 +7285,10 @@ test chan-io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc ope test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} { # TIP #10 - # 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'. Or we have to extend [testthread] as well. - + # 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'. + # Or we have to extend [testthread] as well. set f [open $path(longfile) r] set result [testchannel mthread $f] chan close $f @@ -7433,7 +7297,6 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} { test chan-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] chan puts $out { chan puts [encoding convertfrom identity \xe2] @@ -7456,7 +7319,6 @@ test chan-io-60.1 {writing illegal utf sequences} {openpipe fileevent} { variable x "" set result "" vwait [namespace which -variable x] - # 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 @@ -7489,59 +7351,44 @@ test chan-io-61.1 {Reset eof state after changing the eof char} -setup { removeFile eofchar } -result {77 = 23431} - # 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. +# 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. test chan-io-70.0 {Cutting & Splicing channels} {testchannel} { set f [makeFile {... dummy ...} cutsplice] set c [open $f r] - set res {} lappend res [catch {chan seek $c 0 start}] testchannel cut $c - lappend res [catch {chan seek $c 0 start}] testchannel splice $c - lappend res [catch {chan seek $c 0 start}] chan close $c - removeFile cutsplice - set res } {0 1 0} - - -# 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. - +# 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 chan-io-70.1 {Transfer channel} {testchannel testthread} { set f [makeFile {... dummy ...} cutsplice] set c [open $f r] - set res {} lappend res [catch {chan seek $c 0 start}] testchannel cut $c lappend res [catch {chan seek $c 0 start}] - set tid [testthread create] testthread send $tid [list set c $c] lappend res [testthread send $tid { @@ -7550,10 +7397,8 @@ test chan-io-70.1 {Transfer channel} {testchannel testthread} { chan close $c set res }] - tcltest::threadReap removeFile cutsplice - set res } {0 1 0} @@ -7721,26 +7566,19 @@ foreach {n msg expected} { f3 {-code boss -code 0 -level X -f ba} {-code 1 -level 0 -f ba} } { test chan-io-71.$n {Tcl_SetChannelError} {testchannel} { - set f [makeFile {... dummy ...} cutsplice] set c [open $f r] - set res [testchannel setchannelerror $c [lrange $msg 0 end]] chan close $c removeFile cutsplice - set res } [lrange $expected 0 end] - test chan-io-72.$n {Tcl_SetChannelErrorInterp} {testchannel} { - set f [makeFile {... dummy ...} cutsplice] set c [open $f r] - set res [testchannel setchannelerrorinterp $c [lrange $msg 0 end]] chan close $c removeFile cutsplice - set res } [lrange $expected 0 end] } @@ -7751,7 +7589,7 @@ test chan-io-73.1 {channel Tcl_Obj SetChannelFromAny} {} { } {1} # ### ### ### ######### ######### ######### - + # cleanup foreach file [list fooBar longfile script output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { |