Symaptic: os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/tests/io.test@bde4ae8d615e (annotated)

sl@0	1	# -- tcl --
sl@0	2	# Functionality covered: operation of all IO commands, and all procedures
sl@0	3	# defined in generic/tclIO.c.
sl@0	4	#
sl@0	5	# This file contains a collection of tests for one or more of the Tcl
sl@0	6	# built-in commands. Sourcing this file into Tcl runs the tests and
sl@0	7	# generates output for errors. No output means no errors were found.
sl@0	8	#
sl@0	9	# Copyright (c) 1991-1994 The Regents of the University of California.
sl@0	10	# Copyright (c) 1994-1997 Sun Microsystems, Inc.
sl@0	11	# Copyright (c) 1998-1999 by Scriptics Corporation.
sl@0	12	#
sl@0	13	# See the file "license.terms" for information on usage and redistribution
sl@0	14	# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0	15	#
sl@0	16	# RCS: @(#) $Id: io.test,v 1.40.2.12 2007/02/12 19:25:42 andreas_kupries Exp $
sl@0	17
sl@0	18	if {[catch {package require tcltest 2}]} {
sl@0	19	puts stderr "Skipping tests in [info script]. tcltest 2 required."
sl@0	20	return
sl@0	21	}
sl@0	22	namespace eval ::tcl::test::io {
sl@0	23
sl@0	24	namespace import ::tcltest::cleanupTests
sl@0	25	namespace import ::tcltest::interpreter
sl@0	26	namespace import ::tcltest::makeFile
sl@0	27	namespace import ::tcltest::removeFile
sl@0	28	namespace import ::tcltest::test
sl@0	29	namespace import ::tcltest::testConstraint
sl@0	30	namespace import ::tcltest::viewFile
sl@0	31
sl@0	32	testConstraint testchannel [llength [info commands testchannel]]
sl@0	33	testConstraint exec [llength [info commands exec]]
sl@0	34	testConstraint openpipe 1
sl@0	35	testConstraint fileevent [llength [info commands fileevent]]
sl@0	36	testConstraint fcopy [llength [info commands fcopy]]
sl@0	37
sl@0	38	# You need a very special environment to do some tests. In
sl@0	39	# particular, many file systems do not support large-files...
sl@0	40	testConstraint largefileSupport 0
sl@0	41
sl@0	42	# set up a long data file for some of the following tests
sl@0	43
sl@0	44	set path(longfile) [makeFile {} longfile]
sl@0	45	set f [open $path(longfile) w]
sl@0	46	fconfigure $f -eofchar {} -translation lf
sl@0	47	for { set i 0 } { $i < 100 } { incr i} {
sl@0	48	puts $f "#123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef
sl@0	49	\#123456789abcdef01
sl@0	50	\#"
sl@0	51	}
sl@0	52	close $f
sl@0	53
sl@0	54	set path(cat) [makeFile {
sl@0	55	set f stdin
sl@0	56	if {$argv != ""} {
sl@0	57	set f [open [lindex $argv 0]]
sl@0	58	}
sl@0	59	fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a
sl@0	60	fconfigure stdout -encoding binary -translation lf -buffering none
sl@0	61	fileevent $f readable "foo $f"
sl@0	62	proc foo {f} {
sl@0	63	set x [read $f]
sl@0	64	catch {puts -nonewline $x}
sl@0	65	if {[eof $f]} {
sl@0	66	close $f
sl@0	67	exit 0
sl@0	68	}
sl@0	69	}
sl@0	70	vwait forever
sl@0	71	} cat]
sl@0	72
sl@0	73	set thisScript [file join [pwd] [info script]]
sl@0	74
sl@0	75	proc contents {file} {
sl@0	76	set f [open $file]
sl@0	77	fconfigure $f -translation binary
sl@0	78	set a [read $f]
sl@0	79	close $f
sl@0	80	return $a
sl@0	81	}
sl@0	82
sl@0	83	test io-1.5 {Tcl_WriteChars: CheckChannelErrors} {emptyTest} {
sl@0	84	# no test, need to cause an async error.
sl@0	85	} {}
sl@0	86
sl@0	87	set path(test1) [makeFile {} test1]
sl@0	88
sl@0	89	test io-1.6 {Tcl_WriteChars: WriteBytes} {
sl@0	90	set f [open $path(test1) w]
sl@0	91	fconfigure $f -encoding binary
sl@0	92	puts -nonewline $f "a\u4e4d\0"
sl@0	93	close $f
sl@0	94	contents $path(test1)
sl@0	95	} "a\x4d\x00"
sl@0	96	test io-1.7 {Tcl_WriteChars: WriteChars} {
sl@0	97	set f [open $path(test1) w]
sl@0	98	fconfigure $f -encoding shiftjis
sl@0	99	puts -nonewline $f "a\u4e4d\0"
sl@0	100	close $f
sl@0	101	contents $path(test1)
sl@0	102	} "a\x93\xe1\x00"
sl@0	103
sl@0	104	set path(test2) [makeFile {} test2]
sl@0	105
sl@0	106	test io-1.8 {Tcl_WriteChars: WriteChars} {
sl@0	107	# This test written for SF bug #506297.
sl@0	108	#
sl@0	109	# Executing this test without the fix for the referenced bug
sl@0	110	# applied to tcl will cause tcl, more specifically WriteChars, to
sl@0	111	# go into an infinite loop.
sl@0	112
sl@0	113	set f [open $path(test2) w]
sl@0	114	fconfigure $f -encoding iso2022-jp
sl@0	115	puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
sl@0	116	close $f
sl@0	117	contents $path(test2)
sl@0	118	} " \x1b\$B\$O\x1b(B"
sl@0	119
sl@0	120	test io-1.9 {Tcl_WriteChars: WriteChars} {
sl@0	121	# When closing a channel with an encoding that appends
sl@0	122	# escape bytes, check for the case where the escape
sl@0	123	# bytes overflow the current IO buffer. The bytes
sl@0	124	# should be moved into a new buffer.
sl@0	125
sl@0	126	set data "1234567890 [format %c 12399]"
sl@0	127
sl@0	128	set sizes [list]
sl@0	129
sl@0	130	# With default buffer size
sl@0	131	set f [open $path(test2) w]
sl@0	132	fconfigure $f -encoding iso2022-jp
sl@0	133	puts -nonewline $f $data
sl@0	134	close $f
sl@0	135	lappend sizes [file size $path(test2)]
sl@0	136
sl@0	137	# With buffer size equal to the length
sl@0	138	# of the data, the escape bytes would
sl@0	139	# go into the next buffer.
sl@0	140
sl@0	141	set f [open $path(test2) w]
sl@0	142	fconfigure $f -encoding iso2022-jp -buffersize 16
sl@0	143	puts -nonewline $f $data
sl@0	144	close $f
sl@0	145	lappend sizes [file size $path(test2)]
sl@0	146
sl@0	147	# With buffer size that is large enough
sl@0	148	# to hold 1 byte of escaped data, but
sl@0	149	# not all 3. This should not write
sl@0	150	# the escape bytes to the first buffer
sl@0	151	# and then again to the second buffer.
sl@0	152
sl@0	153	set f [open $path(test2) w]
sl@0	154	fconfigure $f -encoding iso2022-jp -buffersize 17
sl@0	155	puts -nonewline $f $data
sl@0	156	close $f
sl@0	157	lappend sizes [file size $path(test2)]
sl@0	158
sl@0	159	# With buffer size that can hold 2 out of
sl@0	160	# 3 bytes of escaped data.
sl@0	161
sl@0	162	set f [open $path(test2) w]
sl@0	163	fconfigure $f -encoding iso2022-jp -buffersize 18
sl@0	164	puts -nonewline $f $data
sl@0	165	close $f
sl@0	166	lappend sizes [file size $path(test2)]
sl@0	167
sl@0	168	# With buffer size that can hold all the
sl@0	169	# data and escape bytes.
sl@0	170
sl@0	171	set f [open $path(test2) w]
sl@0	172	fconfigure $f -encoding iso2022-jp -buffersize 19
sl@0	173	puts -nonewline $f $data
sl@0	174	close $f
sl@0	175	lappend sizes [file size $path(test2)]
sl@0	176
sl@0	177	set sizes
sl@0	178	} {19 19 19 19 19}
sl@0	179
sl@0	180	test io-2.1 {WriteBytes} {
sl@0	181	# loop until all bytes are written
sl@0	182
sl@0	183	set f [open $path(test1) w]
sl@0	184	fconfigure $f -encoding binary -buffersize 16 -translation crlf
sl@0	185	puts $f "abcdefghijklmnopqrstuvwxyz"
sl@0	186	close $f
sl@0	187	contents $path(test1)
sl@0	188	} "abcdefghijklmnopqrstuvwxyz\r\n"
sl@0	189	test io-2.2 {WriteBytes: savedLF > 0} {
sl@0	190	# After flushing buffer, there was a \n left over from the last
sl@0	191	# \n -> \r\n expansion. It gets stuck at beginning of this buffer.
sl@0	192
sl@0	193	set f [open $path(test1) w]
sl@0	194	fconfigure $f -encoding binary -buffersize 16 -translation crlf
sl@0	195	puts -nonewline $f "123456789012345\n12"
sl@0	196	set x [list [contents $path(test1)]]
sl@0	197	close $f
sl@0	198	lappend x [contents $path(test1)]
sl@0	199	} [list "123456789012345\r" "123456789012345\r\n12"]
sl@0	200	test io-2.3 {WriteBytes: flush on line} {
sl@0	201	# Tcl "line" buffering has weird behavior: if current buffer contains
sl@0	202	# a \n, entire buffer gets flushed. Logical behavior would be to flush
sl@0	203	# only up to the \n.
sl@0	204
sl@0	205	set f [open $path(test1) w]
sl@0	206	fconfigure $f -encoding binary -buffering line -translation crlf
sl@0	207	puts -nonewline $f "\n12"
sl@0	208	set x [contents $path(test1)]
sl@0	209	close $f
sl@0	210	set x
sl@0	211	} "\r\n12"
sl@0	212	test io-2.4 {WriteBytes: reset sawLF after each buffer} {
sl@0	213	set f [open $path(test1) w]
sl@0	214	fconfigure $f -encoding binary -buffering line -translation lf \
sl@0	215	-buffersize 16
sl@0	216	puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
sl@0	217	set x [list [contents $path(test1)]]
sl@0	218	close $f
sl@0	219	lappend x [contents $path(test1)]
sl@0	220	} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
sl@0	221
sl@0	222	test io-3.1 {WriteChars: compatibility with WriteBytes} {
sl@0	223	# loop until all bytes are written
sl@0	224
sl@0	225	set f [open $path(test1) w]
sl@0	226	fconfigure $f -encoding ascii -buffersize 16 -translation crlf
sl@0	227	puts $f "abcdefghijklmnopqrstuvwxyz"
sl@0	228	close $f
sl@0	229	contents $path(test1)
sl@0	230	} "abcdefghijklmnopqrstuvwxyz\r\n"
sl@0	231	test io-3.2 {WriteChars: compatibility with WriteBytes: savedLF > 0} {
sl@0	232	# After flushing buffer, there was a \n left over from the last
sl@0	233	# \n -> \r\n expansion. It gets stuck at beginning of this buffer.
sl@0	234
sl@0	235	set f [open $path(test1) w]
sl@0	236	fconfigure $f -encoding ascii -buffersize 16 -translation crlf
sl@0	237	puts -nonewline $f "123456789012345\n12"
sl@0	238	set x [list [contents $path(test1)]]
sl@0	239	close $f
sl@0	240	lappend x [contents $path(test1)]
sl@0	241	} [list "123456789012345\r" "123456789012345\r\n12"]
sl@0	242	test io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} {
sl@0	243	# Tcl "line" buffering has weird behavior: if current buffer contains
sl@0	244	# a \n, entire buffer gets flushed. Logical behavior would be to flush
sl@0	245	# only up to the \n.
sl@0	246
sl@0	247	set f [open $path(test1) w]
sl@0	248	fconfigure $f -encoding ascii -buffering line -translation crlf
sl@0	249	puts -nonewline $f "\n12"
sl@0	250	set x [contents $path(test1)]
sl@0	251	close $f
sl@0	252	set x
sl@0	253	} "\r\n12"
sl@0	254	test io-3.4 {WriteChars: loop over stage buffer} {
sl@0	255	# stage buffer maps to more than can be queued at once.
sl@0	256
sl@0	257	set f [open $path(test1) w]
sl@0	258	fconfigure $f -encoding jis0208 -buffersize 16
sl@0	259	puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
sl@0	260	set x [list [contents $path(test1)]]
sl@0	261	close $f
sl@0	262	lappend x [contents $path(test1)]
sl@0	263	} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
sl@0	264	test io-3.5 {WriteChars: saved != 0} {
sl@0	265	# Bytes produced by UtfToExternal from end of last channel buffer
sl@0	266	# had to be moved to beginning of next channel buffer to preserve
sl@0	267	# requested buffersize.
sl@0	268
sl@0	269	set f [open $path(test1) w]
sl@0	270	fconfigure $f -encoding jis0208 -buffersize 17
sl@0	271	puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
sl@0	272	set x [list [contents $path(test1)]]
sl@0	273	close $f
sl@0	274	lappend x [contents $path(test1)]
sl@0	275	} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
sl@0	276	test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
sl@0	277	# One incomplete UTF-8 character at end of staging buffer. Backup
sl@0	278	# in src to the beginning of that UTF-8 character and try again.
sl@0	279	#
sl@0	280	# Translate the first 16 bytes, produce 14 bytes of output, 2 left over
sl@0	281	# (first two bytes of \uff21 in UTF-8). Given those two bytes try
sl@0	282	# translating them again, find that no bytes are read produced, and break
sl@0	283	# to outer loop where those two bytes will have the remaining 4 bytes
sl@0	284	# (the last byte of \uff21 plus the all of \uff22) appended.
sl@0	285
sl@0	286	set f [open $path(test1) w]
sl@0	287	fconfigure $f -encoding shiftjis -buffersize 16
sl@0	288	puts -nonewline $f "12345678901234\uff21\uff22"
sl@0	289	set x [list [contents $path(test1)]]
sl@0	290	close $f
sl@0	291	lappend x [contents $path(test1)]
sl@0	292	} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
sl@0	293	test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
sl@0	294	# When translating UTF-8 to external, the produced bytes went past end
sl@0	295	# of the channel buffer. This is done purpose -- we then truncate the
sl@0	296	# bytes at the end of the partial character to preserve the requested
sl@0	297	# blocksize on flush. The truncated bytes are moved to the beginning
sl@0	298	# of the next channel buffer.
sl@0	299
sl@0	300	set f [open $path(test1) w]
sl@0	301	fconfigure $f -encoding jis0208 -buffersize 17
sl@0	302	puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
sl@0	303	set x [list [contents $path(test1)]]
sl@0	304	close $f
sl@0	305	lappend x [contents $path(test1)]
sl@0	306	} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
sl@0	307	test io-3.8 {WriteChars: reset sawLF after each buffer} {
sl@0	308	set f [open $path(test1) w]
sl@0	309	fconfigure $f -encoding ascii -buffering line -translation lf \
sl@0	310	-buffersize 16
sl@0	311	puts -nonewline $f "abcdefg\nhijklmnopqrstuvwxyz"
sl@0	312	set x [list [contents $path(test1)]]
sl@0	313	close $f
sl@0	314	lappend x [contents $path(test1)]
sl@0	315	} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
sl@0	316
sl@0	317	test io-4.1 {TranslateOutputEOL: lf} {
sl@0	318	# search for \n
sl@0	319
sl@0	320	set f [open $path(test1) w]
sl@0	321	fconfigure $f -buffering line -translation lf
sl@0	322	puts $f "abcde"
sl@0	323	set x [list [contents $path(test1)]]
sl@0	324	close $f
sl@0	325	lappend x [contents $path(test1)]
sl@0	326	} [list "abcde\n" "abcde\n"]
sl@0	327	test io-4.2 {TranslateOutputEOL: cr} {
sl@0	328	# search for \n, replace with \r
sl@0	329
sl@0	330	set f [open $path(test1) w]
sl@0	331	fconfigure $f -buffering line -translation cr
sl@0	332	puts $f "abcde"
sl@0	333	set x [list [contents $path(test1)]]
sl@0	334	close $f
sl@0	335	lappend x [contents $path(test1)]
sl@0	336	} [list "abcde\r" "abcde\r"]
sl@0	337	test io-4.3 {TranslateOutputEOL: crlf} {
sl@0	338	# simple case: search for \n, replace with \r
sl@0	339
sl@0	340	set f [open $path(test1) w]
sl@0	341	fconfigure $f -buffering line -translation crlf
sl@0	342	puts $f "abcde"
sl@0	343	set x [list [contents $path(test1)]]
sl@0	344	close $f
sl@0	345	lappend x [contents $path(test1)]
sl@0	346	} [list "abcde\r\n" "abcde\r\n"]
sl@0	347	test io-4.4 {TranslateOutputEOL: crlf} {
sl@0	348	# keep storing more bytes in output buffer until output buffer is full.
sl@0	349	# We have 13 bytes initially that would turn into 18 bytes. Fill
sl@0	350	# dest buffer while (dstEnd < dstMax).
sl@0	351
sl@0	352	set f [open $path(test1) w]
sl@0	353	fconfigure $f -translation crlf -buffersize 16
sl@0	354	puts -nonewline $f "1234567\n\n\n\n\nA"
sl@0	355	set x [list [contents $path(test1)]]
sl@0	356	close $f
sl@0	357	lappend x [contents $path(test1)]
sl@0	358	} [list "1234567\r\n\r\n\r\n\r\n\r" "1234567\r\n\r\n\r\n\r\n\r\nA"]
sl@0	359	test io-4.5 {TranslateOutputEOL: crlf} {
sl@0	360	# Check for overflow of the destination buffer
sl@0	361
sl@0	362	set f [open $path(test1) w]
sl@0	363	fconfigure $f -translation crlf -buffersize 12
sl@0	364	puts -nonewline $f "12345678901\n456789012345678901234"
sl@0	365	close $f
sl@0	366	set x [contents $path(test1)]
sl@0	367	} "12345678901\r\n456789012345678901234"
sl@0	368
sl@0	369	test io-5.1 {CheckFlush: not full} {
sl@0	370	set f [open $path(test1) w]
sl@0	371	fconfigure $f
sl@0	372	puts -nonewline $f "12345678901234567890"
sl@0	373	set x [list [contents $path(test1)]]
sl@0	374	close $f
sl@0	375	lappend x [contents $path(test1)]
sl@0	376	} [list "" "12345678901234567890"]
sl@0	377	test io-5.2 {CheckFlush: full} {
sl@0	378	set f [open $path(test1) w]
sl@0	379	fconfigure $f -buffersize 16
sl@0	380	puts -nonewline $f "12345678901234567890"
sl@0	381	set x [list [contents $path(test1)]]
sl@0	382	close $f
sl@0	383	lappend x [contents $path(test1)]
sl@0	384	} [list "1234567890123456" "12345678901234567890"]
sl@0	385	test io-5.3 {CheckFlush: not line} {
sl@0	386	set f [open $path(test1) w]
sl@0	387	fconfigure $f -buffering line
sl@0	388	puts -nonewline $f "12345678901234567890"
sl@0	389	set x [list [contents $path(test1)]]
sl@0	390	close $f
sl@0	391	lappend x [contents $path(test1)]
sl@0	392	} [list "" "12345678901234567890"]
sl@0	393	test io-5.4 {CheckFlush: line} {
sl@0	394	set f [open $path(test1) w]
sl@0	395	fconfigure $f -buffering line -translation lf -encoding ascii
sl@0	396	puts -nonewline $f "1234567890\n1234567890"
sl@0	397	set x [list [contents $path(test1)]]
sl@0	398	close $f
sl@0	399	lappend x [contents $path(test1)]
sl@0	400	} [list "1234567890\n1234567890" "1234567890\n1234567890"]
sl@0	401	test io-5.5 {CheckFlush: none} {
sl@0	402	set f [open $path(test1) w]
sl@0	403	fconfigure $f -buffering none
sl@0	404	puts -nonewline $f "1234567890"
sl@0	405	set x [list [contents $path(test1)]]
sl@0	406	close $f
sl@0	407	lappend x [contents $path(test1)]
sl@0	408	} [list "1234567890" "1234567890"]
sl@0	409
sl@0	410	test io-6.1 {Tcl_GetsObj: working} {
sl@0	411	set f [open $path(test1) w]
sl@0	412	puts $f "foo\nboo"
sl@0	413	close $f
sl@0	414	set f [open $path(test1)]
sl@0	415	set x [gets $f]
sl@0	416	close $f
sl@0	417	set x
sl@0	418	} {foo}
sl@0	419	test io-6.2 {Tcl_GetsObj: CheckChannelErrors() != 0} {
sl@0	420	# no test, need to cause an async error.
sl@0	421	} {}
sl@0	422	test io-6.3 {Tcl_GetsObj: how many have we used?} {
sl@0	423	# if (bufPtr != NULL) {oldRemoved = bufPtr->nextRemoved}
sl@0	424
sl@0	425	set f [open $path(test1) w]
sl@0	426	fconfigure $f -translation crlf
sl@0	427	puts $f "abc\ndefg"
sl@0	428	close $f
sl@0	429	set f [open $path(test1)]
sl@0	430	set x [list [tell $f] [gets $f line] [tell $f] [gets $f line] $line]
sl@0	431	close $f
sl@0	432	set x
sl@0	433	} {0 3 5 4 defg}
sl@0	434	test io-6.4 {Tcl_GetsObj: encoding == NULL} {
sl@0	435	set f [open $path(test1) w]
sl@0	436	fconfigure $f -translation binary
sl@0	437	puts $f "\x81\u1234\0"
sl@0	438	close $f
sl@0	439	set f [open $path(test1)]
sl@0	440	fconfigure $f -translation binary
sl@0	441	set x [list [gets $f line] $line]
sl@0	442	close $f
sl@0	443	set x
sl@0	444	} [list 3 "\x81\x34\x00"]
sl@0	445	test io-6.5 {Tcl_GetsObj: encoding != NULL} {
sl@0	446	set f [open $path(test1) w]
sl@0	447	fconfigure $f -translation binary
sl@0	448	puts $f "\x88\xea\x92\x9a"
sl@0	449	close $f
sl@0	450	set f [open $path(test1)]
sl@0	451	fconfigure $f -encoding shiftjis
sl@0	452	set x [list [gets $f line] $line]
sl@0	453	close $f
sl@0	454	set x
sl@0	455	} [list 2 "\u4e00\u4e01"]
sl@0	456	set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
sl@0	457	append a $a
sl@0	458	append a $a
sl@0	459	test io-6.6 {Tcl_GetsObj: loop test} {
sl@0	460	# if (dst >= dstEnd)
sl@0	461
sl@0	462	set f [open $path(test1) w]
sl@0	463	puts $f $a
sl@0	464	puts $f hi
sl@0	465	close $f
sl@0	466	set f [open $path(test1)]
sl@0	467	set x [list [gets $f line] $line]
sl@0	468	close $f
sl@0	469	set x
sl@0	470	} [list 256 $a]
sl@0	471	test io-6.7 {Tcl_GetsObj: error in input} {stdio openpipe} {
sl@0	472	# if (FilterInputBytes(chanPtr, &gs) != 0)
sl@0	473
sl@0	474	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	475	puts -nonewline $f "hi\nwould"
sl@0	476	flush $f
sl@0	477	gets $f
sl@0	478	fconfigure $f -blocking 0
sl@0	479	set x [gets $f line]
sl@0	480	close $f
sl@0	481	set x
sl@0	482	} {-1}
sl@0	483	test io-6.8 {Tcl_GetsObj: remember if EOF is seen} {
sl@0	484	set f [open $path(test1) w]
sl@0	485	puts $f "abcdef\x1aghijk\nwombat"
sl@0	486	close $f
sl@0	487	set f [open $path(test1)]
sl@0	488	fconfigure $f -eofchar \x1a
sl@0	489	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	490	close $f
sl@0	491	set x
sl@0	492	} {6 abcdef -1 {}}
sl@0	493	test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
sl@0	494	set f [open $path(test1) w]
sl@0	495	puts $f "abcdefghijk\nwom\u001abat"
sl@0	496	close $f
sl@0	497	set f [open $path(test1)]
sl@0	498	fconfigure $f -eofchar \x1a
sl@0	499	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	500	close $f
sl@0	501	set x
sl@0	502	} {11 abcdefghijk 3 wom}
sl@0	503
sl@0	504	# Comprehensive tests
sl@0	505
sl@0	506	test io-6.10 {Tcl_GetsObj: lf mode: no chars} {
sl@0	507	set f [open $path(test1) w]
sl@0	508	close $f
sl@0	509	set f [open $path(test1)]
sl@0	510	fconfigure $f -translation lf
sl@0	511	set x [list [gets $f line] $line]
sl@0	512	close $f
sl@0	513	set x
sl@0	514	} {-1 {}}
sl@0	515	test io-6.11 {Tcl_GetsObj: lf mode: lone \n} {
sl@0	516	set f [open $path(test1) w]
sl@0	517	fconfigure $f -translation lf
sl@0	518	puts -nonewline $f "\n"
sl@0	519	close $f
sl@0	520	set f [open $path(test1)]
sl@0	521	fconfigure $f -translation lf
sl@0	522	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	523	close $f
sl@0	524	set x
sl@0	525	} {0 {} -1 {}}
sl@0	526	test io-6.12 {Tcl_GetsObj: lf mode: lone \r} {
sl@0	527	set f [open $path(test1) w]
sl@0	528	fconfigure $f -translation lf
sl@0	529	puts -nonewline $f "\r"
sl@0	530	close $f
sl@0	531	set f [open $path(test1)]
sl@0	532	fconfigure $f -translation lf
sl@0	533	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	534	close $f
sl@0	535	set x
sl@0	536	} [list 1 "\r" -1 ""]
sl@0	537	test io-6.13 {Tcl_GetsObj: lf mode: 1 char} {
sl@0	538	set f [open $path(test1) w]
sl@0	539	fconfigure $f -translation lf
sl@0	540	puts -nonewline $f a
sl@0	541	close $f
sl@0	542	set f [open $path(test1)]
sl@0	543	fconfigure $f -translation lf
sl@0	544	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	545	close $f
sl@0	546	set x
sl@0	547	} {1 a -1 {}}
sl@0	548	test io-6.14 {Tcl_GetsObj: lf mode: 1 char followed by EOL} {
sl@0	549	set f [open $path(test1) w]
sl@0	550	fconfigure $f -translation lf
sl@0	551	puts -nonewline $f "a\n"
sl@0	552	close $f
sl@0	553	set f [open $path(test1)]
sl@0	554	fconfigure $f -translation lf
sl@0	555	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	556	close $f
sl@0	557	set x
sl@0	558	} {1 a -1 {}}
sl@0	559	test io-6.15 {Tcl_GetsObj: lf mode: several chars} {
sl@0	560	set f [open $path(test1) w]
sl@0	561	fconfigure $f -translation lf
sl@0	562	puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
sl@0	563	close $f
sl@0	564	set f [open $path(test1)]
sl@0	565	fconfigure $f -translation lf
sl@0	566	set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
sl@0	567	close $f
sl@0	568	set x
sl@0	569	} [list 4 "abcd" 10 "efgh\rijkl\r" 4 "mnop" -1 ""]
sl@0	570	test io-6.16 {Tcl_GetsObj: cr mode: no chars} {
sl@0	571	set f [open $path(test1) w]
sl@0	572	close $f
sl@0	573	set f [open $path(test1)]
sl@0	574	fconfigure $f -translation cr
sl@0	575	set x [list [gets $f line] $line]
sl@0	576	close $f
sl@0	577	set x
sl@0	578	} {-1 {}}
sl@0	579	test io-6.17 {Tcl_GetsObj: cr mode: lone \n} {
sl@0	580	set f [open $path(test1) w]
sl@0	581	fconfigure $f -translation lf
sl@0	582	puts -nonewline $f "\n"
sl@0	583	close $f
sl@0	584	set f [open $path(test1)]
sl@0	585	fconfigure $f -translation cr
sl@0	586	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	587	close $f
sl@0	588	set x
sl@0	589	} [list 1 "\n" -1 ""]
sl@0	590	test io-6.18 {Tcl_GetsObj: cr mode: lone \r} {
sl@0	591	set f [open $path(test1) w]
sl@0	592	fconfigure $f -translation lf
sl@0	593	puts -nonewline $f "\r"
sl@0	594	close $f
sl@0	595	set f [open $path(test1)]
sl@0	596	fconfigure $f -translation cr
sl@0	597	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	598	close $f
sl@0	599	set x
sl@0	600	} {0 {} -1 {}}
sl@0	601	test io-6.19 {Tcl_GetsObj: cr mode: 1 char} {
sl@0	602	set f [open $path(test1) w]
sl@0	603	fconfigure $f -translation lf
sl@0	604	puts -nonewline $f a
sl@0	605	close $f
sl@0	606	set f [open $path(test1)]
sl@0	607	fconfigure $f -translation cr
sl@0	608	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	609	close $f
sl@0	610	set x
sl@0	611	} {1 a -1 {}}
sl@0	612	test io-6.20 {Tcl_GetsObj: cr mode: 1 char followed by EOL} {
sl@0	613	set f [open $path(test1) w]
sl@0	614	fconfigure $f -translation lf
sl@0	615	puts -nonewline $f "a\r"
sl@0	616	close $f
sl@0	617	set f [open $path(test1)]
sl@0	618	fconfigure $f -translation cr
sl@0	619	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	620	close $f
sl@0	621	set x
sl@0	622	} {1 a -1 {}}
sl@0	623	test io-6.21 {Tcl_GetsObj: cr mode: several chars} {
sl@0	624	set f [open $path(test1) w]
sl@0	625	fconfigure $f -translation lf
sl@0	626	puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
sl@0	627	close $f
sl@0	628	set f [open $path(test1)]
sl@0	629	fconfigure $f -translation cr
sl@0	630	set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line [gets $f line] $line]
sl@0	631	close $f
sl@0	632	set x
sl@0	633	} [list 9 "abcd\nefgh" 4 "ijkl" 5 "\nmnop" -1 ""]
sl@0	634	test io-6.22 {Tcl_GetsObj: crlf mode: no chars} {
sl@0	635	set f [open $path(test1) w]
sl@0	636	close $f
sl@0	637	set f [open $path(test1)]
sl@0	638	fconfigure $f -translation crlf
sl@0	639	set x [list [gets $f line] $line]
sl@0	640	close $f
sl@0	641	set x
sl@0	642	} {-1 {}}
sl@0	643	test io-6.23 {Tcl_GetsObj: crlf mode: lone \n} {
sl@0	644	set f [open $path(test1) w]
sl@0	645	fconfigure $f -translation lf
sl@0	646	puts -nonewline $f "\n"
sl@0	647	close $f
sl@0	648	set f [open $path(test1)]
sl@0	649	fconfigure $f -translation crlf
sl@0	650	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	651	close $f
sl@0	652	set x
sl@0	653	} [list 1 "\n" -1 ""]
sl@0	654	test io-6.24 {Tcl_GetsObj: crlf mode: lone \r} {
sl@0	655	set f [open $path(test1) w]
sl@0	656	fconfigure $f -translation lf
sl@0	657	puts -nonewline $f "\r"
sl@0	658	close $f
sl@0	659	set f [open $path(test1)]
sl@0	660	fconfigure $f -translation crlf
sl@0	661	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	662	close $f
sl@0	663	set x
sl@0	664	} [list 1 "\r" -1 ""]
sl@0	665	test io-6.25 {Tcl_GetsObj: crlf mode: \r\r} {
sl@0	666	set f [open $path(test1) w]
sl@0	667	fconfigure $f -translation lf
sl@0	668	puts -nonewline $f "\r\r"
sl@0	669	close $f
sl@0	670	set f [open $path(test1)]
sl@0	671	fconfigure $f -translation crlf
sl@0	672	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	673	close $f
sl@0	674	set x
sl@0	675	} [list 2 "\r\r" -1 ""]
sl@0	676	test io-6.26 {Tcl_GetsObj: crlf mode: \r\n} {
sl@0	677	set f [open $path(test1) w]
sl@0	678	fconfigure $f -translation lf
sl@0	679	puts -nonewline $f "\r\n"
sl@0	680	close $f
sl@0	681	set f [open $path(test1)]
sl@0	682	fconfigure $f -translation crlf
sl@0	683	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	684	close $f
sl@0	685	set x
sl@0	686	} [list 0 "" -1 ""]
sl@0	687	test io-6.27 {Tcl_GetsObj: crlf mode: 1 char} {
sl@0	688	set f [open $path(test1) w]
sl@0	689	fconfigure $f -translation lf
sl@0	690	puts -nonewline $f a
sl@0	691	close $f
sl@0	692	set f [open $path(test1)]
sl@0	693	fconfigure $f -translation crlf
sl@0	694	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	695	close $f
sl@0	696	set x
sl@0	697	} {1 a -1 {}}
sl@0	698	test io-6.28 {Tcl_GetsObj: crlf mode: 1 char followed by EOL} {
sl@0	699	set f [open $path(test1) w]
sl@0	700	fconfigure $f -translation lf
sl@0	701	puts -nonewline $f "a\r\n"
sl@0	702	close $f
sl@0	703	set f [open $path(test1)]
sl@0	704	fconfigure $f -translation crlf
sl@0	705	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	706	close $f
sl@0	707	set x
sl@0	708	} {1 a -1 {}}
sl@0	709	test io-6.29 {Tcl_GetsObj: crlf mode: several chars} {
sl@0	710	set f [open $path(test1) w]
sl@0	711	fconfigure $f -translation lf
sl@0	712	puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
sl@0	713	close $f
sl@0	714	set f [open $path(test1)]
sl@0	715	fconfigure $f -translation crlf
sl@0	716	set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
sl@0	717	close $f
sl@0	718	set x
sl@0	719	} [list 14 "abcd\nefgh\rijkl" 4 "mnop" -1 ""]
sl@0	720	test io-6.30 {Tcl_GetsObj: crlf mode: buffer exhausted} {testchannel} {
sl@0	721	# if (eol >= dstEnd)
sl@0	722
sl@0	723	set f [open $path(test1) w]
sl@0	724	fconfigure $f -translation lf
sl@0	725	puts -nonewline $f "123456789012345\r\nabcdefghijklmnoprstuvwxyz"
sl@0	726	close $f
sl@0	727	set f [open $path(test1)]
sl@0	728	fconfigure $f -translation crlf -buffersize 16
sl@0	729	set x [list [gets $f line] $line [testchannel inputbuffered $f]]
sl@0	730	close $f
sl@0	731	set x
sl@0	732	} [list 15 "123456789012345" 15]
sl@0	733	test io-6.31 {Tcl_GetsObj: crlf mode: buffer exhausted, blocked} {stdio testchannel openpipe fileevent} {
sl@0	734	# (FilterInputBytes() != 0)
sl@0	735
sl@0	736	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	737	fconfigure $f -translation {crlf lf} -buffering none
sl@0	738	puts -nonewline $f "bbbbbbbbbbbbbb\r\n123456789012345\r"
sl@0	739	fconfigure $f -buffersize 16
sl@0	740	set x [gets $f]
sl@0	741	fconfigure $f -blocking 0
sl@0	742	lappend x [gets $f line] $line [fblocked $f] [testchannel inputbuffered $f]
sl@0	743	close $f
sl@0	744	set x
sl@0	745	} [list "bbbbbbbbbbbbbb" -1 "" 1 16]
sl@0	746	test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel} {
sl@0	747	# not (FilterInputBytes() != 0)
sl@0	748
sl@0	749	set f [open $path(test1) w]
sl@0	750	fconfigure $f -translation lf
sl@0	751	puts -nonewline $f "123456789012345\r\n123"
sl@0	752	close $f
sl@0	753	set f [open $path(test1)]
sl@0	754	fconfigure $f -translation crlf -buffersize 16
sl@0	755	set x [list [gets $f line] $line [tell $f] [testchannel inputbuffered $f]]
sl@0	756	close $f
sl@0	757	set x
sl@0	758	} [list 15 "123456789012345" 17 3]
sl@0	759	test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
sl@0	760	# eol still equals dstEnd
sl@0	761
sl@0	762	set f [open $path(test1) w]
sl@0	763	fconfigure $f -translation lf
sl@0	764	puts -nonewline $f "123456789012345\r"
sl@0	765	close $f
sl@0	766	set f [open $path(test1)]
sl@0	767	fconfigure $f -translation crlf -buffersize 16
sl@0	768	set x [list [gets $f line] $line [eof $f]]
sl@0	769	close $f
sl@0	770	set x
sl@0	771	} [list 16 "123456789012345\r" 1]
sl@0	772	test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
sl@0	773	# not (*eol == '\n')
sl@0	774
sl@0	775	set f [open $path(test1) w]
sl@0	776	fconfigure $f -translation lf
sl@0	777	puts -nonewline $f "123456789012345\rabcd\r\nefg"
sl@0	778	close $f
sl@0	779	set f [open $path(test1)]
sl@0	780	fconfigure $f -translation crlf -buffersize 16
sl@0	781	set x [list [gets $f line] $line [tell $f]]
sl@0	782	close $f
sl@0	783	set x
sl@0	784	} [list 20 "123456789012345\rabcd" 22]
sl@0	785	test io-6.35 {Tcl_GetsObj: auto mode: no chars} {
sl@0	786	set f [open $path(test1) w]
sl@0	787	close $f
sl@0	788	set f [open $path(test1)]
sl@0	789	fconfigure $f -translation auto
sl@0	790	set x [list [gets $f line] $line]
sl@0	791	close $f
sl@0	792	set x
sl@0	793	} {-1 {}}
sl@0	794	test io-6.36 {Tcl_GetsObj: auto mode: lone \n} {
sl@0	795	set f [open $path(test1) w]
sl@0	796	fconfigure $f -translation lf
sl@0	797	puts -nonewline $f "\n"
sl@0	798	close $f
sl@0	799	set f [open $path(test1)]
sl@0	800	fconfigure $f -translation auto
sl@0	801	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	802	close $f
sl@0	803	set x
sl@0	804	} [list 0 "" -1 ""]
sl@0	805	test io-6.37 {Tcl_GetsObj: auto mode: lone \r} {
sl@0	806	set f [open $path(test1) w]
sl@0	807	fconfigure $f -translation lf
sl@0	808	puts -nonewline $f "\r"
sl@0	809	close $f
sl@0	810	set f [open $path(test1)]
sl@0	811	fconfigure $f -translation auto
sl@0	812	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	813	close $f
sl@0	814	set x
sl@0	815	} [list 0 "" -1 ""]
sl@0	816	test io-6.38 {Tcl_GetsObj: auto mode: \r\r} {
sl@0	817	set f [open $path(test1) w]
sl@0	818	fconfigure $f -translation lf
sl@0	819	puts -nonewline $f "\r\r"
sl@0	820	close $f
sl@0	821	set f [open $path(test1)]
sl@0	822	fconfigure $f -translation auto
sl@0	823	set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
sl@0	824	close $f
sl@0	825	set x
sl@0	826	} [list 0 "" 0 "" -1 ""]
sl@0	827	test io-6.39 {Tcl_GetsObj: auto mode: \r\n} {
sl@0	828	set f [open $path(test1) w]
sl@0	829	fconfigure $f -translation lf
sl@0	830	puts -nonewline $f "\r\n"
sl@0	831	close $f
sl@0	832	set f [open $path(test1)]
sl@0	833	fconfigure $f -translation auto
sl@0	834	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	835	close $f
sl@0	836	set x
sl@0	837	} [list 0 "" -1 ""]
sl@0	838	test io-6.40 {Tcl_GetsObj: auto mode: 1 char} {
sl@0	839	set f [open $path(test1) w]
sl@0	840	fconfigure $f -translation lf
sl@0	841	puts -nonewline $f a
sl@0	842	close $f
sl@0	843	set f [open $path(test1)]
sl@0	844	fconfigure $f -translation auto
sl@0	845	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	846	close $f
sl@0	847	set x
sl@0	848	} {1 a -1 {}}
sl@0	849	test io-6.41 {Tcl_GetsObj: auto mode: 1 char followed by EOL} {
sl@0	850	set f [open $path(test1) w]
sl@0	851	fconfigure $f -translation lf
sl@0	852	puts -nonewline $f "a\r\n"
sl@0	853	close $f
sl@0	854	set f [open $path(test1)]
sl@0	855	fconfigure $f -translation auto
sl@0	856	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	857	close $f
sl@0	858	set x
sl@0	859	} {1 a -1 {}}
sl@0	860	test io-6.42 {Tcl_GetsObj: auto mode: several chars} {
sl@0	861	set f [open $path(test1) w]
sl@0	862	fconfigure $f -translation lf
sl@0	863	puts -nonewline $f "abcd\nefgh\rijkl\r\nmnop"
sl@0	864	close $f
sl@0	865	set f [open $path(test1)]
sl@0	866	fconfigure $f -translation auto
sl@0	867	set x [list [gets $f line] $line [gets $f line] $line]
sl@0	868	lappend x [gets $f line] $line [gets $f line] $line [gets $f line] $line
sl@0	869	close $f
sl@0	870	set x
sl@0	871	} [list 4 "abcd" 4 "efgh" 4 "ijkl" 4 "mnop" -1 ""]
sl@0	872	test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent} {
sl@0	873	# if (chanPtr->flags & INPUT_SAW_CR)
sl@0	874
sl@0	875	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	876	fconfigure $f -translation {auto lf} -buffering none
sl@0	877	puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
sl@0	878	fconfigure $f -buffersize 16
sl@0	879	set x [list [gets $f]]
sl@0	880	fconfigure $f -blocking 0
sl@0	881	lappend x [gets $f line] $line [testchannel queuedcr $f]
sl@0	882	fconfigure $f -blocking 1
sl@0	883	puts -nonewline $f "\nabcd\refg\x1a"
sl@0	884	lappend x [gets $f line] $line [testchannel queuedcr $f]
sl@0	885	lappend x [gets $f line] $line
sl@0	886	close $f
sl@0	887	set x
sl@0	888	} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
sl@0	889	test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
sl@0	890	# not (*eol == '\n')
sl@0	891
sl@0	892	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	893	fconfigure $f -translation {auto lf} -buffering none
sl@0	894	puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
sl@0	895	fconfigure $f -buffersize 16
sl@0	896	set x [list [gets $f]]
sl@0	897	fconfigure $f -blocking 0
sl@0	898	lappend x [gets $f line] $line [testchannel queuedcr $f]
sl@0	899	fconfigure $f -blocking 1
sl@0	900	puts -nonewline $f "abcd\refg\x1a"
sl@0	901	lappend x [gets $f line] $line [testchannel queuedcr $f]
sl@0	902	lappend x [gets $f line] $line
sl@0	903	close $f
sl@0	904	set x
sl@0	905	} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
sl@0	906	test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio testchannel openpipe fileevent} {
sl@0	907	# Tcl_ExternalToUtf()
sl@0	908
sl@0	909	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	910	fconfigure $f -translation {auto lf} -buffering none
sl@0	911	fconfigure $f -encoding unicode
sl@0	912	puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
sl@0	913	fconfigure $f -buffersize 16
sl@0	914	gets $f
sl@0	915	fconfigure $f -blocking 0
sl@0	916	set x [list [gets $f line] $line [testchannel queuedcr $f]]
sl@0	917	fconfigure $f -blocking 1
sl@0	918	puts -nonewline $f "\nabcd\refg"
sl@0	919	lappend x [gets $f line] $line [testchannel queuedcr $f]
sl@0	920	close $f
sl@0	921	set x
sl@0	922	} [list 15 "123456789abcdef" 1 4 "abcd" 0]
sl@0	923	test io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eof} {stdio testchannel openpipe fileevent} {
sl@0	924	# memmove()
sl@0	925
sl@0	926	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	927	fconfigure $f -translation {auto lf} -buffering none
sl@0	928	puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
sl@0	929	fconfigure $f -buffersize 16
sl@0	930	gets $f
sl@0	931	fconfigure $f -blocking 0
sl@0	932	set x [list [gets $f line] $line [testchannel queuedcr $f]]
sl@0	933	fconfigure $f -blocking 1
sl@0	934	puts -nonewline $f "\n\x1a"
sl@0	935	lappend x [gets $f line] $line [testchannel queuedcr $f]
sl@0	936	close $f
sl@0	937	set x
sl@0	938	} [list 15 "123456789abcdef" 1 -1 "" 0]
sl@0	939	test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testchannel} {
sl@0	940	# (eol == dstEnd)
sl@0	941
sl@0	942	set f [open $path(test1) w]
sl@0	943	fconfigure $f -translation lf
sl@0	944	puts -nonewline $f "123456789012345\r\nabcdefghijklmnopq"
sl@0	945	close $f
sl@0	946	set f [open $path(test1)]
sl@0	947	fconfigure $f -translation auto -buffersize 16
sl@0	948	set x [list [gets $f] [testchannel inputbuffered $f]]
sl@0	949	close $f
sl@0	950	set x
sl@0	951	} [list "123456789012345" 15]
sl@0	952	test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testchannel} {
sl@0	953	# PeekAhead() did not get any, so (eol >= dstEnd)
sl@0	954
sl@0	955	set f [open $path(test1) w]
sl@0	956	fconfigure $f -translation lf
sl@0	957	puts -nonewline $f "123456789012345\r"
sl@0	958	close $f
sl@0	959	set f [open $path(test1)]
sl@0	960	fconfigure $f -translation auto -buffersize 16
sl@0	961	set x [list [gets $f] [testchannel queuedcr $f]]
sl@0	962	close $f
sl@0	963	set x
sl@0	964	} [list "123456789012345" 1]
sl@0	965	test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
sl@0	966	# if (*eol == '\n') {skip++}
sl@0	967
sl@0	968	set f [open $path(test1) w]
sl@0	969	fconfigure $f -translation lf
sl@0	970	puts -nonewline $f "123456\r\n78901"
sl@0	971	close $f
sl@0	972	set f [open $path(test1)]
sl@0	973	set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
sl@0	974	close $f
sl@0	975	set x
sl@0	976	} [list "123456" 0 8 "78901"]
sl@0	977	test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
sl@0	978	# not (*eol == '\n')
sl@0	979
sl@0	980	set f [open $path(test1) w]
sl@0	981	fconfigure $f -translation lf
sl@0	982	puts -nonewline $f "123456\r78901"
sl@0	983	close $f
sl@0	984	set f [open $path(test1)]
sl@0	985	set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
sl@0	986	close $f
sl@0	987	set x
sl@0	988	} [list "123456" 0 7 "78901"]
sl@0	989	test io-6.51 {Tcl_GetsObj: auto mode: \n} {
sl@0	990	# else if (*eol == '\n') {goto gotoeol;}
sl@0	991
sl@0	992	set f [open $path(test1) w]
sl@0	993	fconfigure $f -translation lf
sl@0	994	puts -nonewline $f "123456\n78901"
sl@0	995	close $f
sl@0	996	set f [open $path(test1)]
sl@0	997	set x [list [gets $f] [tell $f] [gets $f]]
sl@0	998	close $f
sl@0	999	set x
sl@0	1000	} [list "123456" 7 "78901"]
sl@0	1001	test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} {
sl@0	1002	# if (eof != NULL)
sl@0	1003
sl@0	1004	set f [open $path(test1) w]
sl@0	1005	fconfigure $f -translation lf
sl@0	1006	puts -nonewline $f "123456\x1ak9012345\r"
sl@0	1007	close $f
sl@0	1008	set f [open $path(test1)]
sl@0	1009	fconfigure $f -eofchar \x1a
sl@0	1010	set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
sl@0	1011	close $f
sl@0	1012	set x
sl@0	1013	} [list "123456" 0 6 ""]
sl@0	1014	test io-6.53 {Tcl_GetsObj: device EOF} {
sl@0	1015	# didn't produce any bytes
sl@0	1016
sl@0	1017	set f [open $path(test1) w]
sl@0	1018	close $f
sl@0	1019	set f [open $path(test1)]
sl@0	1020	set x [list [gets $f line] $line [eof $f]]
sl@0	1021	close $f
sl@0	1022	set x
sl@0	1023	} {-1 {} 1}
sl@0	1024	test io-6.54 {Tcl_GetsObj: device EOF} {
sl@0	1025	# got some bytes before EOF.
sl@0	1026
sl@0	1027	set f [open $path(test1) w]
sl@0	1028	puts -nonewline $f abc
sl@0	1029	close $f
sl@0	1030	set f [open $path(test1)]
sl@0	1031	set x [list [gets $f line] $line [eof $f]]
sl@0	1032	close $f
sl@0	1033	set x
sl@0	1034	} {3 abc 1}
sl@0	1035	test io-6.55 {Tcl_GetsObj: overconverted} {
sl@0	1036	# Tcl_ExternalToUtf(), make sure state updated
sl@0	1037
sl@0	1038	set f [open $path(test1) w]
sl@0	1039	fconfigure $f -encoding iso2022-jp
sl@0	1040	puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
sl@0	1041	close $f
sl@0	1042	set f [open $path(test1)]
sl@0	1043	fconfigure $f -encoding iso2022-jp
sl@0	1044	set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
sl@0	1045	close $f
sl@0	1046	set x
sl@0	1047	} [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
sl@0	1048	test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio openpipe fileevent} {
sl@0	1049	update
sl@0	1050	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	1051	fconfigure $f -buffering none
sl@0	1052	puts -nonewline $f "foobar"
sl@0	1053	fconfigure $f -blocking 0
sl@0	1054	variable x {}
sl@0	1055	after 500 [namespace code { lappend x timeout }]
sl@0	1056	fileevent $f readable [namespace code { lappend x [gets $f] }]
sl@0	1057	vwait [namespace which -variable x]
sl@0	1058	vwait [namespace which -variable x]
sl@0	1059	fconfigure $f -blocking 1
sl@0	1060	puts -nonewline $f "baz\n"
sl@0	1061	after 500 [namespace code { lappend x timeout }]
sl@0	1062	fconfigure $f -blocking 0
sl@0	1063	vwait [namespace which -variable x]
sl@0	1064	vwait [namespace which -variable x]
sl@0	1065	close $f
sl@0	1066	set x
sl@0	1067	} {{} timeout foobarbaz timeout}
sl@0	1068
sl@0	1069	test io-7.1 {FilterInputBytes: split up character at end of buffer} {
sl@0	1070	# (result == TCL_CONVERT_MULTIBYTE)
sl@0	1071
sl@0	1072	set f [open $path(test1) w]
sl@0	1073	fconfigure $f -encoding shiftjis
sl@0	1074	puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
sl@0	1075	close $f
sl@0	1076	set f [open $path(test1)]
sl@0	1077	fconfigure $f -encoding shiftjis -buffersize 16
sl@0	1078	set x [gets $f]
sl@0	1079	close $f
sl@0	1080	set x
sl@0	1081	} "1234567890123\uff10\uff11\uff12\uff13\uff14"
sl@0	1082	test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
sl@0	1083	# (bufPtr->nextAdded < bufPtr->bufLength)
sl@0	1084
sl@0	1085	set f [open $path(test1) w]
sl@0	1086	fconfigure $f -encoding binary
sl@0	1087	puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
sl@0	1088	close $f
sl@0	1089	set f [open $path(test1)]
sl@0	1090	fconfigure $f -encoding shiftjis
sl@0	1091	set x [list [gets $f line] $line [eof $f]]
sl@0	1092	close $f
sl@0	1093	set x
sl@0	1094	} [list 10 "1234567890" 0]
sl@0	1095	test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
sl@0	1096	set f [open $path(test1) w]
sl@0	1097	fconfigure $f -encoding binary
sl@0	1098	puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
sl@0	1099	close $f
sl@0	1100	set f [open $path(test1)]
sl@0	1101	fconfigure $f -encoding shiftjis
sl@0	1102	set x [list [gets $f line] $line]
sl@0	1103	lappend x [tell $f] [testchannel inputbuffered $f] [eof $f]
sl@0	1104	lappend x [gets $f line] $line
sl@0	1105	close $f
sl@0	1106	set x
sl@0	1107	} [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
sl@0	1108	test io-7.4 {FilterInputBytes: recover from split up character} {stdio openpipe fileevent} {
sl@0	1109	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	1110	fconfigure $f -encoding binary -buffering none
sl@0	1111	puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
sl@0	1112	fconfigure $f -encoding shiftjis -blocking 0
sl@0	1113	fileevent $f read [namespace code "ready $f"]
sl@0	1114	variable x {}
sl@0	1115	proc ready {f} {
sl@0	1116	variable x
sl@0	1117	lappend x [gets $f line] $line [fblocked $f]
sl@0	1118	}
sl@0	1119	vwait [namespace which -variable x]
sl@0	1120	fconfigure $f -encoding binary -blocking 1
sl@0	1121	puts $f "\x51\x82\x52"
sl@0	1122	fconfigure $f -encoding shiftjis
sl@0	1123	vwait [namespace which -variable x]
sl@0	1124	close $f
sl@0	1125	set x
sl@0	1126	} [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
sl@0	1127
sl@0	1128	test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} {
sl@0	1129	# (bufPtr->nextPtr == NULL)
sl@0	1130
sl@0	1131	set f [open $path(test1) w]
sl@0	1132	fconfigure $f -encoding ascii -translation lf
sl@0	1133	puts -nonewline $f "123456789012345\r\n2345678"
sl@0	1134	close $f
sl@0	1135	set f [open $path(test1)]
sl@0	1136	fconfigure $f -encoding ascii -translation auto -buffersize 16
sl@0	1137	# here
sl@0	1138	gets $f
sl@0	1139	set x [testchannel inputbuffered $f]
sl@0	1140	close $f
sl@0	1141	set x
sl@0	1142	} "7"
sl@0	1143	test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testchannel openpipe fileevent} {
sl@0	1144	# not (bufPtr->nextPtr == NULL)
sl@0	1145
sl@0	1146	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	1147	fconfigure $f -translation lf -encoding ascii -buffering none
sl@0	1148	puts -nonewline $f "123456789012345\r\nbcdefghijklmnopqrstuvwxyz"
sl@0	1149	variable x {}
sl@0	1150	fileevent $f read [namespace code "ready $f"]
sl@0	1151	proc ready {f} {
sl@0	1152	variable x
sl@0	1153	lappend x [gets $f line] $line [testchannel inputbuffered $f]
sl@0	1154	}
sl@0	1155	fconfigure $f -encoding unicode -buffersize 16 -blocking 0
sl@0	1156	vwait [namespace which -variable x]
sl@0	1157	fconfigure $f -translation auto -encoding ascii -blocking 1
sl@0	1158	# here
sl@0	1159	vwait [namespace which -variable x]
sl@0	1160	close $f
sl@0	1161	set x
sl@0	1162	} [list -1 "" 42 15 "123456789012345" 25]
sl@0	1163	test io-8.3 {PeekAhead: no cached data available} {stdio testchannel openpipe fileevent} {
sl@0	1164	# (bytesLeft == 0)
sl@0	1165
sl@0	1166	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	1167	fconfigure $f -translation {auto binary}
sl@0	1168	puts -nonewline $f "abcdefghijklmno\r"
sl@0	1169	flush $f
sl@0	1170	set x [list [gets $f line] $line [testchannel queuedcr $f]]
sl@0	1171	close $f
sl@0	1172	set x
sl@0	1173	} [list 15 "abcdefghijklmno" 1]
sl@0	1174	set a "123456789012345678901234567890"
sl@0	1175	append a "123456789012345678901234567890"
sl@0	1176	append a "1234567890123456789012345678901"
sl@0	1177	test io-8.4 {PeekAhead: cached data available in this buffer} {
sl@0	1178	# not (bytesLeft == 0)
sl@0	1179
sl@0	1180	set f [open $path(test1) w+]
sl@0	1181	fconfigure $f -translation binary
sl@0	1182	puts $f "${a}\r\nabcdef"
sl@0	1183	close $f
sl@0	1184	set f [open $path(test1)]
sl@0	1185	fconfigure $f -encoding binary -translation auto
sl@0	1186
sl@0	1187	# "${a}\r" was converted in one operation (because ENCODING_LINESIZE
sl@0	1188	# is 30). To check if "\n" follows, calls PeekAhead and determines
sl@0	1189	# that cached data is available in buffer w/o having to call driver.
sl@0	1190
sl@0	1191	set x [gets $f]
sl@0	1192	close $f
sl@0	1193	set x
sl@0	1194	} $a
sl@0	1195	unset a
sl@0	1196	test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
sl@0	1197	# (bufPtr->nextAdded < bufPtr->length)
sl@0	1198
sl@0	1199	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	1200	fconfigure $f -translation {auto binary}
sl@0	1201	puts -nonewline $f "abcdefghijklmno\r"
sl@0	1202	flush $f
sl@0	1203	# here
sl@0	1204	set x [list [gets $f line] $line [testchannel queuedcr $f]]
sl@0	1205	close $f
sl@0	1206	set x
sl@0	1207	} {15 abcdefghijklmno 1}
sl@0	1208	test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
sl@0	1209	# ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
sl@0	1210
sl@0	1211	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	1212	fconfigure $f -translation {auto binary} -buffersize 16
sl@0	1213	puts -nonewline $f "abcdefghijklmno\r"
sl@0	1214	flush $f
sl@0	1215	# here
sl@0	1216	set x [list [gets $f line] $line [testchannel queuedcr $f]]
sl@0	1217	close $f
sl@0	1218	set x
sl@0	1219	} {15 abcdefghijklmno 1}
sl@0	1220	test io-8.7 {PeekAhead: cleanup} {stdio testchannel openpipe fileevent} {
sl@0	1221	# Make sure bytes are removed from buffer.
sl@0	1222
sl@0	1223	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	1224	fconfigure $f -translation {auto binary} -buffering none
sl@0	1225	puts -nonewline $f "abcdefghijklmno\r"
sl@0	1226	# here
sl@0	1227	set x [list [gets $f line] $line [testchannel queuedcr $f]]
sl@0	1228	puts -nonewline $f "\x1a"
sl@0	1229	lappend x [gets $f line] $line
sl@0	1230	close $f
sl@0	1231	set x
sl@0	1232	} {15 abcdefghijklmno 1 -1 {}}
sl@0	1233
sl@0	1234
sl@0	1235	test io-9.1 {CommonGetsCleanup} {
sl@0	1236	} {}
sl@0	1237
sl@0	1238	test io-10.1 {Tcl_ReadChars: CheckChannelErrors} {
sl@0	1239	# no test, need to cause an async error.
sl@0	1240	} {}
sl@0	1241	test io-10.2 {Tcl_ReadChars: loop until enough copied} {
sl@0	1242	# one time
sl@0	1243	# for (copied = 0; (unsigned) toRead > 0; )
sl@0	1244
sl@0	1245	set f [open $path(test1) w]
sl@0	1246	puts $f abcdefghijklmnop
sl@0	1247	close $f
sl@0	1248
sl@0	1249	set f [open $path(test1)]
sl@0	1250	set x [read $f 5]
sl@0	1251	close $f
sl@0	1252	set x
sl@0	1253	} {abcde}
sl@0	1254	test io-10.3 {Tcl_ReadChars: loop until enough copied} {
sl@0	1255	# multiple times
sl@0	1256	# for (copied = 0; (unsigned) toRead > 0; )
sl@0	1257
sl@0	1258	set f [open $path(test1) w]
sl@0	1259	puts $f abcdefghijklmnopqrstuvwxyz
sl@0	1260	close $f
sl@0	1261
sl@0	1262	set f [open $path(test1)]
sl@0	1263	fconfigure $f -buffersize 16
sl@0	1264	# here
sl@0	1265	set x [read $f 19]
sl@0	1266	close $f
sl@0	1267	set x
sl@0	1268	} {abcdefghijklmnopqrs}
sl@0	1269	test io-10.4 {Tcl_ReadChars: no more in channel buffer} {
sl@0	1270	# (copiedNow < 0)
sl@0	1271
sl@0	1272	set f [open $path(test1) w]
sl@0	1273	puts -nonewline $f abcdefghijkl
sl@0	1274	close $f
sl@0	1275
sl@0	1276	set f [open $path(test1)]
sl@0	1277	# here
sl@0	1278	set x [read $f 1000]
sl@0	1279	close $f
sl@0	1280	set x
sl@0	1281	} {abcdefghijkl}
sl@0	1282	test io-10.5 {Tcl_ReadChars: stop on EOF} {
sl@0	1283	# (chanPtr->flags & CHANNEL_EOF)
sl@0	1284
sl@0	1285	set f [open $path(test1) w]
sl@0	1286	puts -nonewline $f abcdefghijkl
sl@0	1287	close $f
sl@0	1288
sl@0	1289	set f [open $path(test1)]
sl@0	1290	# here
sl@0	1291	set x [read $f 1000]
sl@0	1292	close $f
sl@0	1293	set x
sl@0	1294	} {abcdefghijkl}
sl@0	1295
sl@0	1296	test io-11.1 {ReadBytes: want to read a lot} {
sl@0	1297	# ((unsigned) toRead > (unsigned) srcLen)
sl@0	1298
sl@0	1299	set f [open $path(test1) w]
sl@0	1300	puts -nonewline $f abcdefghijkl
sl@0	1301	close $f
sl@0	1302	set f [open $path(test1)]
sl@0	1303	fconfigure $f -encoding binary
sl@0	1304	# here
sl@0	1305	set x [read $f 1000]
sl@0	1306	close $f
sl@0	1307	set x
sl@0	1308	} {abcdefghijkl}
sl@0	1309	test io-11.2 {ReadBytes: want to read all} {
sl@0	1310	# ((unsigned) toRead > (unsigned) srcLen)
sl@0	1311
sl@0	1312	set f [open $path(test1) w]
sl@0	1313	puts -nonewline $f abcdefghijkl
sl@0	1314	close $f
sl@0	1315	set f [open $path(test1)]
sl@0	1316	fconfigure $f -encoding binary
sl@0	1317	# here
sl@0	1318	set x [read $f]
sl@0	1319	close $f
sl@0	1320	set x
sl@0	1321	} {abcdefghijkl}
sl@0	1322	test io-11.3 {ReadBytes: allocate more space} {
sl@0	1323	# (toRead > length - offset - 1)
sl@0	1324
sl@0	1325	set f [open $path(test1) w]
sl@0	1326	puts -nonewline $f abcdefghijklmnopqrstuvwxyz
sl@0	1327	close $f
sl@0	1328	set f [open $path(test1)]
sl@0	1329	fconfigure $f -buffersize 16 -encoding binary
sl@0	1330	# here
sl@0	1331	set x [read $f]
sl@0	1332	close $f
sl@0	1333	set x
sl@0	1334	} {abcdefghijklmnopqrstuvwxyz}
sl@0	1335	test io-11.4 {ReadBytes: EOF char found} {
sl@0	1336	# (TranslateInputEOL() != 0)
sl@0	1337
sl@0	1338	set f [open $path(test1) w]
sl@0	1339	puts $f abcdefghijklmnopqrstuvwxyz
sl@0	1340	close $f
sl@0	1341	set f [open $path(test1)]
sl@0	1342	fconfigure $f -eofchar m -encoding binary
sl@0	1343	# here
sl@0	1344	set x [list [read $f] [eof $f] [read $f] [eof $f]]
sl@0	1345	close $f
sl@0	1346	set x
sl@0	1347	} [list "abcdefghijkl" 1 "" 1]
sl@0	1348
sl@0	1349	test io-12.1 {ReadChars: want to read a lot} {
sl@0	1350	# ((unsigned) toRead > (unsigned) srcLen)
sl@0	1351
sl@0	1352	set f [open $path(test1) w]
sl@0	1353	puts -nonewline $f abcdefghijkl
sl@0	1354	close $f
sl@0	1355	set f [open $path(test1)]
sl@0	1356	# here
sl@0	1357	set x [read $f 1000]
sl@0	1358	close $f
sl@0	1359	set x
sl@0	1360	} {abcdefghijkl}
sl@0	1361	test io-12.2 {ReadChars: want to read all} {
sl@0	1362	# ((unsigned) toRead > (unsigned) srcLen)
sl@0	1363
sl@0	1364	set f [open $path(test1) w]
sl@0	1365	puts -nonewline $f abcdefghijkl
sl@0	1366	close $f
sl@0	1367	set f [open $path(test1)]
sl@0	1368	# here
sl@0	1369	set x [read $f]
sl@0	1370	close $f
sl@0	1371	set x
sl@0	1372	} {abcdefghijkl}
sl@0	1373	test io-12.3 {ReadChars: allocate more space} {
sl@0	1374	# (toRead > length - offset - 1)
sl@0	1375
sl@0	1376	set f [open $path(test1) w]
sl@0	1377	puts -nonewline $f abcdefghijklmnopqrstuvwxyz
sl@0	1378	close $f
sl@0	1379	set f [open $path(test1)]
sl@0	1380	fconfigure $f -buffersize 16
sl@0	1381	# here
sl@0	1382	set x [read $f]
sl@0	1383	close $f
sl@0	1384	set x
sl@0	1385	} {abcdefghijklmnopqrstuvwxyz}
sl@0	1386	test io-12.4 {ReadChars: split-up char} {stdio testchannel openpipe fileevent} {
sl@0	1387	# (srcRead == 0)
sl@0	1388
sl@0	1389	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	1390	fconfigure $f -encoding binary -buffering none -buffersize 16
sl@0	1391	puts -nonewline $f "123456789012345\x96"
sl@0	1392	fconfigure $f -encoding shiftjis -blocking 0
sl@0	1393
sl@0	1394	fileevent $f read [namespace code "ready $f"]
sl@0	1395	proc ready {f} {
sl@0	1396	variable x
sl@0	1397	lappend x [read $f] [testchannel inputbuffered $f]
sl@0	1398	}
sl@0	1399	variable x {}
sl@0	1400
sl@0	1401	fconfigure $f -encoding shiftjis
sl@0	1402	vwait [namespace which -variable x]
sl@0	1403	fconfigure $f -encoding binary -blocking 1
sl@0	1404	puts -nonewline $f "\x7b"
sl@0	1405	after 500 ;# Give the cat process time to catch up
sl@0	1406	fconfigure $f -encoding shiftjis -blocking 0
sl@0	1407	vwait [namespace which -variable x]
sl@0	1408	close $f
sl@0	1409	set x
sl@0	1410	} [list "123456789012345" 1 "\u672c" 0]
sl@0	1411	test io-12.5 {ReadChars: fileevents on partial characters} {stdio openpipe fileevent} {
sl@0	1412	set path(test1) [makeFile {
sl@0	1413	fconfigure stdout -encoding binary -buffering none
sl@0	1414	gets stdin; puts -nonewline "\xe7"
sl@0	1415	gets stdin; puts -nonewline "\x89"
sl@0	1416	gets stdin; puts -nonewline "\xa6"
sl@0	1417	} test1]
sl@0	1418	set f [open "\|[list [interpreter] $path(test1)]" r+]
sl@0	1419	fileevent $f readable [namespace code {
sl@0	1420	lappend x [read $f]
sl@0	1421	if {[eof $f]} {
sl@0	1422	lappend x eof
sl@0	1423	}
sl@0	1424	}]
sl@0	1425	puts $f "go1"
sl@0	1426	flush $f
sl@0	1427	fconfigure $f -blocking 0 -encoding utf-8
sl@0	1428	variable x {}
sl@0	1429	vwait [namespace which -variable x]
sl@0	1430	after 500 [namespace code { lappend x timeout }]
sl@0	1431	vwait [namespace which -variable x]
sl@0	1432	puts $f "go2"
sl@0	1433	flush $f
sl@0	1434	vwait [namespace which -variable x]
sl@0	1435	after 500 [namespace code { lappend x timeout }]
sl@0	1436	vwait [namespace which -variable x]
sl@0	1437	puts $f "go3"
sl@0	1438	flush $f
sl@0	1439	vwait [namespace which -variable x]
sl@0	1440	vwait [namespace which -variable x]
sl@0	1441	lappend x [catch {close $f} msg] $msg
sl@0	1442	set x
sl@0	1443	} "{} timeout {} timeout \u7266 {} eof 0 {}"
sl@0	1444
sl@0	1445	test io-13.1 {TranslateInputEOL: cr mode} {} {
sl@0	1446	set f [open $path(test1) w]
sl@0	1447	fconfigure $f -translation lf
sl@0	1448	puts -nonewline $f "abcd\rdef\r"
sl@0	1449	close $f
sl@0	1450	set f [open $path(test1)]
sl@0	1451	fconfigure $f -translation cr
sl@0	1452	set x [read $f]
sl@0	1453	close $f
sl@0	1454	set x
sl@0	1455	} "abcd\ndef\n"
sl@0	1456	test io-13.2 {TranslateInputEOL: crlf mode} {
sl@0	1457	set f [open $path(test1) w]
sl@0	1458	fconfigure $f -translation lf
sl@0	1459	puts -nonewline $f "abcd\r\ndef\r\n"
sl@0	1460	close $f
sl@0	1461	set f [open $path(test1)]
sl@0	1462	fconfigure $f -translation crlf
sl@0	1463	set x [read $f]
sl@0	1464	close $f
sl@0	1465	set x
sl@0	1466	} "abcd\ndef\n"
sl@0	1467	test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
sl@0	1468	# (src >= srcMax)
sl@0	1469
sl@0	1470	set f [open $path(test1) w]
sl@0	1471	fconfigure $f -translation lf
sl@0	1472	puts -nonewline $f "abcd\r\ndef\r"
sl@0	1473	close $f
sl@0	1474	set f [open $path(test1)]
sl@0	1475	fconfigure $f -translation crlf
sl@0	1476	set x [read $f]
sl@0	1477	close $f
sl@0	1478	set x
sl@0	1479	} "abcd\ndef\r"
sl@0	1480	test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
sl@0	1481	# (src >= srcMax)
sl@0	1482
sl@0	1483	set f [open $path(test1) w]
sl@0	1484	fconfigure $f -translation lf
sl@0	1485	puts -nonewline $f "abcd\r\ndef\rfgh"
sl@0	1486	close $f
sl@0	1487	set f [open $path(test1)]
sl@0	1488	fconfigure $f -translation crlf
sl@0	1489	set x [read $f]
sl@0	1490	close $f
sl@0	1491	set x
sl@0	1492	} "abcd\ndef\rfgh"
sl@0	1493	test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
sl@0	1494	# (src >= srcMax)
sl@0	1495
sl@0	1496	set f [open $path(test1) w]
sl@0	1497	fconfigure $f -translation lf
sl@0	1498	puts -nonewline $f "abcd\r\ndef\nfgh"
sl@0	1499	close $f
sl@0	1500	set f [open $path(test1)]
sl@0	1501	fconfigure $f -translation crlf
sl@0	1502	set x [read $f]
sl@0	1503	close $f
sl@0	1504	set x
sl@0	1505	} "abcd\ndef\nfgh"
sl@0	1506	test io-13.6 {TranslateInputEOL: auto mode: saw cr in last segment} {stdio testchannel openpipe fileevent} {
sl@0	1507	# (chanPtr->flags & INPUT_SAW_CR)
sl@0	1508	# This test may fail on slower machines.
sl@0	1509
sl@0	1510	set f [open "\|[list [interpreter] $path(cat)]" w+]
sl@0	1511	fconfigure $f -blocking 0 -buffering none -translation {auto lf}
sl@0	1512
sl@0	1513	fileevent $f read [namespace code "ready $f"]
sl@0	1514	proc ready {f} {
sl@0	1515	variable x
sl@0	1516	lappend x [read $f] [testchannel queuedcr $f]
sl@0	1517	}
sl@0	1518	variable x {}
sl@0	1519	variable y {}
sl@0	1520
sl@0	1521	puts -nonewline $f "abcdefghj\r"
sl@0	1522	after 500 [namespace code {set y ok}]
sl@0	1523	vwait [namespace which -variable y]
sl@0	1524
sl@0	1525	puts -nonewline $f "\n01234"
sl@0	1526	after 500 [namespace code {set y ok}]
sl@0	1527	vwait [namespace which -variable y]
sl@0	1528
sl@0	1529	close $f
sl@0	1530	set x
sl@0	1531	} [list "abcdefghj\n" 1 "01234" 0]
sl@0	1532	test io-13.7 {TranslateInputEOL: auto mode: naked \r} {testchannel openpipe} {
sl@0	1533	# (src >= srcMax)
sl@0	1534
sl@0	1535	set f [open $path(test1) w]
sl@0	1536	fconfigure $f -translation lf
sl@0	1537	puts -nonewline $f "abcd\r"
sl@0	1538	close $f
sl@0	1539	set f [open $path(test1)]
sl@0	1540	fconfigure $f -translation auto
sl@0	1541	set x [list [read $f] [testchannel queuedcr $f]]
sl@0	1542	close $f
sl@0	1543	set x
sl@0	1544	} [list "abcd\n" 1]
sl@0	1545	test io-13.8 {TranslateInputEOL: auto mode: \r\n} {
sl@0	1546	# (*src == '\n')
sl@0	1547
sl@0	1548	set f [open $path(test1) w]
sl@0	1549	fconfigure $f -translation lf
sl@0	1550	puts -nonewline $f "abcd\r\ndef"
sl@0	1551	close $f
sl@0	1552	set f [open $path(test1)]
sl@0	1553	fconfigure $f -translation auto
sl@0	1554	set x [read $f]
sl@0	1555	close $f
sl@0	1556	set x
sl@0	1557	} "abcd\ndef"
sl@0	1558	test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
sl@0	1559	set f [open $path(test1) w]
sl@0	1560	fconfigure $f -translation lf
sl@0	1561	puts -nonewline $f "abcd\rdef"
sl@0	1562	close $f
sl@0	1563	set f [open $path(test1)]
sl@0	1564	fconfigure $f -translation auto
sl@0	1565	set x [read $f]
sl@0	1566	close $f
sl@0	1567	set x
sl@0	1568	} "abcd\ndef"
sl@0	1569	test io-13.10 {TranslateInputEOL: auto mode: \n} {
sl@0	1570	# not (*src == '\r')
sl@0	1571
sl@0	1572	set f [open $path(test1) w]
sl@0	1573	fconfigure $f -translation lf
sl@0	1574	puts -nonewline $f "abcd\ndef"
sl@0	1575	close $f
sl@0	1576	set f [open $path(test1)]
sl@0	1577	fconfigure $f -translation auto
sl@0	1578	set x [read $f]
sl@0	1579	close $f
sl@0	1580	set x
sl@0	1581	} "abcd\ndef"
sl@0	1582	test io-13.11 {TranslateInputEOL: EOF char} {
sl@0	1583	# (*chanPtr->inEofChar != '\0')
sl@0	1584
sl@0	1585	set f [open $path(test1) w]
sl@0	1586	fconfigure $f -translation lf
sl@0	1587	puts -nonewline $f "abcd\ndefgh"
sl@0	1588	close $f
sl@0	1589	set f [open $path(test1)]
sl@0	1590	fconfigure $f -translation auto -eofchar e
sl@0	1591	set x [read $f]
sl@0	1592	close $f
sl@0	1593	set x
sl@0	1594	} "abcd\nd"
sl@0	1595	test io-13.12 {TranslateInputEOL: find EOF char in src} {
sl@0	1596	# (*chanPtr->inEofChar != '\0')
sl@0	1597
sl@0	1598	set f [open $path(test1) w]
sl@0	1599	fconfigure $f -translation lf
sl@0	1600	puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
sl@0	1601	close $f
sl@0	1602	set f [open $path(test1)]
sl@0	1603	fconfigure $f -translation auto -eofchar e
sl@0	1604	set x [read $f]
sl@0	1605	close $f
sl@0	1606	set x
sl@0	1607	} "\n\n\nab\n\nd"
sl@0	1608
sl@0	1609	# Test standard handle management. The functions tested are
sl@0	1610	# Tcl_SetStdChannel and Tcl_GetStdChannel. Incidentally we are
sl@0	1611	# also testing channel table management.
sl@0	1612
sl@0	1613	if {[info commands testchannel] != ""} {
sl@0	1614	if {$tcl_platform(platform) == "macintosh"} {
sl@0	1615	set consoleFileNames [list console0 console1 console2]
sl@0	1616	} else {
sl@0	1617	set consoleFileNames [lsort [testchannel open]]
sl@0	1618	}
sl@0	1619	} else {
sl@0	1620	# just to avoid an error
sl@0	1621	set consoleFileNames [list]
sl@0	1622	}
sl@0	1623
sl@0	1624	test io-14.1 {Tcl_SetStdChannel and Tcl_GetStdChannel} {testchannel} {
sl@0	1625	set l ""
sl@0	1626	lappend l [fconfigure stdin -buffering]
sl@0	1627	lappend l [fconfigure stdout -buffering]
sl@0	1628	lappend l [fconfigure stderr -buffering]
sl@0	1629	lappend l [lsort [testchannel open]]
sl@0	1630	set l
sl@0	1631	} [list line line none $consoleFileNames]
sl@0	1632	test io-14.2 {Tcl_SetStdChannel and Tcl_GetStdChannel} {
sl@0	1633	interp create x
sl@0	1634	set l ""
sl@0	1635	lappend l [x eval {fconfigure stdin -buffering}]
sl@0	1636	lappend l [x eval {fconfigure stdout -buffering}]
sl@0	1637	lappend l [x eval {fconfigure stderr -buffering}]
sl@0	1638	interp delete x
sl@0	1639	set l
sl@0	1640	} {line line none}
sl@0	1641
sl@0	1642	set path(test3) [makeFile {} test3]
sl@0	1643
sl@0	1644	test io-14.3 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec openpipe} {
sl@0	1645	set f [open $path(test1) w]
sl@0	1646	puts -nonewline $f {
sl@0	1647	close stdin
sl@0	1648	close stdout
sl@0	1649	close stderr
sl@0	1650	set f [}
sl@0	1651	puts $f [list open $path(test1) r]]
sl@0	1652	puts $f "set f2 \[[list open $path(test2) w]]"
sl@0	1653	puts $f "set f3 \[[list open $path(test3) w]]"
sl@0	1654	puts $f { puts stdout [gets stdin]
sl@0	1655	puts stdout out
sl@0	1656	puts stderr err
sl@0	1657	close $f
sl@0	1658	close $f2
sl@0	1659	close $f3
sl@0	1660	}
sl@0	1661	close $f
sl@0	1662	set result [exec [interpreter] $path(test1)]
sl@0	1663	set f [open $path(test2) r]
sl@0	1664	set f2 [open $path(test3) r]
sl@0	1665	lappend result [read $f] [read $f2]
sl@0	1666	close $f
sl@0	1667	close $f2
sl@0	1668	set result
sl@0	1669	} {{
sl@0	1670	out
sl@0	1671	} {err
sl@0	1672	}}
sl@0	1673	# This test relies on the fact that the smallest available fd is used first.
sl@0	1674	test io-14.4 {Tcl_SetStdChannel & Tcl_GetStdChannel} {exec unixOnly} {
sl@0	1675	set f [open $path(test1) w]
sl@0	1676	puts -nonewline $f { close stdin
sl@0	1677	close stdout
sl@0	1678	close stderr
sl@0	1679	set f [}
sl@0	1680	puts $f [list open $path(test1) r]]
sl@0	1681	puts $f "set f2 \[[list open $path(test2) w]]"
sl@0	1682	puts $f "set f3 \[[list open $path(test3) w]]"
sl@0	1683	puts $f { puts stdout [gets stdin]
sl@0	1684	puts stdout $f2
sl@0	1685	puts stderr $f3
sl@0	1686	close $f
sl@0	1687	close $f2
sl@0	1688	close $f3
sl@0	1689	}
sl@0	1690	close $f
sl@0	1691	set result [exec [interpreter] $path(test1)]
sl@0	1692	set f [open $path(test2) r]
sl@0	1693	set f2 [open $path(test3) r]
sl@0	1694	lappend result [read $f] [read $f2]
sl@0	1695	close $f
sl@0	1696	close $f2
sl@0	1697	set result
sl@0	1698	} {{ close stdin
sl@0	1699	file1
sl@0	1700	} {file2
sl@0	1701	}}
sl@0	1702	catch {interp delete z}
sl@0	1703	test io-14.5 {Tcl_GetChannel: stdio name translation} {
sl@0	1704	interp create z
sl@0	1705	eof stdin
sl@0	1706	catch {z eval flush stdin} msg1
sl@0	1707	catch {z eval close stdin} msg2
sl@0	1708	catch {z eval flush stdin} msg3
sl@0	1709	set result [list $msg1 $msg2 $msg3]
sl@0	1710	interp delete z
sl@0	1711	set result
sl@0	1712	} {{channel "stdin" wasn't opened for writing} {} {can not find channel named "stdin"}}
sl@0	1713	test io-14.6 {Tcl_GetChannel: stdio name translation} {
sl@0	1714	interp create z
sl@0	1715	eof stdout
sl@0	1716	catch {z eval flush stdout} msg1
sl@0	1717	catch {z eval close stdout} msg2
sl@0	1718	catch {z eval flush stdout} msg3
sl@0	1719	set result [list $msg1 $msg2 $msg3]
sl@0	1720	interp delete z
sl@0	1721	set result
sl@0	1722	} {{} {} {can not find channel named "stdout"}}
sl@0	1723	test io-14.7 {Tcl_GetChannel: stdio name translation} {
sl@0	1724	interp create z
sl@0	1725	eof stderr
sl@0	1726	catch {z eval flush stderr} msg1
sl@0	1727	catch {z eval close stderr} msg2
sl@0	1728	catch {z eval flush stderr} msg3
sl@0	1729	set result [list $msg1 $msg2 $msg3]
sl@0	1730	interp delete z
sl@0	1731	set result
sl@0	1732	} {{} {} {can not find channel named "stderr"}}
sl@0	1733
sl@0	1734	set path(script) [makeFile {} script]
sl@0	1735
sl@0	1736	test io-14.8 {reuse of stdio special channels} {stdio openpipe} {
sl@0	1737	file delete $path(script)
sl@0	1738	file delete $path(test1)
sl@0	1739	set f [open $path(script) w]
sl@0	1740	puts -nonewline $f {
sl@0	1741	close stderr
sl@0	1742	set f [}
sl@0	1743	puts $f [list open $path(test1) w]]
sl@0	1744	puts -nonewline $f {
sl@0	1745	puts stderr hello
sl@0	1746	close $f
sl@0	1747	set f [}
sl@0	1748	puts $f [list open $path(test1) r]]
sl@0	1749	puts $f {
sl@0	1750	puts [gets $f]
sl@0	1751	}
sl@0	1752	close $f
sl@0	1753	set f [open "\|[list [interpreter] $path(script)]" r]
sl@0	1754	set c [gets $f]
sl@0	1755	close $f
sl@0	1756	set c
sl@0	1757	} hello
sl@0	1758
sl@0	1759	test io-14.9 {reuse of stdio special channels} {stdio openpipe fileevent} {
sl@0	1760	file delete $path(script)
sl@0	1761	file delete $path(test1)
sl@0	1762	set f [open $path(script) w]
sl@0	1763	puts $f {
sl@0	1764	array set path [lindex $argv 0]
sl@0	1765	set f [open $path(test1) w]
sl@0	1766	puts $f hello
sl@0	1767	close $f
sl@0	1768	close stderr
sl@0	1769	set f [open "\|[list [info nameofexecutable] $path(cat) $path(test1)]" r]
sl@0	1770	puts [gets $f]
sl@0	1771	}
sl@0	1772	close $f
sl@0	1773	set f [open "\|[list [interpreter] $path(script) [array get path]]" r]
sl@0	1774	set c [gets $f]
sl@0	1775	close $f
sl@0	1776	# Added delay to give Windows time to stop the spawned process and clean
sl@0	1777	# up its grip on the file test1. Added delete as proper test cleanup.
sl@0	1778	# The failing tests were 18.1 and 18.2 as first re-users of file "test1".
sl@0	1779	after 10000
sl@0	1780	file delete $path(script)
sl@0	1781	file delete $path(test1)
sl@0	1782	set c
sl@0	1783	} hello
sl@0	1784
sl@0	1785	test io-15.1 {Tcl_CreateCloseHandler} {
sl@0	1786	} {}
sl@0	1787
sl@0	1788	test io-16.1 {Tcl_DeleteCloseHandler} {
sl@0	1789	} {}
sl@0	1790
sl@0	1791	# Test channel table management. The functions tested are
sl@0	1792	# GetChannelTable, DeleteChannelTable, Tcl_RegisterChannel,
sl@0	1793	# Tcl_UnregisterChannel, Tcl_GetChannel and Tcl_CreateChannel.
sl@0	1794	#
sl@0	1795	# These functions use "eof stdin" to ensure that the standard
sl@0	1796	# channels are added to the channel table of the interpreter.
sl@0	1797
sl@0	1798	test io-17.1 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
sl@0	1799	set l1 [testchannel refcount stdin]
sl@0	1800	eof stdin
sl@0	1801	interp create x
sl@0	1802	set l ""
sl@0	1803	lappend l [expr [testchannel refcount stdin] - $l1]
sl@0	1804	x eval {eof stdin}
sl@0	1805	lappend l [expr [testchannel refcount stdin] - $l1]
sl@0	1806	interp delete x
sl@0	1807	lappend l [expr [testchannel refcount stdin] - $l1]
sl@0	1808	set l
sl@0	1809	} {0 1 0}
sl@0	1810	test io-17.2 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
sl@0	1811	set l1 [testchannel refcount stdout]
sl@0	1812	eof stdin
sl@0	1813	interp create x
sl@0	1814	set l ""
sl@0	1815	lappend l [expr [testchannel refcount stdout] - $l1]
sl@0	1816	x eval {eof stdout}
sl@0	1817	lappend l [expr [testchannel refcount stdout] - $l1]
sl@0	1818	interp delete x
sl@0	1819	lappend l [expr [testchannel refcount stdout] - $l1]
sl@0	1820	set l
sl@0	1821	} {0 1 0}
sl@0	1822	test io-17.3 {GetChannelTable, DeleteChannelTable on std handles} {testchannel} {
sl@0	1823	set l1 [testchannel refcount stderr]
sl@0	1824	eof stdin
sl@0	1825	interp create x
sl@0	1826	set l ""
sl@0	1827	lappend l [expr [testchannel refcount stderr] - $l1]
sl@0	1828	x eval {eof stderr}
sl@0	1829	lappend l [expr [testchannel refcount stderr] - $l1]
sl@0	1830	interp delete x
sl@0	1831	lappend l [expr [testchannel refcount stderr] - $l1]
sl@0	1832	set l
sl@0	1833	} {0 1 0}
sl@0	1834
sl@0	1835	test io-18.1 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
sl@0	1836	file delete $path(test1)
sl@0	1837	set l ""
sl@0	1838	set f [open $path(test1) w]
sl@0	1839	lappend l [lindex [testchannel info $f] 15]
sl@0	1840	close $f
sl@0	1841	if {[catch {lindex [testchannel info $f] 15} msg]} {
sl@0	1842	lappend l $msg
sl@0	1843	} else {
sl@0	1844	lappend l "very broken: $f found after being closed"
sl@0	1845	}
sl@0	1846	string compare [string tolower $l] \
sl@0	1847	[list 1 [format "can not find channel named \"%s\"" $f]]
sl@0	1848	} 0
sl@0	1849	test io-18.2 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
sl@0	1850	file delete $path(test1)
sl@0	1851	set l ""
sl@0	1852	set f [open $path(test1) w]
sl@0	1853	lappend l [lindex [testchannel info $f] 15]
sl@0	1854	interp create x
sl@0	1855	interp share "" $f x
sl@0	1856	lappend l [lindex [testchannel info $f] 15]
sl@0	1857	x eval close $f
sl@0	1858	lappend l [lindex [testchannel info $f] 15]
sl@0	1859	interp delete x
sl@0	1860	lappend l [lindex [testchannel info $f] 15]
sl@0	1861	close $f
sl@0	1862	if {[catch {lindex [testchannel info $f] 15} msg]} {
sl@0	1863	lappend l $msg
sl@0	1864	} else {
sl@0	1865	lappend l "very broken: $f found after being closed"
sl@0	1866	}
sl@0	1867	string compare [string tolower $l] \
sl@0	1868	[list 1 2 1 1 [format "can not find channel named \"%s\"" $f]]
sl@0	1869	} 0
sl@0	1870	test io-18.3 {Tcl_RegisterChannel, Tcl_UnregisterChannel} {testchannel} {
sl@0	1871	file delete $path(test1)
sl@0	1872	set l ""
sl@0	1873	set f [open $path(test1) w]
sl@0	1874	lappend l [lindex [testchannel info $f] 15]
sl@0	1875	interp create x
sl@0	1876	interp share "" $f x
sl@0	1877	lappend l [lindex [testchannel info $f] 15]
sl@0	1878	interp delete x
sl@0	1879	lappend l [lindex [testchannel info $f] 15]
sl@0	1880	close $f
sl@0	1881	if {[catch {lindex [testchannel info $f] 15} msg]} {
sl@0	1882	lappend l $msg
sl@0	1883	} else {
sl@0	1884	lappend l "very broken: $f found after being closed"
sl@0	1885	}
sl@0	1886	string compare [string tolower $l] \
sl@0	1887	[list 1 2 1 [format "can not find channel named \"%s\"" $f]]
sl@0	1888	} 0
sl@0	1889
sl@0	1890	test io-19.1 {Tcl_GetChannel->Tcl_GetStdChannel, standard handles} {
sl@0	1891	eof stdin
sl@0	1892	} 0
sl@0	1893	test io-19.2 {testing Tcl_GetChannel, user opened handle} {
sl@0	1894	file delete $path(test1)
sl@0	1895	set f [open $path(test1) w]
sl@0	1896	set x [eof $f]
sl@0	1897	close $f
sl@0	1898	set x
sl@0	1899	} 0
sl@0	1900	test io-19.3 {Tcl_GetChannel, channel not found} {
sl@0	1901	list [catch {eof file34} msg] $msg
sl@0	1902	} {1 {can not find channel named "file34"}}
sl@0	1903	test io-19.4 {Tcl_CreateChannel, insertion into channel table} {testchannel} {
sl@0	1904	file delete $path(test1)
sl@0	1905	set f [open $path(test1) w]
sl@0	1906	set l ""
sl@0	1907	lappend l [eof $f]
sl@0	1908	close $f
sl@0	1909	if {[catch {lindex [testchannel info $f] 15} msg]} {
sl@0	1910	lappend l $msg
sl@0	1911	} else {
sl@0	1912	lappend l "very broken: $f found after being closed"
sl@0	1913	}
sl@0	1914	string compare [string tolower $l] \
sl@0	1915	[list 0 [format "can not find channel named \"%s\"" $f]]
sl@0	1916	} 0
sl@0	1917
sl@0	1918	test io-20.1 {Tcl_CreateChannel: initial settings} {
sl@0	1919	set a [open $path(test2) w]
sl@0	1920	set old [encoding system]
sl@0	1921	encoding system ascii
sl@0	1922	set f [open $path(test1) w]
sl@0	1923	set x [fconfigure $f -encoding]
sl@0	1924	close $f
sl@0	1925	encoding system $old
sl@0	1926	close $a
sl@0	1927	set x
sl@0	1928	} {ascii}
sl@0	1929	test io-20.2 {Tcl_CreateChannel: initial settings} {pcOnly} {
sl@0	1930	set f [open $path(test1) w+]
sl@0	1931	set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
sl@0	1932	close $f
sl@0	1933	set x
sl@0	1934	} [list [list \x1a ""] {auto crlf}]
sl@0	1935	test io-20.3 {Tcl_CreateChannel: initial settings} {unixOnly} {
sl@0	1936	set f [open $path(test1) w+]
sl@0	1937	set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
sl@0	1938	close $f
sl@0	1939	set x
sl@0	1940	} {{{} {}} {auto lf}}
sl@0	1941	test io-20.4 {Tcl_CreateChannel: initial settings} {macOnly} {
sl@0	1942	set f [open $path(test1) w+]
sl@0	1943	set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
sl@0	1944	close $f
sl@0	1945	set x
sl@0	1946	} {{{} {}} {auto cr}}
sl@0	1947
sl@0	1948	set path(stdout) [makeFile {} stdout]
sl@0	1949
sl@0	1950	test io-20.5 {Tcl_CreateChannel: install channel in empty slot} {stdio openpipe} {
sl@0	1951	set f [open $path(script) w]
sl@0	1952	puts -nonewline $f {
sl@0	1953	close stdout
sl@0	1954	set f1 [}
sl@0	1955	puts $f [list open $path(stdout) w]]
sl@0	1956	puts $f {
sl@0	1957	fconfigure $f1 -buffersize 777
sl@0	1958	puts stderr [fconfigure stdout -buffersize]
sl@0	1959	}
sl@0	1960	close $f
sl@0	1961	set f [open "\|[list [interpreter] $path(script)]"]
sl@0	1962	catch {close $f} msg
sl@0	1963	set msg
sl@0	1964	} {777}
sl@0	1965
sl@0	1966	test io-21.1 {CloseChannelsOnExit} {
sl@0	1967	} {}
sl@0	1968
sl@0	1969	# Test management of attributes associated with a channel, such as
sl@0	1970	# its default translation, its name and type, etc. The functions
sl@0	1971	# tested in this group are Tcl_GetChannelName,
sl@0	1972	# Tcl_GetChannelType and Tcl_GetChannelFile. Tcl_GetChannelInstanceData
sl@0	1973	# not tested because files do not use the instance data.
sl@0	1974
sl@0	1975	test io-22.1 {Tcl_GetChannelMode} {
sl@0	1976	# Not used anywhere in Tcl.
sl@0	1977	} {}
sl@0	1978
sl@0	1979	test io-23.1 {Tcl_GetChannelName} {testchannel} {
sl@0	1980	file delete $path(test1)
sl@0	1981	set f [open $path(test1) w]
sl@0	1982	set n [testchannel name $f]
sl@0	1983	close $f
sl@0	1984	string compare $n $f
sl@0	1985	} 0
sl@0	1986
sl@0	1987	test io-24.1 {Tcl_GetChannelType} {testchannel} {
sl@0	1988	file delete $path(test1)
sl@0	1989	set f [open $path(test1) w]
sl@0	1990	set t [testchannel type $f]
sl@0	1991	close $f
sl@0	1992	string compare $t file
sl@0	1993	} 0
sl@0	1994
sl@0	1995	test io-25.1 {Tcl_GetChannelHandle, input} {testchannel} {
sl@0	1996	set f [open $path(test1) w]
sl@0	1997	fconfigure $f -translation lf -eofchar {}
sl@0	1998	puts $f "1234567890\n098765432"
sl@0	1999	close $f
sl@0	2000	set f [open $path(test1) r]
sl@0	2001	gets $f
sl@0	2002	set l ""
sl@0	2003	lappend l [testchannel inputbuffered $f]
sl@0	2004	lappend l [tell $f]
sl@0	2005	close $f
sl@0	2006	set l
sl@0	2007	} {10 11}
sl@0	2008	test io-25.2 {Tcl_GetChannelHandle, output} {testchannel} {
sl@0	2009	file delete $path(test1)
sl@0	2010	set f [open $path(test1) w]
sl@0	2011	fconfigure $f -translation lf
sl@0	2012	puts $f hello
sl@0	2013	set l ""
sl@0	2014	lappend l [testchannel outputbuffered $f]
sl@0	2015	lappend l [tell $f]
sl@0	2016	flush $f
sl@0	2017	lappend l [testchannel outputbuffered $f]
sl@0	2018	lappend l [tell $f]
sl@0	2019	close $f
sl@0	2020	file delete $path(test1)
sl@0	2021	set l
sl@0	2022	} {6 6 0 6}
sl@0	2023
sl@0	2024	test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
sl@0	2025	# "pid" command uses Tcl_GetChannelInstanceData
sl@0	2026	# Don't care what pid is (but must be a number), just want to exercise it.
sl@0	2027
sl@0	2028	set f [open "\|[list [interpreter] << exit]"]
sl@0	2029	expr [pid $f]
sl@0	2030	close $f
sl@0	2031	} {}
sl@0	2032
sl@0	2033	# Test flushing. The functions tested here are FlushChannel.
sl@0	2034
sl@0	2035	test io-27.1 {FlushChannel, no output buffered} {
sl@0	2036	file delete $path(test1)
sl@0	2037	set f [open $path(test1) w]
sl@0	2038	flush $f
sl@0	2039	set s [file size $path(test1)]
sl@0	2040	close $f
sl@0	2041	set s
sl@0	2042	} 0
sl@0	2043	test io-27.2 {FlushChannel, some output buffered} {
sl@0	2044	file delete $path(test1)
sl@0	2045	set f [open $path(test1) w]
sl@0	2046	fconfigure $f -translation lf -eofchar {}
sl@0	2047	set l ""
sl@0	2048	puts $f hello
sl@0	2049	lappend l [file size $path(test1)]
sl@0	2050	flush $f
sl@0	2051	lappend l [file size $path(test1)]
sl@0	2052	close $f
sl@0	2053	lappend l [file size $path(test1)]
sl@0	2054	set l
sl@0	2055	} {0 6 6}
sl@0	2056	test io-27.3 {FlushChannel, implicit flush on close} {
sl@0	2057	file delete $path(test1)
sl@0	2058	set f [open $path(test1) w]
sl@0	2059	fconfigure $f -translation lf -eofchar {}
sl@0	2060	set l ""
sl@0	2061	puts $f hello
sl@0	2062	lappend l [file size $path(test1)]
sl@0	2063	close $f
sl@0	2064	lappend l [file size $path(test1)]
sl@0	2065	set l
sl@0	2066	} {0 6}
sl@0	2067	test io-27.4 {FlushChannel, implicit flush when buffer fills} {
sl@0	2068	file delete $path(test1)
sl@0	2069	set f [open $path(test1) w]
sl@0	2070	fconfigure $f -translation lf -eofchar {}
sl@0	2071	fconfigure $f -buffersize 60
sl@0	2072	set l ""
sl@0	2073	lappend l [file size $path(test1)]
sl@0	2074	for {set i 0} {$i < 12} {incr i} {
sl@0	2075	puts $f hello
sl@0	2076	}
sl@0	2077	lappend l [file size $path(test1)]
sl@0	2078	flush $f
sl@0	2079	lappend l [file size $path(test1)]
sl@0	2080	close $f
sl@0	2081	set l
sl@0	2082	} {0 60 72}
sl@0	2083	test io-27.5 {FlushChannel, implicit flush when buffer fills and on close} \
sl@0	2084	{unixOrPc} {
sl@0	2085	file delete $path(test1)
sl@0	2086	set f [open $path(test1) w]
sl@0	2087	fconfigure $f -translation lf -buffersize 60 -eofchar {}
sl@0	2088	set l ""
sl@0	2089	lappend l [file size $path(test1)]
sl@0	2090	for {set i 0} {$i < 12} {incr i} {
sl@0	2091	puts $f hello
sl@0	2092	}
sl@0	2093	lappend l [file size $path(test1)]
sl@0	2094	close $f
sl@0	2095	lappend l [file size $path(test1)]
sl@0	2096	set l
sl@0	2097	} {0 60 72}
sl@0	2098
sl@0	2099	set path(pipe) [makeFile {} pipe]
sl@0	2100	set path(output) [makeFile {} output]
sl@0	2101
sl@0	2102	test io-27.6 {FlushChannel, async flushing, async close} \
sl@0	2103	{stdio asyncPipeClose openpipe} {
sl@0	2104	file delete $path(pipe)
sl@0	2105	file delete $path(output)
sl@0	2106	set f [open $path(pipe) w]
sl@0	2107	puts $f "set f \[[list open $path(output) w]]"
sl@0	2108	puts $f {
sl@0	2109	fconfigure $f -translation lf -buffering none -eofchar {}
sl@0	2110	while {![eof stdin]} {
sl@0	2111	after 20
sl@0	2112	puts -nonewline $f [read stdin 1024]
sl@0	2113	}
sl@0	2114	close $f
sl@0	2115	}
sl@0	2116	close $f
sl@0	2117	set x 01234567890123456789012345678901
sl@0	2118	for {set i 0} {$i < 11} {incr i} {
sl@0	2119	set x "$x$x"
sl@0	2120	}
sl@0	2121	set f [open $path(output) w]
sl@0	2122	close $f
sl@0	2123	set f [open "\|[list [interpreter] $path(pipe)]" w]
sl@0	2124	fconfigure $f -blocking off
sl@0	2125	puts -nonewline $f $x
sl@0	2126	close $f
sl@0	2127	set counter 0
sl@0	2128	while {([file size $path(output)] < 65536) && ($counter < 1000)} {
sl@0	2129	incr counter
sl@0	2130	after 20
sl@0	2131	update
sl@0	2132	}
sl@0	2133	if {$counter == 1000} {
sl@0	2134	set result "file size only [file size $path(output)]"
sl@0	2135	} else {
sl@0	2136	set result ok
sl@0	2137	}
sl@0	2138	} ok
sl@0	2139
sl@0	2140	# Tests closing a channel. The functions tested are CloseChannel and Tcl_Close.
sl@0	2141
sl@0	2142	test io-28.1 {CloseChannel called when all references are dropped} {testchannel} {
sl@0	2143	file delete $path(test1)
sl@0	2144	set f [open $path(test1) w]
sl@0	2145	interp create x
sl@0	2146	interp share "" $f x
sl@0	2147	set l ""
sl@0	2148	lappend l [testchannel refcount $f]
sl@0	2149	x eval close $f
sl@0	2150	interp delete x
sl@0	2151	lappend l [testchannel refcount $f]
sl@0	2152	close $f
sl@0	2153	set l
sl@0	2154	} {2 1}
sl@0	2155	test io-28.2 {CloseChannel called when all references are dropped} {
sl@0	2156	file delete $path(test1)
sl@0	2157	set f [open $path(test1) w]
sl@0	2158	interp create x
sl@0	2159	interp share "" $f x
sl@0	2160	puts -nonewline $f abc
sl@0	2161	close $f
sl@0	2162	x eval puts $f def
sl@0	2163	x eval close $f
sl@0	2164	interp delete x
sl@0	2165	set f [open $path(test1) r]
sl@0	2166	set l [gets $f]
sl@0	2167	close $f
sl@0	2168	set l
sl@0	2169	} abcdef
sl@0	2170	test io-28.3 {CloseChannel, not called before output queue is empty} \
sl@0	2171	{stdio asyncPipeClose nonPortable openpipe} {
sl@0	2172	file delete $path(pipe)
sl@0	2173	file delete $path(output)
sl@0	2174	set f [open $path(pipe) w]
sl@0	2175	puts $f {
sl@0	2176
sl@0	2177	# Need to not have eof char appended on close, because the other
sl@0	2178	# side of the pipe already closed, so that writing would cause an
sl@0	2179	# error "invalid file".
sl@0	2180
sl@0	2181	fconfigure stdout -eofchar {}
sl@0	2182	fconfigure stderr -eofchar {}
sl@0	2183
sl@0	2184	set f [open $path(output) w]
sl@0	2185	fconfigure $f -translation lf -buffering none
sl@0	2186	for {set x 0} {$x < 20} {incr x} {
sl@0	2187	after 20
sl@0	2188	puts -nonewline $f [read stdin 1024]
sl@0	2189	}
sl@0	2190	close $f
sl@0	2191	}
sl@0	2192	close $f
sl@0	2193	set x 01234567890123456789012345678901
sl@0	2194	for {set i 0} {$i < 11} {incr i} {
sl@0	2195	set x "$x$x"
sl@0	2196	}
sl@0	2197	set f [open $path(output) w]
sl@0	2198	close $f
sl@0	2199	set f [open "\|[list [interpreter] pipe]" r+]
sl@0	2200	fconfigure $f -blocking off -eofchar {}
sl@0	2201
sl@0	2202	puts -nonewline $f $x
sl@0	2203	close $f
sl@0	2204	set counter 0
sl@0	2205	while {([file size $path(output)] < 20480) && ($counter < 1000)} {
sl@0	2206	incr counter
sl@0	2207	after 20
sl@0	2208	update
sl@0	2209	}
sl@0	2210	if {$counter == 1000} {
sl@0	2211	set result probably_broken
sl@0	2212	} else {
sl@0	2213	set result ok
sl@0	2214	}
sl@0	2215	} ok
sl@0	2216	test io-28.4 {Tcl_Close} {testchannel} {
sl@0	2217	file delete $path(test1)
sl@0	2218	set l ""
sl@0	2219	lappend l [lsort [testchannel open]]
sl@0	2220	set f [open $path(test1) w]
sl@0	2221	lappend l [lsort [testchannel open]]
sl@0	2222	close $f
sl@0	2223	lappend l [lsort [testchannel open]]
sl@0	2224	set x [list $consoleFileNames \
sl@0	2225	[lsort [eval list $consoleFileNames $f]] \
sl@0	2226	$consoleFileNames]
sl@0	2227	string compare $l $x
sl@0	2228	} 0
sl@0	2229	test io-28.5 {Tcl_Close vs standard handles} {stdio unixOnly testchannel openpipe} {
sl@0	2230	file delete $path(script)
sl@0	2231	set f [open $path(script) w]
sl@0	2232	puts $f {
sl@0	2233	close stdin
sl@0	2234	puts [testchannel open]
sl@0	2235	}
sl@0	2236	close $f
sl@0	2237	set f [open "\|[list [interpreter] $path(script)]" r]
sl@0	2238	set l [gets $f]
sl@0	2239	close $f
sl@0	2240	set l
sl@0	2241	} {file1 file2}
sl@0	2242
sl@0	2243	test io-29.1 {Tcl_WriteChars, channel not writable} {
sl@0	2244	list [catch {puts stdin hello} msg] $msg
sl@0	2245	} {1 {channel "stdin" wasn't opened for writing}}
sl@0	2246	test io-29.2 {Tcl_WriteChars, empty string} {
sl@0	2247	file delete $path(test1)
sl@0	2248	set f [open $path(test1) w]
sl@0	2249	fconfigure $f -eofchar {}
sl@0	2250	puts -nonewline $f ""
sl@0	2251	close $f
sl@0	2252	file size $path(test1)
sl@0	2253	} 0
sl@0	2254	test io-29.3 {Tcl_WriteChars, nonempty string} {
sl@0	2255	file delete $path(test1)
sl@0	2256	set f [open $path(test1) w]
sl@0	2257	fconfigure $f -eofchar {}
sl@0	2258	puts -nonewline $f hello
sl@0	2259	close $f
sl@0	2260	file size $path(test1)
sl@0	2261	} 5
sl@0	2262	test io-29.4 {Tcl_WriteChars, buffering in full buffering mode} {testchannel} {
sl@0	2263	file delete $path(test1)
sl@0	2264	set f [open $path(test1) w]
sl@0	2265	fconfigure $f -translation lf -buffering full -eofchar {}
sl@0	2266	puts $f hello
sl@0	2267	set l ""
sl@0	2268	lappend l [testchannel outputbuffered $f]
sl@0	2269	lappend l [file size $path(test1)]
sl@0	2270	flush $f
sl@0	2271	lappend l [testchannel outputbuffered $f]
sl@0	2272	lappend l [file size $path(test1)]
sl@0	2273	close $f
sl@0	2274	set l
sl@0	2275	} {6 0 0 6}
sl@0	2276	test io-29.5 {Tcl_WriteChars, buffering in line buffering mode} {testchannel} {
sl@0	2277	file delete $path(test1)
sl@0	2278	set f [open $path(test1) w]
sl@0	2279	fconfigure $f -translation lf -buffering line -eofchar {}
sl@0	2280	puts -nonewline $f hello
sl@0	2281	set l ""
sl@0	2282	lappend l [testchannel outputbuffered $f]
sl@0	2283	lappend l [file size $path(test1)]
sl@0	2284	puts $f hello
sl@0	2285	lappend l [testchannel outputbuffered $f]
sl@0	2286	lappend l [file size $path(test1)]
sl@0	2287	close $f
sl@0	2288	set l
sl@0	2289	} {5 0 0 11}
sl@0	2290	test io-29.6 {Tcl_WriteChars, buffering in no buffering mode} {testchannel} {
sl@0	2291	file delete $path(test1)
sl@0	2292	set f [open $path(test1) w]
sl@0	2293	fconfigure $f -translation lf -buffering none -eofchar {}
sl@0	2294	puts -nonewline $f hello
sl@0	2295	set l ""
sl@0	2296	lappend l [testchannel outputbuffered $f]
sl@0	2297	lappend l [file size $path(test1)]
sl@0	2298	puts $f hello
sl@0	2299	lappend l [testchannel outputbuffered $f]
sl@0	2300	lappend l [file size $path(test1)]
sl@0	2301	close $f
sl@0	2302	set l
sl@0	2303	} {0 5 0 11}
sl@0	2304
sl@0	2305	test io-29.7 {Tcl_Flush, full buffering} {testchannel} {
sl@0	2306	file delete $path(test1)
sl@0	2307	set f [open $path(test1) w]
sl@0	2308	fconfigure $f -translation lf -buffering full -eofchar {}
sl@0	2309	puts -nonewline $f hello
sl@0	2310	set l ""
sl@0	2311	lappend l [testchannel outputbuffered $f]
sl@0	2312	lappend l [file size $path(test1)]
sl@0	2313	puts $f hello
sl@0	2314	lappend l [testchannel outputbuffered $f]
sl@0	2315	lappend l [file size $path(test1)]
sl@0	2316	flush $f
sl@0	2317	lappend l [testchannel outputbuffered $f]
sl@0	2318	lappend l [file size $path(test1)]
sl@0	2319	close $f
sl@0	2320	set l
sl@0	2321	} {5 0 11 0 0 11}
sl@0	2322	test io-29.8 {Tcl_Flush, full buffering} {testchannel} {
sl@0	2323	file delete $path(test1)
sl@0	2324	set f [open $path(test1) w]
sl@0	2325	fconfigure $f -translation lf -buffering line
sl@0	2326	puts -nonewline $f hello
sl@0	2327	set l ""
sl@0	2328	lappend l [testchannel outputbuffered $f]
sl@0	2329	lappend l [file size $path(test1)]
sl@0	2330	flush $f
sl@0	2331	lappend l [testchannel outputbuffered $f]
sl@0	2332	lappend l [file size $path(test1)]
sl@0	2333	puts $f hello
sl@0	2334	lappend l [testchannel outputbuffered $f]
sl@0	2335	lappend l [file size $path(test1)]
sl@0	2336	flush $f
sl@0	2337	lappend l [testchannel outputbuffered $f]
sl@0	2338	lappend l [file size $path(test1)]
sl@0	2339	close $f
sl@0	2340	set l
sl@0	2341	} {5 0 0 5 0 11 0 11}
sl@0	2342	test io-29.9 {Tcl_Flush, channel not writable} {
sl@0	2343	list [catch {flush stdin} msg] $msg
sl@0	2344	} {1 {channel "stdin" wasn't opened for writing}}
sl@0	2345	test io-29.10 {Tcl_WriteChars, looping and buffering} {
sl@0	2346	file delete $path(test1)
sl@0	2347	set f1 [open $path(test1) w]
sl@0	2348	fconfigure $f1 -translation lf -eofchar {}
sl@0	2349	set f2 [open $path(longfile) r]
sl@0	2350	for {set x 0} {$x < 10} {incr x} {
sl@0	2351	puts $f1 [gets $f2]
sl@0	2352	}
sl@0	2353	close $f2
sl@0	2354	close $f1
sl@0	2355	file size $path(test1)
sl@0	2356	} 387
sl@0	2357	test io-29.11 {Tcl_WriteChars, no newline, implicit flush} {
sl@0	2358	file delete $path(test1)
sl@0	2359	set f1 [open $path(test1) w]
sl@0	2360	fconfigure $f1 -eofchar {}
sl@0	2361	set f2 [open $path(longfile) r]
sl@0	2362	for {set x 0} {$x < 10} {incr x} {
sl@0	2363	puts -nonewline $f1 [gets $f2]
sl@0	2364	}
sl@0	2365	close $f1
sl@0	2366	close $f2
sl@0	2367	file size $path(test1)
sl@0	2368	} 377
sl@0	2369	test io-29.12 {Tcl_WriteChars on a pipe} {stdio openpipe} {
sl@0	2370	file delete $path(test1)
sl@0	2371	file delete $path(pipe)
sl@0	2372	set f1 [open $path(pipe) w]
sl@0	2373	puts $f1 "set f1 \[[list open $path(longfile) r]]"
sl@0	2374	puts $f1 {
sl@0	2375	for {set x 0} {$x < 10} {incr x} {
sl@0	2376	puts [gets $f1]
sl@0	2377	}
sl@0	2378	}
sl@0	2379	close $f1
sl@0	2380	set f1 [open "\|[list [interpreter] $path(pipe)]" r]
sl@0	2381	set f2 [open $path(longfile) r]
sl@0	2382	set y ok
sl@0	2383	for {set x 0} {$x < 10} {incr x} {
sl@0	2384	set l1 [gets $f1]
sl@0	2385	set l2 [gets $f2]
sl@0	2386	if {"$l1" != "$l2"} {
sl@0	2387	set y broken
sl@0	2388	}
sl@0	2389	}
sl@0	2390	close $f1
sl@0	2391	close $f2
sl@0	2392	set y
sl@0	2393	} ok
sl@0	2394	test io-29.13 {Tcl_WriteChars to a pipe, line buffered} {stdio openpipe} {
sl@0	2395	file delete $path(test1)
sl@0	2396	file delete $path(pipe)
sl@0	2397	set f1 [open $path(pipe) w]
sl@0	2398	puts $f1 {
sl@0	2399	puts [gets stdin]
sl@0	2400	puts [gets stdin]
sl@0	2401	}
sl@0	2402	close $f1
sl@0	2403	set y ok
sl@0	2404	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	2405	fconfigure $f1 -buffering line
sl@0	2406	set f2 [open $path(longfile) r]
sl@0	2407	set line [gets $f2]
sl@0	2408	puts $f1 $line
sl@0	2409	set backline [gets $f1]
sl@0	2410	if {"$line" != "$backline"} {
sl@0	2411	set y broken
sl@0	2412	}
sl@0	2413	set line [gets $f2]
sl@0	2414	puts $f1 $line
sl@0	2415	set backline [gets $f1]
sl@0	2416	if {"$line" != "$backline"} {
sl@0	2417	set y broken
sl@0	2418	}
sl@0	2419	close $f1
sl@0	2420	close $f2
sl@0	2421	set y
sl@0	2422	} ok
sl@0	2423	test io-29.14 {Tcl_WriteChars, buffering and implicit flush at close} {
sl@0	2424	file delete $path(test3)
sl@0	2425	set f [open $path(test3) w]
sl@0	2426	puts -nonewline $f "Text1"
sl@0	2427	puts -nonewline $f " Text 2"
sl@0	2428	puts $f " Text 3"
sl@0	2429	close $f
sl@0	2430	set f [open $path(test3) r]
sl@0	2431	set x [gets $f]
sl@0	2432	close $f
sl@0	2433	set x
sl@0	2434	} {Text1 Text 2 Text 3}
sl@0	2435	test io-29.15 {Tcl_Flush, channel not open for writing} {
sl@0	2436	file delete $path(test1)
sl@0	2437	set fd [open $path(test1) w]
sl@0	2438	close $fd
sl@0	2439	set fd [open $path(test1) r]
sl@0	2440	set x [list [catch {flush $fd} msg] $msg]
sl@0	2441	close $fd
sl@0	2442	string compare $x \
sl@0	2443	[list 1 "channel \"$fd\" wasn't opened for writing"]
sl@0	2444	} 0
sl@0	2445	test io-29.16 {Tcl_Flush on pipe opened only for reading} {stdio openpipe} {
sl@0	2446	set fd [open "\|[list [interpreter] cat longfile]" r]
sl@0	2447	set x [list [catch {flush $fd} msg] $msg]
sl@0	2448	catch {close $fd}
sl@0	2449	string compare $x \
sl@0	2450	[list 1 "channel \"$fd\" wasn't opened for writing"]
sl@0	2451	} 0
sl@0	2452	test io-29.17 {Tcl_WriteChars buffers, then Tcl_Flush flushes} {
sl@0	2453	file delete $path(test1)
sl@0	2454	set f1 [open $path(test1) w]
sl@0	2455	fconfigure $f1 -translation lf
sl@0	2456	puts $f1 hello
sl@0	2457	puts $f1 hello
sl@0	2458	puts $f1 hello
sl@0	2459	flush $f1
sl@0	2460	set x [file size $path(test1)]
sl@0	2461	close $f1
sl@0	2462	set x
sl@0	2463	} 18
sl@0	2464	test io-29.18 {Tcl_WriteChars and Tcl_Flush intermixed} {
sl@0	2465	file delete $path(test1)
sl@0	2466	set x ""
sl@0	2467	set f1 [open $path(test1) w]
sl@0	2468	fconfigure $f1 -translation lf
sl@0	2469	puts $f1 hello
sl@0	2470	puts $f1 hello
sl@0	2471	puts $f1 hello
sl@0	2472	flush $f1
sl@0	2473	lappend x [file size $path(test1)]
sl@0	2474	puts $f1 hello
sl@0	2475	flush $f1
sl@0	2476	lappend x [file size $path(test1)]
sl@0	2477	puts $f1 hello
sl@0	2478	flush $f1
sl@0	2479	lappend x [file size $path(test1)]
sl@0	2480	close $f1
sl@0	2481	set x
sl@0	2482	} {18 24 30}
sl@0	2483	test io-29.19 {Explicit and implicit flushes} {
sl@0	2484	file delete $path(test1)
sl@0	2485	set f1 [open $path(test1) w]
sl@0	2486	fconfigure $f1 -translation lf -eofchar {}
sl@0	2487	set x ""
sl@0	2488	puts $f1 hello
sl@0	2489	puts $f1 hello
sl@0	2490	puts $f1 hello
sl@0	2491	flush $f1
sl@0	2492	lappend x [file size $path(test1)]
sl@0	2493	puts $f1 hello
sl@0	2494	flush $f1
sl@0	2495	lappend x [file size $path(test1)]
sl@0	2496	puts $f1 hello
sl@0	2497	close $f1
sl@0	2498	lappend x [file size $path(test1)]
sl@0	2499	set x
sl@0	2500	} {18 24 30}
sl@0	2501	test io-29.20 {Implicit flush when buffer is full} {
sl@0	2502	file delete $path(test1)
sl@0	2503	set f1 [open $path(test1) w]
sl@0	2504	fconfigure $f1 -translation lf -eofchar {}
sl@0	2505	set line "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
sl@0	2506	for {set x 0} {$x < 100} {incr x} {
sl@0	2507	puts $f1 $line
sl@0	2508	}
sl@0	2509	set z ""
sl@0	2510	lappend z [file size $path(test1)]
sl@0	2511	for {set x 0} {$x < 100} {incr x} {
sl@0	2512	puts $f1 $line
sl@0	2513	}
sl@0	2514	lappend z [file size $path(test1)]
sl@0	2515	close $f1
sl@0	2516	lappend z [file size $path(test1)]
sl@0	2517	set z
sl@0	2518	} {4096 12288 12600}
sl@0	2519	test io-29.21 {Tcl_Flush to pipe} {stdio openpipe} {
sl@0	2520	file delete $path(pipe)
sl@0	2521	set f1 [open $path(pipe) w]
sl@0	2522	puts $f1 {set x [read stdin 6]}
sl@0	2523	puts $f1 {set cnt [string length $x]}
sl@0	2524	puts $f1 {puts "read $cnt characters"}
sl@0	2525	close $f1
sl@0	2526	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	2527	puts $f1 hello
sl@0	2528	flush $f1
sl@0	2529	set x [gets $f1]
sl@0	2530	catch {close $f1}
sl@0	2531	set x
sl@0	2532	} "read 6 characters"
sl@0	2533	test io-29.22 {Tcl_Flush called at other end of pipe} {stdio openpipe} {
sl@0	2534	file delete $path(pipe)
sl@0	2535	set f1 [open $path(pipe) w]
sl@0	2536	puts $f1 {
sl@0	2537	fconfigure stdout -buffering full
sl@0	2538	puts hello
sl@0	2539	puts hello
sl@0	2540	flush stdout
sl@0	2541	gets stdin
sl@0	2542	puts bye
sl@0	2543	flush stdout
sl@0	2544	}
sl@0	2545	close $f1
sl@0	2546	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	2547	set x ""
sl@0	2548	lappend x [gets $f1]
sl@0	2549	lappend x [gets $f1]
sl@0	2550	puts $f1 hello
sl@0	2551	flush $f1
sl@0	2552	lappend x [gets $f1]
sl@0	2553	close $f1
sl@0	2554	set x
sl@0	2555	} {hello hello bye}
sl@0	2556	test io-29.23 {Tcl_Flush and line buffering at end of pipe} {stdio openpipe} {
sl@0	2557	file delete $path(pipe)
sl@0	2558	set f1 [open $path(pipe) w]
sl@0	2559	puts $f1 {
sl@0	2560	puts hello
sl@0	2561	puts hello
sl@0	2562	gets stdin
sl@0	2563	puts bye
sl@0	2564	}
sl@0	2565	close $f1
sl@0	2566	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	2567	set x ""
sl@0	2568	lappend x [gets $f1]
sl@0	2569	lappend x [gets $f1]
sl@0	2570	puts $f1 hello
sl@0	2571	flush $f1
sl@0	2572	lappend x [gets $f1]
sl@0	2573	close $f1
sl@0	2574	set x
sl@0	2575	} {hello hello bye}
sl@0	2576	test io-29.24 {Tcl_WriteChars and Tcl_Flush move end of file} {
sl@0	2577	set f [open $path(test3) w]
sl@0	2578	puts $f "Line 1"
sl@0	2579	puts $f "Line 2"
sl@0	2580	set f2 [open $path(test3)]
sl@0	2581	set x {}
sl@0	2582	lappend x [read -nonewline $f2]
sl@0	2583	close $f2
sl@0	2584	flush $f
sl@0	2585	set f2 [open $path(test3)]
sl@0	2586	lappend x [read -nonewline $f2]
sl@0	2587	close $f2
sl@0	2588	close $f
sl@0	2589	set x
sl@0	2590	} "{} {Line 1\nLine 2}"
sl@0	2591	test io-29.25 {Implicit flush with Tcl_Flush to command pipelines} {stdio openpipe fileevent} {
sl@0	2592	file delete $path(test3)
sl@0	2593	set f [open "\|[list [interpreter] $path(cat) \| [interpreter] $path(cat) > $path(test3)]" w]
sl@0	2594	puts $f "Line 1"
sl@0	2595	puts $f "Line 2"
sl@0	2596	close $f
sl@0	2597	after 100
sl@0	2598	set f [open $path(test3) r]
sl@0	2599	set x [read $f]
sl@0	2600	close $f
sl@0	2601	set x
sl@0	2602	} "Line 1\nLine 2\n"
sl@0	2603	test io-29.26 {Tcl_Flush, Tcl_Write on bidirectional pipelines} {stdio unixExecs openpipe} {
sl@0	2604	set f [open "\|[list cat -u]" r+]
sl@0	2605	puts $f "Line1"
sl@0	2606	flush $f
sl@0	2607	set x [gets $f]
sl@0	2608	close $f
sl@0	2609	set x
sl@0	2610	} {Line1}
sl@0	2611	test io-29.27 {Tcl_Flush on closed pipeline} {stdio openpipe} {
sl@0	2612	file delete $path(pipe)
sl@0	2613	set f [open $path(pipe) w]
sl@0	2614	puts $f {exit}
sl@0	2615	close $f
sl@0	2616	set f [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	2617	gets $f
sl@0	2618	puts $f output
sl@0	2619	after 50
sl@0	2620	#
sl@0	2621	# The flush below will get a SIGPIPE. This is an expected part of
sl@0	2622	# test and indicates that the test operates correctly. If you run
sl@0	2623	# this test under a debugger, the signal will by intercepted unless
sl@0	2624	# you disable the debugger's signal interception.
sl@0	2625	#
sl@0	2626	if {[catch {flush $f} msg]} {
sl@0	2627	set x [list 1 $msg $errorCode]
sl@0	2628	catch {close $f}
sl@0	2629	} else {
sl@0	2630	if {[catch {close $f} msg]} {
sl@0	2631	set x [list 1 $msg $errorCode]
sl@0	2632	} else {
sl@0	2633	set x {this was supposed to fail and did not}
sl@0	2634	}
sl@0	2635	}
sl@0	2636	regsub {".*":} $x {"":} x
sl@0	2637	string tolower $x
sl@0	2638	} {1 {error flushing "": broken pipe} {posix epipe {broken pipe}}}
sl@0	2639	test io-29.28 {Tcl_WriteChars, lf mode} {
sl@0	2640	file delete $path(test1)
sl@0	2641	set f [open $path(test1) w]
sl@0	2642	fconfigure $f -translation lf -eofchar {}
sl@0	2643	puts $f hello\nthere\nand\nhere
sl@0	2644	flush $f
sl@0	2645	set s [file size $path(test1)]
sl@0	2646	close $f
sl@0	2647	set s
sl@0	2648	} 21
sl@0	2649	test io-29.29 {Tcl_WriteChars, cr mode} {
sl@0	2650	file delete $path(test1)
sl@0	2651	set f [open $path(test1) w]
sl@0	2652	fconfigure $f -translation cr -eofchar {}
sl@0	2653	puts $f hello\nthere\nand\nhere
sl@0	2654	close $f
sl@0	2655	file size $path(test1)
sl@0	2656	} 21
sl@0	2657	test io-29.30 {Tcl_WriteChars, crlf mode} {
sl@0	2658	file delete $path(test1)
sl@0	2659	set f [open $path(test1) w]
sl@0	2660	fconfigure $f -translation crlf -eofchar {}
sl@0	2661	puts $f hello\nthere\nand\nhere
sl@0	2662	close $f
sl@0	2663	file size $path(test1)
sl@0	2664	} 25
sl@0	2665	test io-29.31 {Tcl_WriteChars, background flush} {stdio openpipe} {
sl@0	2666	file delete $path(pipe)
sl@0	2667	file delete $path(output)
sl@0	2668	set f [open $path(pipe) w]
sl@0	2669	puts $f "set f \[[list open $path(output) w]]"
sl@0	2670	puts $f {fconfigure $f -translation lf}
sl@0	2671	set x [list while {![eof stdin]}]
sl@0	2672	set x "$x {"
sl@0	2673	puts $f $x
sl@0	2674	puts $f { puts -nonewline $f [read stdin 4096]}
sl@0	2675	puts $f { flush $f}
sl@0	2676	puts $f "}"
sl@0	2677	puts $f {close $f}
sl@0	2678	close $f
sl@0	2679	set x 01234567890123456789012345678901
sl@0	2680	for {set i 0} {$i < 11} {incr i} {
sl@0	2681	set x "$x$x"
sl@0	2682	}
sl@0	2683	set f [open $path(output) w]
sl@0	2684	close $f
sl@0	2685	set f [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	2686	fconfigure $f -blocking off
sl@0	2687	puts -nonewline $f $x
sl@0	2688	close $f
sl@0	2689	set counter 0
sl@0	2690	while {([file size $path(output)] < 65536) && ($counter < 1000)} {
sl@0	2691	incr counter
sl@0	2692	after 5
sl@0	2693	update
sl@0	2694	}
sl@0	2695	if {$counter == 1000} {
sl@0	2696	set result "file size only [file size $path(output)]"
sl@0	2697	} else {
sl@0	2698	set result ok
sl@0	2699	}
sl@0	2700	} ok
sl@0	2701	test io-29.32 {Tcl_WriteChars, background flush to slow reader} \
sl@0	2702	{stdio asyncPipeClose openpipe} {
sl@0	2703	file delete $path(pipe)
sl@0	2704	file delete $path(output)
sl@0	2705	set f [open $path(pipe) w]
sl@0	2706	puts $f "set f \[[list open $path(output) w]]"
sl@0	2707	puts $f {fconfigure $f -translation lf}
sl@0	2708	set x [list while {![eof stdin]}]
sl@0	2709	set x "$x \{"
sl@0	2710	puts $f $x
sl@0	2711	puts $f { after 20}
sl@0	2712	puts $f { puts -nonewline $f [read stdin 1024]}
sl@0	2713	puts $f { flush $f}
sl@0	2714	puts $f "\}"
sl@0	2715	puts $f {close $f}
sl@0	2716	close $f
sl@0	2717	set x 01234567890123456789012345678901
sl@0	2718	for {set i 0} {$i < 11} {incr i} {
sl@0	2719	set x "$x$x"
sl@0	2720	}
sl@0	2721	set f [open $path(output) w]
sl@0	2722	close $f
sl@0	2723	set f [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	2724	fconfigure $f -blocking off
sl@0	2725	puts -nonewline $f $x
sl@0	2726	close $f
sl@0	2727	set counter 0
sl@0	2728	while {([file size $path(output)] < 65536) && ($counter < 1000)} {
sl@0	2729	incr counter
sl@0	2730	after 20
sl@0	2731	update
sl@0	2732	}
sl@0	2733	if {$counter == 1000} {
sl@0	2734	set result "file size only [file size $path(output)]"
sl@0	2735	} else {
sl@0	2736	set result ok
sl@0	2737	}
sl@0	2738	} ok
sl@0	2739	test io-29.33 {Tcl_Flush, implicit flush on exit} {exec} {
sl@0	2740	set f [open $path(script) w]
sl@0	2741	puts $f "set f \[[list open $path(test1) w]]"
sl@0	2742	puts $f {fconfigure $f -translation lf
sl@0	2743	puts $f hello
sl@0	2744	puts $f bye
sl@0	2745	puts $f strange
sl@0	2746	}
sl@0	2747	close $f
sl@0	2748	exec [interpreter] $path(script)
sl@0	2749	set f [open $path(test1) r]
sl@0	2750	set r [read $f]
sl@0	2751	close $f
sl@0	2752	set r
sl@0	2753	} "hello\nbye\nstrange\n"
sl@0	2754	test io-29.34 {Tcl_Close, async flush on close, using sockets} {socket tempNotMac fileevent} {
sl@0	2755	variable c 0
sl@0	2756	variable x running
sl@0	2757	set l abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz
sl@0	2758	proc writelots {s l} {
sl@0	2759	for {set i 0} {$i < 2000} {incr i} {
sl@0	2760	puts $s $l
sl@0	2761	}
sl@0	2762	}
sl@0	2763	proc accept {s a p} {
sl@0	2764	variable x
sl@0	2765	fileevent $s readable [namespace code [list readit $s]]
sl@0	2766	fconfigure $s -blocking off
sl@0	2767	set x accepted
sl@0	2768	}
sl@0	2769	proc readit {s} {
sl@0	2770	variable c
sl@0	2771	variable x
sl@0	2772	set l [gets $s]
sl@0	2773
sl@0	2774	if {[eof $s]} {
sl@0	2775	close $s
sl@0	2776	set x done
sl@0	2777	} elseif {([string length $l] > 0) \|\| ![fblocked $s]} {
sl@0	2778	incr c
sl@0	2779	}
sl@0	2780	}
sl@0	2781	set ss [socket -server [namespace code accept] 0]
sl@0	2782	set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
sl@0	2783	vwait [namespace which -variable x]
sl@0	2784	fconfigure $cs -blocking off
sl@0	2785	writelots $cs $l
sl@0	2786	close $cs
sl@0	2787	close $ss
sl@0	2788	vwait [namespace which -variable x]
sl@0	2789	set c
sl@0	2790	} 2000
sl@0	2791	test io-29.35 {Tcl_Close vs fileevent vs multiple interpreters} {socket tempNotMac fileevent} {
sl@0	2792	# On Mac, this test screws up sockets such that subsequent tests using port 2828
sl@0	2793	# either cause errors or panic().
sl@0	2794
sl@0	2795	catch {interp delete x}
sl@0	2796	catch {interp delete y}
sl@0	2797	interp create x
sl@0	2798	interp create y
sl@0	2799	set s [socket -server [namespace code accept] 0]
sl@0	2800	proc accept {s a p} {
sl@0	2801	puts $s hello
sl@0	2802	close $s
sl@0	2803	}
sl@0	2804	set c [socket [info hostname] [lindex [fconfigure $s -sockname] 2]]
sl@0	2805	interp share {} $c x
sl@0	2806	interp share {} $c y
sl@0	2807	close $c
sl@0	2808	x eval {
sl@0	2809	proc readit {s} {
sl@0	2810	gets $s
sl@0	2811	if {[eof $s]} {
sl@0	2812	close $s
sl@0	2813	}
sl@0	2814	}
sl@0	2815	}
sl@0	2816	y eval {
sl@0	2817	proc readit {s} {
sl@0	2818	gets $s
sl@0	2819	if {[eof $s]} {
sl@0	2820	close $s
sl@0	2821	}
sl@0	2822	}
sl@0	2823	}
sl@0	2824	x eval "fileevent $c readable \{readit $c\}"
sl@0	2825	y eval "fileevent $c readable \{readit $c\}"
sl@0	2826	y eval [list close $c]
sl@0	2827	update
sl@0	2828	close $s
sl@0	2829	interp delete x
sl@0	2830	interp delete y
sl@0	2831	} ""
sl@0	2832
sl@0	2833	# Test end of line translations. Procedures tested are Tcl_Write, Tcl_Read.
sl@0	2834
sl@0	2835	test io-30.1 {Tcl_Write lf, Tcl_Read lf} {
sl@0	2836	file delete $path(test1)
sl@0	2837	set f [open $path(test1) w]
sl@0	2838	fconfigure $f -translation lf
sl@0	2839	puts $f hello\nthere\nand\nhere
sl@0	2840	close $f
sl@0	2841	set f [open $path(test1) r]
sl@0	2842	fconfigure $f -translation lf
sl@0	2843	set x [read $f]
sl@0	2844	close $f
sl@0	2845	set x
sl@0	2846	} "hello\nthere\nand\nhere\n"
sl@0	2847	test io-30.2 {Tcl_Write lf, Tcl_Read cr} {
sl@0	2848	file delete $path(test1)
sl@0	2849	set f [open $path(test1) w]
sl@0	2850	fconfigure $f -translation lf
sl@0	2851	puts $f hello\nthere\nand\nhere
sl@0	2852	close $f
sl@0	2853	set f [open $path(test1) r]
sl@0	2854	fconfigure $f -translation cr
sl@0	2855	set x [read $f]
sl@0	2856	close $f
sl@0	2857	set x
sl@0	2858	} "hello\nthere\nand\nhere\n"
sl@0	2859	test io-30.3 {Tcl_Write lf, Tcl_Read crlf} {
sl@0	2860	file delete $path(test1)
sl@0	2861	set f [open $path(test1) w]
sl@0	2862	fconfigure $f -translation lf
sl@0	2863	puts $f hello\nthere\nand\nhere
sl@0	2864	close $f
sl@0	2865	set f [open $path(test1) r]
sl@0	2866	fconfigure $f -translation crlf
sl@0	2867	set x [read $f]
sl@0	2868	close $f
sl@0	2869	set x
sl@0	2870	} "hello\nthere\nand\nhere\n"
sl@0	2871	test io-30.4 {Tcl_Write cr, Tcl_Read cr} {
sl@0	2872	file delete $path(test1)
sl@0	2873	set f [open $path(test1) w]
sl@0	2874	fconfigure $f -translation cr
sl@0	2875	puts $f hello\nthere\nand\nhere
sl@0	2876	close $f
sl@0	2877	set f [open $path(test1) r]
sl@0	2878	fconfigure $f -translation cr
sl@0	2879	set x [read $f]
sl@0	2880	close $f
sl@0	2881	set x
sl@0	2882	} "hello\nthere\nand\nhere\n"
sl@0	2883	test io-30.5 {Tcl_Write cr, Tcl_Read lf} {
sl@0	2884	file delete $path(test1)
sl@0	2885	set f [open $path(test1) w]
sl@0	2886	fconfigure $f -translation cr
sl@0	2887	puts $f hello\nthere\nand\nhere
sl@0	2888	close $f
sl@0	2889	set f [open $path(test1) r]
sl@0	2890	fconfigure $f -translation lf
sl@0	2891	set x [read $f]
sl@0	2892	close $f
sl@0	2893	set x
sl@0	2894	} "hello\rthere\rand\rhere\r"
sl@0	2895	test io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
sl@0	2896	file delete $path(test1)
sl@0	2897	set f [open $path(test1) w]
sl@0	2898	fconfigure $f -translation cr
sl@0	2899	puts $f hello\nthere\nand\nhere
sl@0	2900	close $f
sl@0	2901	set f [open $path(test1) r]
sl@0	2902	fconfigure $f -translation crlf
sl@0	2903	set x [read $f]
sl@0	2904	close $f
sl@0	2905	set x
sl@0	2906	} "hello\rthere\rand\rhere\r"
sl@0	2907	test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
sl@0	2908	file delete $path(test1)
sl@0	2909	set f [open $path(test1) w]
sl@0	2910	fconfigure $f -translation crlf
sl@0	2911	puts $f hello\nthere\nand\nhere
sl@0	2912	close $f
sl@0	2913	set f [open $path(test1) r]
sl@0	2914	fconfigure $f -translation crlf
sl@0	2915	set x [read $f]
sl@0	2916	close $f
sl@0	2917	set x
sl@0	2918	} "hello\nthere\nand\nhere\n"
sl@0	2919	test io-30.8 {Tcl_Write crlf, Tcl_Read lf} {
sl@0	2920	file delete $path(test1)
sl@0	2921	set f [open $path(test1) w]
sl@0	2922	fconfigure $f -translation crlf
sl@0	2923	puts $f hello\nthere\nand\nhere
sl@0	2924	close $f
sl@0	2925	set f [open $path(test1) r]
sl@0	2926	fconfigure $f -translation lf
sl@0	2927	set x [read $f]
sl@0	2928	close $f
sl@0	2929	set x
sl@0	2930	} "hello\r\nthere\r\nand\r\nhere\r\n"
sl@0	2931	test io-30.9 {Tcl_Write crlf, Tcl_Read cr} {
sl@0	2932	file delete $path(test1)
sl@0	2933	set f [open $path(test1) w]
sl@0	2934	fconfigure $f -translation crlf
sl@0	2935	puts $f hello\nthere\nand\nhere
sl@0	2936	close $f
sl@0	2937	set f [open $path(test1) r]
sl@0	2938	fconfigure $f -translation cr
sl@0	2939	set x [read $f]
sl@0	2940	close $f
sl@0	2941	set x
sl@0	2942	} "hello\n\nthere\n\nand\n\nhere\n\n"
sl@0	2943	test io-30.10 {Tcl_Write lf, Tcl_Read auto} {
sl@0	2944	file delete $path(test1)
sl@0	2945	set f [open $path(test1) w]
sl@0	2946	fconfigure $f -translation lf
sl@0	2947	puts $f hello\nthere\nand\nhere
sl@0	2948	close $f
sl@0	2949	set f [open $path(test1) r]
sl@0	2950	set c [read $f]
sl@0	2951	set x [fconfigure $f -translation]
sl@0	2952	close $f
sl@0	2953	list $c $x
sl@0	2954	} {{hello
sl@0	2955	there
sl@0	2956	and
sl@0	2957	here
sl@0	2958	} auto}
sl@0	2959	test io-30.11 {Tcl_Write cr, Tcl_Read auto} {
sl@0	2960	file delete $path(test1)
sl@0	2961	set f [open $path(test1) w]
sl@0	2962	fconfigure $f -translation cr
sl@0	2963	puts $f hello\nthere\nand\nhere
sl@0	2964	close $f
sl@0	2965	set f [open $path(test1) r]
sl@0	2966	set c [read $f]
sl@0	2967	set x [fconfigure $f -translation]
sl@0	2968	close $f
sl@0	2969	list $c $x
sl@0	2970	} {{hello
sl@0	2971	there
sl@0	2972	and
sl@0	2973	here
sl@0	2974	} auto}
sl@0	2975	test io-30.12 {Tcl_Write crlf, Tcl_Read auto} {
sl@0	2976	file delete $path(test1)
sl@0	2977	set f [open $path(test1) w]
sl@0	2978	fconfigure $f -translation crlf
sl@0	2979	puts $f hello\nthere\nand\nhere
sl@0	2980	close $f
sl@0	2981	set f [open $path(test1) r]
sl@0	2982	set c [read $f]
sl@0	2983	set x [fconfigure $f -translation]
sl@0	2984	close $f
sl@0	2985	list $c $x
sl@0	2986	} {{hello
sl@0	2987	there
sl@0	2988	and
sl@0	2989	here
sl@0	2990	} auto}
sl@0	2991
sl@0	2992	test io-30.13 {Tcl_Write crlf on block boundary, Tcl_Read auto} {
sl@0	2993	file delete $path(test1)
sl@0	2994	set f [open $path(test1) w]
sl@0	2995	fconfigure $f -translation crlf
sl@0	2996	set line "123456789ABCDE" ;# 14 char plus crlf
sl@0	2997	puts -nonewline $f x ;# shift crlf across block boundary
sl@0	2998	for {set i 0} {$i < 700} {incr i} {
sl@0	2999	puts $f $line
sl@0	3000	}
sl@0	3001	close $f
sl@0	3002	set f [open $path(test1) r]
sl@0	3003	fconfigure $f -translation auto
sl@0	3004	set c [read $f]
sl@0	3005	close $f
sl@0	3006	string length $c
sl@0	3007	} [expr 700*15+1]
sl@0	3008
sl@0	3009	test io-30.14 {Tcl_Write crlf on block boundary, Tcl_Read crlf} {
sl@0	3010	file delete $path(test1)
sl@0	3011	set f [open $path(test1) w]
sl@0	3012	fconfigure $f -translation crlf
sl@0	3013	set line "123456789ABCDE" ;# 14 char plus crlf
sl@0	3014	puts -nonewline $f x ;# shift crlf across block boundary
sl@0	3015	for {set i 0} {$i < 700} {incr i} {
sl@0	3016	puts $f $line
sl@0	3017	}
sl@0	3018	close $f
sl@0	3019	set f [open $path(test1) r]
sl@0	3020	fconfigure $f -translation crlf
sl@0	3021	set c [read $f]
sl@0	3022	close $f
sl@0	3023	string length $c
sl@0	3024	} [expr 700*15+1]
sl@0	3025
sl@0	3026	test io-30.15 {Tcl_Write mixed, Tcl_Read auto} {
sl@0	3027	file delete $path(test1)
sl@0	3028	set f [open $path(test1) w]
sl@0	3029	fconfigure $f -translation lf
sl@0	3030	puts $f hello\nthere\nand\rhere
sl@0	3031	close $f
sl@0	3032	set f [open $path(test1) r]
sl@0	3033	fconfigure $f -translation auto
sl@0	3034	set c [read $f]
sl@0	3035	close $f
sl@0	3036	set c
sl@0	3037	} {hello
sl@0	3038	there
sl@0	3039	and
sl@0	3040	here
sl@0	3041	}
sl@0	3042	test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
sl@0	3043	file delete $path(test1)
sl@0	3044	set f [open $path(test1) w]
sl@0	3045	fconfigure $f -translation lf
sl@0	3046	puts -nonewline $f hello\nthere\nand\rhere\n\x1a
sl@0	3047	close $f
sl@0	3048	set f [open $path(test1) r]
sl@0	3049	fconfigure $f -eofchar \x1a -translation auto
sl@0	3050	set c [read $f]
sl@0	3051	close $f
sl@0	3052	set c
sl@0	3053	} {hello
sl@0	3054	there
sl@0	3055	and
sl@0	3056	here
sl@0	3057	}
sl@0	3058	test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {pcOnly} {
sl@0	3059	file delete $path(test1)
sl@0	3060	set f [open $path(test1) w]
sl@0	3061	fconfigure $f -eofchar \x1a -translation lf
sl@0	3062	puts $f hello\nthere\nand\rhere
sl@0	3063	close $f
sl@0	3064	set f [open $path(test1) r]
sl@0	3065	fconfigure $f -eofchar \x1a -translation auto
sl@0	3066	set c [read $f]
sl@0	3067	close $f
sl@0	3068	set c
sl@0	3069	} {hello
sl@0	3070	there
sl@0	3071	and
sl@0	3072	here
sl@0	3073	}
sl@0	3074	test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
sl@0	3075	file delete $path(test1)
sl@0	3076	set f [open $path(test1) w]
sl@0	3077	fconfigure $f -translation lf
sl@0	3078	set s [format "abc\ndef\n%cghi\nqrs" 26]
sl@0	3079	puts $f $s
sl@0	3080	close $f
sl@0	3081	set f [open $path(test1) r]
sl@0	3082	fconfigure $f -eofchar \x1a -translation auto
sl@0	3083	set l ""
sl@0	3084	lappend l [gets $f]
sl@0	3085	lappend l [gets $f]
sl@0	3086	lappend l [eof $f]
sl@0	3087	lappend l [gets $f]
sl@0	3088	lappend l [eof $f]
sl@0	3089	lappend l [gets $f]
sl@0	3090	lappend l [eof $f]
sl@0	3091	close $f
sl@0	3092	set l
sl@0	3093	} {abc def 0 {} 1 {} 1}
sl@0	3094	test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
sl@0	3095	file delete $path(test1)
sl@0	3096	set f [open $path(test1) w]
sl@0	3097	fconfigure $f -translation lf
sl@0	3098	set s [format "abc\ndef\n%cghi\nqrs" 26]
sl@0	3099	puts $f $s
sl@0	3100	close $f
sl@0	3101	set f [open $path(test1) r]
sl@0	3102	fconfigure $f -eofchar \x1a -translation auto
sl@0	3103	set l ""
sl@0	3104	lappend l [gets $f]
sl@0	3105	lappend l [gets $f]
sl@0	3106	lappend l [eof $f]
sl@0	3107	lappend l [gets $f]
sl@0	3108	lappend l [eof $f]
sl@0	3109	lappend l [gets $f]
sl@0	3110	lappend l [eof $f]
sl@0	3111	close $f
sl@0	3112	set l
sl@0	3113	} {abc def 0 {} 1 {} 1}
sl@0	3114	test io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} {
sl@0	3115	file delete $path(test1)
sl@0	3116	set f [open $path(test1) w]
sl@0	3117	fconfigure $f -translation lf -eofchar {}
sl@0	3118	set s [format "abc\ndef\n%cghi\nqrs" 26]
sl@0	3119	puts $f $s
sl@0	3120	close $f
sl@0	3121	set f [open $path(test1) r]
sl@0	3122	fconfigure $f -translation lf -eofchar {}
sl@0	3123	set l ""
sl@0	3124	lappend l [gets $f]
sl@0	3125	lappend l [gets $f]
sl@0	3126	lappend l [eof $f]
sl@0	3127	lappend l [gets $f]
sl@0	3128	lappend l [eof $f]
sl@0	3129	lappend l [gets $f]
sl@0	3130	lappend l [eof $f]
sl@0	3131	lappend l [gets $f]
sl@0	3132	lappend l [eof $f]
sl@0	3133	close $f
sl@0	3134	set l
sl@0	3135	} "abc def 0 \x1aghi 0 qrs 0 {} 1"
sl@0	3136	test io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} {
sl@0	3137	file delete $path(test1)
sl@0	3138	set f [open $path(test1) w]
sl@0	3139	fconfigure $f -translation lf -eofchar {}
sl@0	3140	set s [format "abc\ndef\n%cghi\nqrs" 26]
sl@0	3141	puts $f $s
sl@0	3142	close $f
sl@0	3143	set f [open $path(test1) r]
sl@0	3144	fconfigure $f -translation cr -eofchar {}
sl@0	3145	set l ""
sl@0	3146	set x [gets $f]
sl@0	3147	lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
sl@0	3148	lappend l [eof $f]
sl@0	3149	lappend l [gets $f]
sl@0	3150	lappend l [eof $f]
sl@0	3151	close $f
sl@0	3152	set l
sl@0	3153	} {0 1 {} 1}
sl@0	3154	test io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} {
sl@0	3155	file delete $path(test1)
sl@0	3156	set f [open $path(test1) w]
sl@0	3157	fconfigure $f -translation lf -eofchar {}
sl@0	3158	set s [format "abc\ndef\n%cghi\nqrs" 26]
sl@0	3159	puts $f $s
sl@0	3160	close $f
sl@0	3161	set f [open $path(test1) r]
sl@0	3162	fconfigure $f -translation crlf -eofchar {}
sl@0	3163	set l ""
sl@0	3164	set x [gets $f]
sl@0	3165	lappend l [string compare $x "abc\ndef\n\x1aghi\nqrs\n"]
sl@0	3166	lappend l [eof $f]
sl@0	3167	lappend l [gets $f]
sl@0	3168	lappend l [eof $f]
sl@0	3169	close $f
sl@0	3170	set l
sl@0	3171	} {0 1 {} 1}
sl@0	3172	test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
sl@0	3173	file delete $path(test1)
sl@0	3174	set f [open $path(test1) w]
sl@0	3175	fconfigure $f -translation lf
sl@0	3176	set c [format abc\ndef\n%cqrs\ntuv 26]
sl@0	3177	puts $f $c
sl@0	3178	close $f
sl@0	3179	set f [open $path(test1) r]
sl@0	3180	fconfigure $f -translation auto -eofchar \x1a
sl@0	3181	set c [string length [read $f]]
sl@0	3182	set e [eof $f]
sl@0	3183	close $f
sl@0	3184	list $c $e
sl@0	3185	} {8 1}
sl@0	3186	test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
sl@0	3187	file delete $path(test1)
sl@0	3188	set f [open $path(test1) w]
sl@0	3189	fconfigure $f -translation lf
sl@0	3190	set c [format abc\ndef\n%cqrs\ntuv 26]
sl@0	3191	puts $f $c
sl@0	3192	close $f
sl@0	3193	set f [open $path(test1) r]
sl@0	3194	fconfigure $f -translation lf -eofchar \x1a
sl@0	3195	set c [string length [read $f]]
sl@0	3196	set e [eof $f]
sl@0	3197	close $f
sl@0	3198	list $c $e
sl@0	3199	} {8 1}
sl@0	3200	test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
sl@0	3201	file delete $path(test1)
sl@0	3202	set f [open $path(test1) w]
sl@0	3203	fconfigure $f -translation cr
sl@0	3204	set c [format abc\ndef\n%cqrs\ntuv 26]
sl@0	3205	puts $f $c
sl@0	3206	close $f
sl@0	3207	set f [open $path(test1) r]
sl@0	3208	fconfigure $f -translation auto -eofchar \x1a
sl@0	3209	set c [string length [read $f]]
sl@0	3210	set e [eof $f]
sl@0	3211	close $f
sl@0	3212	list $c $e
sl@0	3213	} {8 1}
sl@0	3214	test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
sl@0	3215	file delete $path(test1)
sl@0	3216	set f [open $path(test1) w]
sl@0	3217	fconfigure $f -translation cr
sl@0	3218	set c [format abc\ndef\n%cqrs\ntuv 26]
sl@0	3219	puts $f $c
sl@0	3220	close $f
sl@0	3221	set f [open $path(test1) r]
sl@0	3222	fconfigure $f -translation cr -eofchar \x1a
sl@0	3223	set c [string length [read $f]]
sl@0	3224	set e [eof $f]
sl@0	3225	close $f
sl@0	3226	list $c $e
sl@0	3227	} {8 1}
sl@0	3228	test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
sl@0	3229	file delete $path(test1)
sl@0	3230	set f [open $path(test1) w]
sl@0	3231	fconfigure $f -translation crlf
sl@0	3232	set c [format abc\ndef\n%cqrs\ntuv 26]
sl@0	3233	puts $f $c
sl@0	3234	close $f
sl@0	3235	set f [open $path(test1) r]
sl@0	3236	fconfigure $f -translation auto -eofchar \x1a
sl@0	3237	set c [string length [read $f]]
sl@0	3238	set e [eof $f]
sl@0	3239	close $f
sl@0	3240	list $c $e
sl@0	3241	} {8 1}
sl@0	3242	test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
sl@0	3243	file delete $path(test1)
sl@0	3244	set f [open $path(test1) w]
sl@0	3245	fconfigure $f -translation crlf
sl@0	3246	set c [format abc\ndef\n%cqrs\ntuv 26]
sl@0	3247	puts $f $c
sl@0	3248	close $f
sl@0	3249	set f [open $path(test1) r]
sl@0	3250	fconfigure $f -translation crlf -eofchar \x1a
sl@0	3251	set c [string length [read $f]]
sl@0	3252	set e [eof $f]
sl@0	3253	close $f
sl@0	3254	list $c $e
sl@0	3255	} {8 1}
sl@0	3256
sl@0	3257	# Test end of line translations. Functions tested are Tcl_Write and Tcl_Gets.
sl@0	3258
sl@0	3259	test io-31.1 {Tcl_Write lf, Tcl_Gets auto} {
sl@0	3260	file delete $path(test1)
sl@0	3261	set f [open $path(test1) w]
sl@0	3262	fconfigure $f -translation lf
sl@0	3263	puts $f hello\nthere\nand\nhere
sl@0	3264	close $f
sl@0	3265	set f [open $path(test1) r]
sl@0	3266	set l ""
sl@0	3267	lappend l [gets $f]
sl@0	3268	lappend l [tell $f]
sl@0	3269	lappend l [fconfigure $f -translation]
sl@0	3270	lappend l [gets $f]
sl@0	3271	lappend l [tell $f]
sl@0	3272	lappend l [fconfigure $f -translation]
sl@0	3273	close $f
sl@0	3274	set l
sl@0	3275	} {hello 6 auto there 12 auto}
sl@0	3276	test io-31.2 {Tcl_Write cr, Tcl_Gets auto} {
sl@0	3277	file delete $path(test1)
sl@0	3278	set f [open $path(test1) w]
sl@0	3279	fconfigure $f -translation cr
sl@0	3280	puts $f hello\nthere\nand\nhere
sl@0	3281	close $f
sl@0	3282	set f [open $path(test1) r]
sl@0	3283	set l ""
sl@0	3284	lappend l [gets $f]
sl@0	3285	lappend l [tell $f]
sl@0	3286	lappend l [fconfigure $f -translation]
sl@0	3287	lappend l [gets $f]
sl@0	3288	lappend l [tell $f]
sl@0	3289	lappend l [fconfigure $f -translation]
sl@0	3290	close $f
sl@0	3291	set l
sl@0	3292	} {hello 6 auto there 12 auto}
sl@0	3293	test io-31.3 {Tcl_Write crlf, Tcl_Gets auto} {
sl@0	3294	file delete $path(test1)
sl@0	3295	set f [open $path(test1) w]
sl@0	3296	fconfigure $f -translation crlf
sl@0	3297	puts $f hello\nthere\nand\nhere
sl@0	3298	close $f
sl@0	3299	set f [open $path(test1) r]
sl@0	3300	set l ""
sl@0	3301	lappend l [gets $f]
sl@0	3302	lappend l [tell $f]
sl@0	3303	lappend l [fconfigure $f -translation]
sl@0	3304	lappend l [gets $f]
sl@0	3305	lappend l [tell $f]
sl@0	3306	lappend l [fconfigure $f -translation]
sl@0	3307	close $f
sl@0	3308	set l
sl@0	3309	} {hello 7 auto there 14 auto}
sl@0	3310	test io-31.4 {Tcl_Write lf, Tcl_Gets lf} {
sl@0	3311	file delete $path(test1)
sl@0	3312	set f [open $path(test1) w]
sl@0	3313	fconfigure $f -translation lf
sl@0	3314	puts $f hello\nthere\nand\nhere
sl@0	3315	close $f
sl@0	3316	set f [open $path(test1) r]
sl@0	3317	fconfigure $f -translation lf
sl@0	3318	set l ""
sl@0	3319	lappend l [gets $f]
sl@0	3320	lappend l [tell $f]
sl@0	3321	lappend l [fconfigure $f -translation]
sl@0	3322	lappend l [gets $f]
sl@0	3323	lappend l [tell $f]
sl@0	3324	lappend l [fconfigure $f -translation]
sl@0	3325	close $f
sl@0	3326	set l
sl@0	3327	} {hello 6 lf there 12 lf}
sl@0	3328	test io-31.5 {Tcl_Write lf, Tcl_Gets cr} {
sl@0	3329	file delete $path(test1)
sl@0	3330	set f [open $path(test1) w]
sl@0	3331	fconfigure $f -translation lf
sl@0	3332	puts $f hello\nthere\nand\nhere
sl@0	3333	close $f
sl@0	3334	set f [open $path(test1) r]
sl@0	3335	fconfigure $f -translation cr
sl@0	3336	set l ""
sl@0	3337	lappend l [string length [gets $f]]
sl@0	3338	lappend l [tell $f]
sl@0	3339	lappend l [fconfigure $f -translation]
sl@0	3340	lappend l [eof $f]
sl@0	3341	lappend l [gets $f]
sl@0	3342	lappend l [tell $f]
sl@0	3343	lappend l [fconfigure $f -translation]
sl@0	3344	lappend l [eof $f]
sl@0	3345	close $f
sl@0	3346	set l
sl@0	3347	} {21 21 cr 1 {} 21 cr 1}
sl@0	3348	test io-31.6 {Tcl_Write lf, Tcl_Gets crlf} {
sl@0	3349	file delete $path(test1)
sl@0	3350	set f [open $path(test1) w]
sl@0	3351	fconfigure $f -translation lf
sl@0	3352	puts $f hello\nthere\nand\nhere
sl@0	3353	close $f
sl@0	3354	set f [open $path(test1) r]
sl@0	3355	fconfigure $f -translation crlf
sl@0	3356	set l ""
sl@0	3357	lappend l [string length [gets $f]]
sl@0	3358	lappend l [tell $f]
sl@0	3359	lappend l [fconfigure $f -translation]
sl@0	3360	lappend l [eof $f]
sl@0	3361	lappend l [gets $f]
sl@0	3362	lappend l [tell $f]
sl@0	3363	lappend l [fconfigure $f -translation]
sl@0	3364	lappend l [eof $f]
sl@0	3365	close $f
sl@0	3366	set l
sl@0	3367	} {21 21 crlf 1 {} 21 crlf 1}
sl@0	3368	test io-31.7 {Tcl_Write cr, Tcl_Gets cr} {
sl@0	3369	file delete $path(test1)
sl@0	3370	set f [open $path(test1) w]
sl@0	3371	fconfigure $f -translation cr
sl@0	3372	puts $f hello\nthere\nand\nhere
sl@0	3373	close $f
sl@0	3374	set f [open $path(test1) r]
sl@0	3375	fconfigure $f -translation cr
sl@0	3376	set l ""
sl@0	3377	lappend l [gets $f]
sl@0	3378	lappend l [tell $f]
sl@0	3379	lappend l [fconfigure $f -translation]
sl@0	3380	lappend l [eof $f]
sl@0	3381	lappend l [gets $f]
sl@0	3382	lappend l [tell $f]
sl@0	3383	lappend l [fconfigure $f -translation]
sl@0	3384	lappend l [eof $f]
sl@0	3385	close $f
sl@0	3386	set l
sl@0	3387	} {hello 6 cr 0 there 12 cr 0}
sl@0	3388	test io-31.8 {Tcl_Write cr, Tcl_Gets lf} {
sl@0	3389	file delete $path(test1)
sl@0	3390	set f [open $path(test1) w]
sl@0	3391	fconfigure $f -translation cr
sl@0	3392	puts $f hello\nthere\nand\nhere
sl@0	3393	close $f
sl@0	3394	set f [open $path(test1) r]
sl@0	3395	fconfigure $f -translation lf
sl@0	3396	set l ""
sl@0	3397	lappend l [string length [gets $f]]
sl@0	3398	lappend l [tell $f]
sl@0	3399	lappend l [fconfigure $f -translation]
sl@0	3400	lappend l [eof $f]
sl@0	3401	lappend l [gets $f]
sl@0	3402	lappend l [tell $f]
sl@0	3403	lappend l [fconfigure $f -translation]
sl@0	3404	lappend l [eof $f]
sl@0	3405	close $f
sl@0	3406	set l
sl@0	3407	} {21 21 lf 1 {} 21 lf 1}
sl@0	3408	test io-31.9 {Tcl_Write cr, Tcl_Gets crlf} {
sl@0	3409	file delete $path(test1)
sl@0	3410	set f [open $path(test1) w]
sl@0	3411	fconfigure $f -translation cr
sl@0	3412	puts $f hello\nthere\nand\nhere
sl@0	3413	close $f
sl@0	3414	set f [open $path(test1) r]
sl@0	3415	fconfigure $f -translation crlf
sl@0	3416	set l ""
sl@0	3417	lappend l [string length [gets $f]]
sl@0	3418	lappend l [tell $f]
sl@0	3419	lappend l [fconfigure $f -translation]
sl@0	3420	lappend l [eof $f]
sl@0	3421	lappend l [gets $f]
sl@0	3422	lappend l [tell $f]
sl@0	3423	lappend l [fconfigure $f -translation]
sl@0	3424	lappend l [eof $f]
sl@0	3425	close $f
sl@0	3426	set l
sl@0	3427	} {21 21 crlf 1 {} 21 crlf 1}
sl@0	3428	test io-31.10 {Tcl_Write crlf, Tcl_Gets crlf} {
sl@0	3429	file delete $path(test1)
sl@0	3430	set f [open $path(test1) w]
sl@0	3431	fconfigure $f -translation crlf
sl@0	3432	puts $f hello\nthere\nand\nhere
sl@0	3433	close $f
sl@0	3434	set f [open $path(test1) r]
sl@0	3435	fconfigure $f -translation crlf
sl@0	3436	set l ""
sl@0	3437	lappend l [gets $f]
sl@0	3438	lappend l [tell $f]
sl@0	3439	lappend l [fconfigure $f -translation]
sl@0	3440	lappend l [eof $f]
sl@0	3441	lappend l [gets $f]
sl@0	3442	lappend l [tell $f]
sl@0	3443	lappend l [fconfigure $f -translation]
sl@0	3444	lappend l [eof $f]
sl@0	3445	close $f
sl@0	3446	set l
sl@0	3447	} {hello 7 crlf 0 there 14 crlf 0}
sl@0	3448	test io-31.11 {Tcl_Write crlf, Tcl_Gets cr} {
sl@0	3449	file delete $path(test1)
sl@0	3450	set f [open $path(test1) w]
sl@0	3451	fconfigure $f -translation crlf
sl@0	3452	puts $f hello\nthere\nand\nhere
sl@0	3453	close $f
sl@0	3454	set f [open $path(test1) r]
sl@0	3455	fconfigure $f -translation cr
sl@0	3456	set l ""
sl@0	3457	lappend l [gets $f]
sl@0	3458	lappend l [tell $f]
sl@0	3459	lappend l [fconfigure $f -translation]
sl@0	3460	lappend l [eof $f]
sl@0	3461	lappend l [string length [gets $f]]
sl@0	3462	lappend l [tell $f]
sl@0	3463	lappend l [fconfigure $f -translation]
sl@0	3464	lappend l [eof $f]
sl@0	3465	close $f
sl@0	3466	set l
sl@0	3467	} {hello 6 cr 0 6 13 cr 0}
sl@0	3468	test io-31.12 {Tcl_Write crlf, Tcl_Gets lf} {
sl@0	3469	file delete $path(test1)
sl@0	3470	set f [open $path(test1) w]
sl@0	3471	fconfigure $f -translation crlf
sl@0	3472	puts $f hello\nthere\nand\nhere
sl@0	3473	close $f
sl@0	3474	set f [open $path(test1) r]
sl@0	3475	fconfigure $f -translation lf
sl@0	3476	set l ""
sl@0	3477	lappend l [string length [gets $f]]
sl@0	3478	lappend l [tell $f]
sl@0	3479	lappend l [fconfigure $f -translation]
sl@0	3480	lappend l [eof $f]
sl@0	3481	lappend l [string length [gets $f]]
sl@0	3482	lappend l [tell $f]
sl@0	3483	lappend l [fconfigure $f -translation]
sl@0	3484	lappend l [eof $f]
sl@0	3485	close $f
sl@0	3486	set l
sl@0	3487	} {6 7 lf 0 6 14 lf 0}
sl@0	3488	test io-31.13 {binary mode is synonym of lf mode} {
sl@0	3489	file delete $path(test1)
sl@0	3490	set f [open $path(test1) w]
sl@0	3491	fconfigure $f -translation binary
sl@0	3492	set x [fconfigure $f -translation]
sl@0	3493	close $f
sl@0	3494	set x
sl@0	3495	} lf
sl@0	3496	#
sl@0	3497	# Test io-9.14 has been removed because "auto" output translation mode is
sl@0	3498	# not supoprted.
sl@0	3499	#
sl@0	3500	test io-31.14 {Tcl_Write mixed, Tcl_Gets auto} {
sl@0	3501	file delete $path(test1)
sl@0	3502	set f [open $path(test1) w]
sl@0	3503	fconfigure $f -translation lf
sl@0	3504	puts $f hello\nthere\rand\r\nhere
sl@0	3505	close $f
sl@0	3506	set f [open $path(test1) r]
sl@0	3507	fconfigure $f -translation auto
sl@0	3508	set l ""
sl@0	3509	lappend l [gets $f]
sl@0	3510	lappend l [gets $f]
sl@0	3511	lappend l [gets $f]
sl@0	3512	lappend l [gets $f]
sl@0	3513	lappend l [eof $f]
sl@0	3514	lappend l [gets $f]
sl@0	3515	lappend l [eof $f]
sl@0	3516	close $f
sl@0	3517	set l
sl@0	3518	} {hello there and here 0 {} 1}
sl@0	3519	test io-31.15 {Tcl_Write mixed, Tcl_Gets auto} {
sl@0	3520	file delete $path(test1)
sl@0	3521	set f [open $path(test1) w]
sl@0	3522	fconfigure $f -translation lf
sl@0	3523	puts -nonewline $f hello\nthere\rand\r\nhere\r
sl@0	3524	close $f
sl@0	3525	set f [open $path(test1) r]
sl@0	3526	fconfigure $f -translation auto
sl@0	3527	set l ""
sl@0	3528	lappend l [gets $f]
sl@0	3529	lappend l [gets $f]
sl@0	3530	lappend l [gets $f]
sl@0	3531	lappend l [gets $f]
sl@0	3532	lappend l [eof $f]
sl@0	3533	lappend l [gets $f]
sl@0	3534	lappend l [eof $f]
sl@0	3535	close $f
sl@0	3536	set l
sl@0	3537	} {hello there and here 0 {} 1}
sl@0	3538	test io-31.16 {Tcl_Write mixed, Tcl_Gets auto} {
sl@0	3539	file delete $path(test1)
sl@0	3540	set f [open $path(test1) w]
sl@0	3541	fconfigure $f -translation lf
sl@0	3542	puts -nonewline $f hello\nthere\rand\r\nhere\n
sl@0	3543	close $f
sl@0	3544	set f [open $path(test1) r]
sl@0	3545	set l ""
sl@0	3546	lappend l [gets $f]
sl@0	3547	lappend l [gets $f]
sl@0	3548	lappend l [gets $f]
sl@0	3549	lappend l [gets $f]
sl@0	3550	lappend l [eof $f]
sl@0	3551	lappend l [gets $f]
sl@0	3552	lappend l [eof $f]
sl@0	3553	close $f
sl@0	3554	set l
sl@0	3555	} {hello there and here 0 {} 1}
sl@0	3556	test io-31.17 {Tcl_Write mixed, Tcl_Gets auto} {
sl@0	3557	file delete $path(test1)
sl@0	3558	set f [open $path(test1) w]
sl@0	3559	fconfigure $f -translation lf
sl@0	3560	puts -nonewline $f hello\nthere\rand\r\nhere\r\n
sl@0	3561	close $f
sl@0	3562	set f [open $path(test1) r]
sl@0	3563	fconfigure $f -translation auto
sl@0	3564	set l ""
sl@0	3565	lappend l [gets $f]
sl@0	3566	lappend l [gets $f]
sl@0	3567	lappend l [gets $f]
sl@0	3568	lappend l [gets $f]
sl@0	3569	lappend l [eof $f]
sl@0	3570	lappend l [gets $f]
sl@0	3571	lappend l [eof $f]
sl@0	3572	close $f
sl@0	3573	set l
sl@0	3574	} {hello there and here 0 {} 1}
sl@0	3575	test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
sl@0	3576	file delete $path(test1)
sl@0	3577	set f [open $path(test1) w]
sl@0	3578	fconfigure $f -translation lf
sl@0	3579	set s [format "hello\nthere\nand\rhere\n\%c" 26]
sl@0	3580	puts $f $s
sl@0	3581	close $f
sl@0	3582	set f [open $path(test1) r]
sl@0	3583	fconfigure $f -eofchar \x1a -translation auto
sl@0	3584	set l ""
sl@0	3585	lappend l [gets $f]
sl@0	3586	lappend l [gets $f]
sl@0	3587	lappend l [gets $f]
sl@0	3588	lappend l [gets $f]
sl@0	3589	lappend l [eof $f]
sl@0	3590	lappend l [gets $f]
sl@0	3591	lappend l [eof $f]
sl@0	3592	close $f
sl@0	3593	set l
sl@0	3594	} {hello there and here 0 {} 1}
sl@0	3595	test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
sl@0	3596	file delete $path(test1)
sl@0	3597	set f [open $path(test1) w]
sl@0	3598	fconfigure $f -eofchar \x1a -translation lf
sl@0	3599	puts $f hello\nthere\nand\rhere
sl@0	3600	close $f
sl@0	3601	set f [open $path(test1) r]
sl@0	3602	fconfigure $f -eofchar \x1a -translation auto
sl@0	3603	set l ""
sl@0	3604	lappend l [gets $f]
sl@0	3605	lappend l [gets $f]
sl@0	3606	lappend l [gets $f]
sl@0	3607	lappend l [gets $f]
sl@0	3608	lappend l [eof $f]
sl@0	3609	lappend l [gets $f]
sl@0	3610	lappend l [eof $f]
sl@0	3611	close $f
sl@0	3612	set l
sl@0	3613	} {hello there and here 0 {} 1}
sl@0	3614	test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
sl@0	3615	file delete $path(test1)
sl@0	3616	set f [open $path(test1) w]
sl@0	3617	fconfigure $f -translation lf
sl@0	3618	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3619	puts $f $s
sl@0	3620	close $f
sl@0	3621	set f [open $path(test1) r]
sl@0	3622	fconfigure $f -eofchar \x1a
sl@0	3623	fconfigure $f -translation auto
sl@0	3624	set l ""
sl@0	3625	lappend l [gets $f]
sl@0	3626	lappend l [gets $f]
sl@0	3627	lappend l [eof $f]
sl@0	3628	lappend l [gets $f]
sl@0	3629	lappend l [eof $f]
sl@0	3630	close $f
sl@0	3631	set l
sl@0	3632	} {abc def 0 {} 1}
sl@0	3633	test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
sl@0	3634	file delete $path(test1)
sl@0	3635	set f [open $path(test1) w]
sl@0	3636	fconfigure $f -translation lf
sl@0	3637	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3638	puts $f $s
sl@0	3639	close $f
sl@0	3640	set f [open $path(test1) r]
sl@0	3641	fconfigure $f -eofchar \x1a -translation auto
sl@0	3642	set l ""
sl@0	3643	lappend l [gets $f]
sl@0	3644	lappend l [gets $f]
sl@0	3645	lappend l [eof $f]
sl@0	3646	lappend l [gets $f]
sl@0	3647	lappend l [eof $f]
sl@0	3648	close $f
sl@0	3649	set l
sl@0	3650	} {abc def 0 {} 1}
sl@0	3651	test io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} {
sl@0	3652	file delete $path(test1)
sl@0	3653	set f [open $path(test1) w]
sl@0	3654	fconfigure $f -translation lf -eofchar {}
sl@0	3655	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3656	puts $f $s
sl@0	3657	close $f
sl@0	3658	set f [open $path(test1) r]
sl@0	3659	fconfigure $f -translation lf -eofchar {}
sl@0	3660	set l ""
sl@0	3661	lappend l [gets $f]
sl@0	3662	lappend l [gets $f]
sl@0	3663	lappend l [eof $f]
sl@0	3664	lappend l [gets $f]
sl@0	3665	lappend l [eof $f]
sl@0	3666	lappend l [gets $f]
sl@0	3667	lappend l [eof $f]
sl@0	3668	lappend l [gets $f]
sl@0	3669	lappend l [eof $f]
sl@0	3670	close $f
sl@0	3671	set l
sl@0	3672	} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
sl@0	3673	test io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} {
sl@0	3674	file delete $path(test1)
sl@0	3675	set f [open $path(test1) w]
sl@0	3676	fconfigure $f -translation cr -eofchar {}
sl@0	3677	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3678	puts $f $s
sl@0	3679	close $f
sl@0	3680	set f [open $path(test1) r]
sl@0	3681	fconfigure $f -translation cr -eofchar {}
sl@0	3682	set l ""
sl@0	3683	lappend l [gets $f]
sl@0	3684	lappend l [gets $f]
sl@0	3685	lappend l [eof $f]
sl@0	3686	lappend l [gets $f]
sl@0	3687	lappend l [eof $f]
sl@0	3688	lappend l [gets $f]
sl@0	3689	lappend l [eof $f]
sl@0	3690	lappend l [gets $f]
sl@0	3691	lappend l [eof $f]
sl@0	3692	close $f
sl@0	3693	set l
sl@0	3694	} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
sl@0	3695	test io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} {
sl@0	3696	file delete $path(test1)
sl@0	3697	set f [open $path(test1) w]
sl@0	3698	fconfigure $f -translation crlf -eofchar {}
sl@0	3699	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3700	puts $f $s
sl@0	3701	close $f
sl@0	3702	set f [open $path(test1) r]
sl@0	3703	fconfigure $f -translation crlf -eofchar {}
sl@0	3704	set l ""
sl@0	3705	lappend l [gets $f]
sl@0	3706	lappend l [gets $f]
sl@0	3707	lappend l [eof $f]
sl@0	3708	lappend l [gets $f]
sl@0	3709	lappend l [eof $f]
sl@0	3710	lappend l [gets $f]
sl@0	3711	lappend l [eof $f]
sl@0	3712	lappend l [gets $f]
sl@0	3713	lappend l [eof $f]
sl@0	3714	close $f
sl@0	3715	set l
sl@0	3716	} "abc def 0 \x1aqrs 0 tuv 0 {} 1"
sl@0	3717	test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
sl@0	3718	file delete $path(test1)
sl@0	3719	set f [open $path(test1) w]
sl@0	3720	fconfigure $f -translation lf
sl@0	3721	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3722	puts $f $s
sl@0	3723	close $f
sl@0	3724	set f [open $path(test1) r]
sl@0	3725	fconfigure $f -translation auto -eofchar \x1a
sl@0	3726	set l ""
sl@0	3727	lappend l [gets $f]
sl@0	3728	lappend l [gets $f]
sl@0	3729	lappend l [eof $f]
sl@0	3730	lappend l [gets $f]
sl@0	3731	lappend l [eof $f]
sl@0	3732	close $f
sl@0	3733	set l
sl@0	3734	} {abc def 0 {} 1}
sl@0	3735	test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
sl@0	3736	file delete $path(test1)
sl@0	3737	set f [open $path(test1) w]
sl@0	3738	fconfigure $f -translation lf
sl@0	3739	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3740	puts $f $s
sl@0	3741	close $f
sl@0	3742	set f [open $path(test1) r]
sl@0	3743	fconfigure $f -translation lf -eofchar \x1a
sl@0	3744	set l ""
sl@0	3745	lappend l [gets $f]
sl@0	3746	lappend l [gets $f]
sl@0	3747	lappend l [eof $f]
sl@0	3748	lappend l [gets $f]
sl@0	3749	lappend l [eof $f]
sl@0	3750	close $f
sl@0	3751	set l
sl@0	3752	} {abc def 0 {} 1}
sl@0	3753	test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
sl@0	3754	file delete $path(test1)
sl@0	3755	set f [open $path(test1) w]
sl@0	3756	fconfigure $f -translation cr -eofchar {}
sl@0	3757	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3758	puts $f $s
sl@0	3759	close $f
sl@0	3760	set f [open $path(test1) r]
sl@0	3761	fconfigure $f -translation auto -eofchar \x1a
sl@0	3762	set l ""
sl@0	3763	lappend l [gets $f]
sl@0	3764	lappend l [gets $f]
sl@0	3765	lappend l [eof $f]
sl@0	3766	lappend l [gets $f]
sl@0	3767	lappend l [eof $f]
sl@0	3768	close $f
sl@0	3769	set l
sl@0	3770	} {abc def 0 {} 1}
sl@0	3771	test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
sl@0	3772	file delete $path(test1)
sl@0	3773	set f [open $path(test1) w]
sl@0	3774	fconfigure $f -translation cr -eofchar {}
sl@0	3775	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3776	puts $f $s
sl@0	3777	close $f
sl@0	3778	set f [open $path(test1) r]
sl@0	3779	fconfigure $f -translation cr -eofchar \x1a
sl@0	3780	set l ""
sl@0	3781	lappend l [gets $f]
sl@0	3782	lappend l [gets $f]
sl@0	3783	lappend l [eof $f]
sl@0	3784	lappend l [gets $f]
sl@0	3785	lappend l [eof $f]
sl@0	3786	close $f
sl@0	3787	set l
sl@0	3788	} {abc def 0 {} 1}
sl@0	3789	test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
sl@0	3790	file delete $path(test1)
sl@0	3791	set f [open $path(test1) w]
sl@0	3792	fconfigure $f -translation crlf -eofchar {}
sl@0	3793	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3794	puts $f $s
sl@0	3795	close $f
sl@0	3796	set f [open $path(test1) r]
sl@0	3797	fconfigure $f -translation auto -eofchar \x1a
sl@0	3798	set l ""
sl@0	3799	lappend l [gets $f]
sl@0	3800	lappend l [gets $f]
sl@0	3801	lappend l [eof $f]
sl@0	3802	lappend l [gets $f]
sl@0	3803	lappend l [eof $f]
sl@0	3804	close $f
sl@0	3805	set l
sl@0	3806	} {abc def 0 {} 1}
sl@0	3807	test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
sl@0	3808	file delete $path(test1)
sl@0	3809	set f [open $path(test1) w]
sl@0	3810	fconfigure $f -translation crlf -eofchar {}
sl@0	3811	set s [format "abc\ndef\n%cqrs\ntuv" 26]
sl@0	3812	puts $f $s
sl@0	3813	close $f
sl@0	3814	set f [open $path(test1) r]
sl@0	3815	fconfigure $f -translation crlf -eofchar \x1a
sl@0	3816	set l ""
sl@0	3817	lappend l [gets $f]
sl@0	3818	lappend l [gets $f]
sl@0	3819	lappend l [eof $f]
sl@0	3820	lappend l [gets $f]
sl@0	3821	lappend l [eof $f]
sl@0	3822	close $f
sl@0	3823	set l
sl@0	3824	} {abc def 0 {} 1}
sl@0	3825	test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
sl@0	3826	file delete $path(test1)
sl@0	3827	set f [open $path(test1) w]
sl@0	3828	fconfigure $f -translation crlf
sl@0	3829	set line "123456789ABCDE" ;# 14 char plus crlf
sl@0	3830	puts -nonewline $f x ;# shift crlf across block boundary
sl@0	3831	for {set i 0} {$i < 700} {incr i} {
sl@0	3832	puts $f $line
sl@0	3833	}
sl@0	3834	close $f
sl@0	3835	set f [open $path(test1) r]
sl@0	3836	fconfigure $f -translation crlf
sl@0	3837	set c ""
sl@0	3838	while {[gets $f line] >= 0} {
sl@0	3839	append c $line\n
sl@0	3840	}
sl@0	3841	close $f
sl@0	3842	string length $c
sl@0	3843	} [expr 700*15+1]
sl@0	3844	test io-31.32 {Tcl_Write crlf on block boundary, Tcl_Gets auto} {
sl@0	3845	file delete $path(test1)
sl@0	3846	set f [open $path(test1) w]
sl@0	3847	fconfigure $f -translation crlf
sl@0	3848	set line "123456789ABCDE" ;# 14 char plus crlf
sl@0	3849	puts -nonewline $f x ;# shift crlf across block boundary
sl@0	3850	for {set i 0} {$i < 700} {incr i} {
sl@0	3851	puts $f $line
sl@0	3852	}
sl@0	3853	close $f
sl@0	3854	set f [open $path(test1) r]
sl@0	3855	fconfigure $f -translation auto
sl@0	3856	set c ""
sl@0	3857	while {[gets $f line] >= 0} {
sl@0	3858	append c $line\n
sl@0	3859	}
sl@0	3860	close $f
sl@0	3861	string length $c
sl@0	3862	} [expr 700*15+1]
sl@0	3863
sl@0	3864
sl@0	3865	# Test Tcl_Read and buffering.
sl@0	3866
sl@0	3867	test io-32.1 {Tcl_Read, channel not readable} {
sl@0	3868	list [catch {read stdout} msg] $msg
sl@0	3869	} {1 {channel "stdout" wasn't opened for reading}}
sl@0	3870	test io-32.2 {Tcl_Read, zero byte count} {
sl@0	3871	read stdin 0
sl@0	3872	} ""
sl@0	3873	test io-32.3 {Tcl_Read, negative byte count} {
sl@0	3874	set f [open $path(longfile) r]
sl@0	3875	set l [list [catch {read $f -1} msg] $msg]
sl@0	3876	close $f
sl@0	3877	set l
sl@0	3878	} {1 {bad argument "-1": should be "nonewline"}}
sl@0	3879	test io-32.4 {Tcl_Read, positive byte count} {
sl@0	3880	set f [open $path(longfile) r]
sl@0	3881	set x [read $f 1024]
sl@0	3882	set s [string length $x]
sl@0	3883	unset x
sl@0	3884	close $f
sl@0	3885	set s
sl@0	3886	} 1024
sl@0	3887	test io-32.5 {Tcl_Read, multiple buffers} {
sl@0	3888	set f [open $path(longfile) r]
sl@0	3889	fconfigure $f -buffersize 100
sl@0	3890	set x [read $f 1024]
sl@0	3891	set s [string length $x]
sl@0	3892	unset x
sl@0	3893	close $f
sl@0	3894	set s
sl@0	3895	} 1024
sl@0	3896	test io-32.6 {Tcl_Read, very large read} {
sl@0	3897	set f1 [open $path(longfile) r]
sl@0	3898	set z [read $f1 1000000]
sl@0	3899	close $f1
sl@0	3900	set l [string length $z]
sl@0	3901	set x ok
sl@0	3902	set z [file size $path(longfile)]
sl@0	3903	if {$z != $l} {
sl@0	3904	set x broken
sl@0	3905	}
sl@0	3906	set x
sl@0	3907	} ok
sl@0	3908	test io-32.7 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
sl@0	3909	set f1 [open $path(longfile) r]
sl@0	3910	fconfigure $f1 -blocking off
sl@0	3911	set z [read $f1 20]
sl@0	3912	close $f1
sl@0	3913	set l [string length $z]
sl@0	3914	set x ok
sl@0	3915	if {$l != 20} {
sl@0	3916	set x broken
sl@0	3917	}
sl@0	3918	set x
sl@0	3919	} ok
sl@0	3920	test io-32.8 {Tcl_Read, nonblocking, file} {nonBlockFiles} {
sl@0	3921	set f1 [open $path(longfile) r]
sl@0	3922	fconfigure $f1 -blocking off
sl@0	3923	set z [read $f1 1000000]
sl@0	3924	close $f1
sl@0	3925	set x ok
sl@0	3926	set l [string length $z]
sl@0	3927	set z [file size $path(longfile)]
sl@0	3928	if {$z != $l} {
sl@0	3929	set x broken
sl@0	3930	}
sl@0	3931	set x
sl@0	3932	} ok
sl@0	3933	test io-32.9 {Tcl_Read, read to end of file} {
sl@0	3934	set f1 [open $path(longfile) r]
sl@0	3935	set z [read $f1]
sl@0	3936	close $f1
sl@0	3937	set l [string length $z]
sl@0	3938	set x ok
sl@0	3939	set z [file size $path(longfile)]
sl@0	3940	if {$z != $l} {
sl@0	3941	set x broken
sl@0	3942	}
sl@0	3943	set x
sl@0	3944	} ok
sl@0	3945	test io-32.10 {Tcl_Read from a pipe} {stdio openpipe} {
sl@0	3946	file delete $path(pipe)
sl@0	3947	set f1 [open $path(pipe) w]
sl@0	3948	puts $f1 {puts [gets stdin]}
sl@0	3949	close $f1
sl@0	3950	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	3951	puts $f1 hello
sl@0	3952	flush $f1
sl@0	3953	set x [read $f1]
sl@0	3954	close $f1
sl@0	3955	set x
sl@0	3956	} "hello\n"
sl@0	3957	test io-32.11 {Tcl_Read from a pipe} {stdio openpipe} {
sl@0	3958	file delete $path(pipe)
sl@0	3959	set f1 [open $path(pipe) w]
sl@0	3960	puts $f1 {puts [gets stdin]}
sl@0	3961	puts $f1 {puts [gets stdin]}
sl@0	3962	close $f1
sl@0	3963	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	3964	puts $f1 hello
sl@0	3965	flush $f1
sl@0	3966	set x ""
sl@0	3967	lappend x [read $f1 6]
sl@0	3968	puts $f1 hello
sl@0	3969	flush $f1
sl@0	3970	lappend x [read $f1]
sl@0	3971	close $f1
sl@0	3972	set x
sl@0	3973	} {{hello
sl@0	3974	} {hello
sl@0	3975	}}
sl@0	3976	test io-32.12 {Tcl_Read, -nonewline} {
sl@0	3977	file delete $path(test1)
sl@0	3978	set f1 [open $path(test1) w]
sl@0	3979	puts $f1 hello
sl@0	3980	puts $f1 bye
sl@0	3981	close $f1
sl@0	3982	set f1 [open $path(test1) r]
sl@0	3983	set c [read -nonewline $f1]
sl@0	3984	close $f1
sl@0	3985	set c
sl@0	3986	} {hello
sl@0	3987	bye}
sl@0	3988	test io-32.13 {Tcl_Read, -nonewline} {
sl@0	3989	file delete $path(test1)
sl@0	3990	set f1 [open $path(test1) w]
sl@0	3991	puts $f1 hello
sl@0	3992	puts $f1 bye
sl@0	3993	close $f1
sl@0	3994	set f1 [open $path(test1) r]
sl@0	3995	set c [read -nonewline $f1]
sl@0	3996	close $f1
sl@0	3997	list [string length $c] $c
sl@0	3998	} {9 {hello
sl@0	3999	bye}}
sl@0	4000	test io-32.14 {Tcl_Read, reading in small chunks} {
sl@0	4001	file delete $path(test1)
sl@0	4002	set f [open $path(test1) w]
sl@0	4003	puts $f "Two lines: this one"
sl@0	4004	puts $f "and this one"
sl@0	4005	close $f
sl@0	4006	set f [open $path(test1)]
sl@0	4007	set x [list [read $f 1] [read $f 2] [read $f]]
sl@0	4008	close $f
sl@0	4009	set x
sl@0	4010	} {T wo { lines: this one
sl@0	4011	and this one
sl@0	4012	}}
sl@0	4013	test io-32.15 {Tcl_Read, asking for more input than available} {
sl@0	4014	file delete $path(test1)
sl@0	4015	set f [open $path(test1) w]
sl@0	4016	puts $f "Two lines: this one"
sl@0	4017	puts $f "and this one"
sl@0	4018	close $f
sl@0	4019	set f [open $path(test1)]
sl@0	4020	set x [read $f 100]
sl@0	4021	close $f
sl@0	4022	set x
sl@0	4023	} {Two lines: this one
sl@0	4024	and this one
sl@0	4025	}
sl@0	4026	test io-32.16 {Tcl_Read, read to end of file with -nonewline} {
sl@0	4027	file delete $path(test1)
sl@0	4028	set f [open $path(test1) w]
sl@0	4029	puts $f "Two lines: this one"
sl@0	4030	puts $f "and this one"
sl@0	4031	close $f
sl@0	4032	set f [open $path(test1)]
sl@0	4033	set x [read -nonewline $f]
sl@0	4034	close $f
sl@0	4035	set x
sl@0	4036	} {Two lines: this one
sl@0	4037	and this one}
sl@0	4038
sl@0	4039	# Test Tcl_Gets.
sl@0	4040
sl@0	4041	test io-33.1 {Tcl_Gets, reading what was written} {
sl@0	4042	file delete $path(test1)
sl@0	4043	set f1 [open $path(test1) w]
sl@0	4044	set y "first line"
sl@0	4045	puts $f1 $y
sl@0	4046	close $f1
sl@0	4047	set f1 [open $path(test1) r]
sl@0	4048	set x [gets $f1]
sl@0	4049	set z ok
sl@0	4050	if {"$x" != "$y"} {
sl@0	4051	set z broken
sl@0	4052	}
sl@0	4053	close $f1
sl@0	4054	set z
sl@0	4055	} ok
sl@0	4056	test io-33.2 {Tcl_Gets into variable} {
sl@0	4057	set f1 [open $path(longfile) r]
sl@0	4058	set c [gets $f1 x]
sl@0	4059	set l [string length x]
sl@0	4060	set z ok
sl@0	4061	if {$l != $l} {
sl@0	4062	set z broken
sl@0	4063	}
sl@0	4064	close $f1
sl@0	4065	set z
sl@0	4066	} ok
sl@0	4067	test io-33.3 {Tcl_Gets from pipe} {stdio openpipe} {
sl@0	4068	file delete $path(pipe)
sl@0	4069	set f1 [open $path(pipe) w]
sl@0	4070	puts $f1 {puts [gets stdin]}
sl@0	4071	close $f1
sl@0	4072	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	4073	puts $f1 hello
sl@0	4074	flush $f1
sl@0	4075	set x [gets $f1]
sl@0	4076	close $f1
sl@0	4077	set z ok
sl@0	4078	if {"$x" != "hello"} {
sl@0	4079	set z broken
sl@0	4080	}
sl@0	4081	set z
sl@0	4082	} ok
sl@0	4083	test io-33.4 {Tcl_Gets with long line} {
sl@0	4084	file delete $path(test3)
sl@0	4085	set f [open $path(test3) w]
sl@0	4086	puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
sl@0	4087	puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
sl@0	4088	puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
sl@0	4089	puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
sl@0	4090	puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
sl@0	4091	close $f
sl@0	4092	set f [open $path(test3)]
sl@0	4093	set x [gets $f]
sl@0	4094	close $f
sl@0	4095	set x
sl@0	4096	} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
sl@0	4097	test io-33.5 {Tcl_Gets with long line} {
sl@0	4098	set f [open $path(test3)]
sl@0	4099	set x [gets $f y]
sl@0	4100	close $f
sl@0	4101	list $x $y
sl@0	4102	} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
sl@0	4103	test io-33.6 {Tcl_Gets and end of file} {
sl@0	4104	file delete $path(test3)
sl@0	4105	set f [open $path(test3) w]
sl@0	4106	puts -nonewline $f "Test1\nTest2"
sl@0	4107	close $f
sl@0	4108	set f [open $path(test3)]
sl@0	4109	set x {}
sl@0	4110	set y {}
sl@0	4111	lappend x [gets $f y] $y
sl@0	4112	set y {}
sl@0	4113	lappend x [gets $f y] $y
sl@0	4114	set y {}
sl@0	4115	lappend x [gets $f y] $y
sl@0	4116	close $f
sl@0	4117	set x
sl@0	4118	} {5 Test1 5 Test2 -1 {}}
sl@0	4119	test io-33.7 {Tcl_Gets and bad variable} {
sl@0	4120	set f [open $path(test3) w]
sl@0	4121	puts $f "Line 1"
sl@0	4122	puts $f "Line 2"
sl@0	4123	close $f
sl@0	4124	catch {unset x}
sl@0	4125	set x 24
sl@0	4126	set f [open $path(test3) r]
sl@0	4127	set result [list [catch {gets $f x(0)} msg] $msg]
sl@0	4128	close $f
sl@0	4129	set result
sl@0	4130	} {1 {can't set "x(0)": variable isn't array}}
sl@0	4131	test io-33.8 {Tcl_Gets, exercising double buffering} {
sl@0	4132	set f [open $path(test3) w]
sl@0	4133	fconfigure $f -translation lf -eofchar {}
sl@0	4134	set x ""
sl@0	4135	for {set y 0} {$y < 99} {incr y} {set x "a$x"}
sl@0	4136	for {set y 0} {$y < 100} {incr y} {puts $f $x}
sl@0	4137	close $f
sl@0	4138	set f [open $path(test3) r]
sl@0	4139	fconfigure $f -translation lf
sl@0	4140	for {set y 0} {$y < 100} {incr y} {gets $f}
sl@0	4141	close $f
sl@0	4142	set y
sl@0	4143	} 100
sl@0	4144	test io-33.9 {Tcl_Gets, exercising double buffering} {
sl@0	4145	set f [open $path(test3) w]
sl@0	4146	fconfigure $f -translation lf -eofchar {}
sl@0	4147	set x ""
sl@0	4148	for {set y 0} {$y < 99} {incr y} {set x "a$x"}
sl@0	4149	for {set y 0} {$y < 200} {incr y} {puts $f $x}
sl@0	4150	close $f
sl@0	4151	set f [open $path(test3) r]
sl@0	4152	fconfigure $f -translation lf
sl@0	4153	for {set y 0} {$y < 200} {incr y} {gets $f}
sl@0	4154	close $f
sl@0	4155	set y
sl@0	4156	} 200
sl@0	4157	test io-33.10 {Tcl_Gets, exercising double buffering} {
sl@0	4158	set f [open $path(test3) w]
sl@0	4159	fconfigure $f -translation lf -eofchar {}
sl@0	4160	set x ""
sl@0	4161	for {set y 0} {$y < 99} {incr y} {set x "a$x"}
sl@0	4162	for {set y 0} {$y < 300} {incr y} {puts $f $x}
sl@0	4163	close $f
sl@0	4164	set f [open $path(test3) r]
sl@0	4165	fconfigure $f -translation lf
sl@0	4166	for {set y 0} {$y < 300} {incr y} {gets $f}
sl@0	4167	close $f
sl@0	4168	set y
sl@0	4169	} 300
sl@0	4170
sl@0	4171	# Test Tcl_Seek and Tcl_Tell.
sl@0	4172
sl@0	4173	test io-34.1 {Tcl_Seek to current position at start of file} {
sl@0	4174	set f1 [open $path(longfile) r]
sl@0	4175	seek $f1 0 current
sl@0	4176	set c [tell $f1]
sl@0	4177	close $f1
sl@0	4178	set c
sl@0	4179	} 0
sl@0	4180	test io-34.2 {Tcl_Seek to offset from start} {
sl@0	4181	file delete $path(test1)
sl@0	4182	set f1 [open $path(test1) w]
sl@0	4183	fconfigure $f1 -translation lf -eofchar {}
sl@0	4184	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4185	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4186	close $f1
sl@0	4187	set f1 [open $path(test1) r]
sl@0	4188	seek $f1 10 start
sl@0	4189	set c [tell $f1]
sl@0	4190	close $f1
sl@0	4191	set c
sl@0	4192	} 10
sl@0	4193	test io-34.3 {Tcl_Seek to end of file} {
sl@0	4194	file delete $path(test1)
sl@0	4195	set f1 [open $path(test1) w]
sl@0	4196	fconfigure $f1 -translation lf -eofchar {}
sl@0	4197	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4198	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4199	close $f1
sl@0	4200	set f1 [open $path(test1) r]
sl@0	4201	seek $f1 0 end
sl@0	4202	set c [tell $f1]
sl@0	4203	close $f1
sl@0	4204	set c
sl@0	4205	} 54
sl@0	4206	test io-34.4 {Tcl_Seek to offset from end of file} {
sl@0	4207	file delete $path(test1)
sl@0	4208	set f1 [open $path(test1) w]
sl@0	4209	fconfigure $f1 -translation lf -eofchar {}
sl@0	4210	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4211	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4212	close $f1
sl@0	4213	set f1 [open $path(test1) r]
sl@0	4214	seek $f1 -10 end
sl@0	4215	set c [tell $f1]
sl@0	4216	close $f1
sl@0	4217	set c
sl@0	4218	} 44
sl@0	4219	test io-34.5 {Tcl_Seek to offset from current position} {
sl@0	4220	file delete $path(test1)
sl@0	4221	set f1 [open $path(test1) w]
sl@0	4222	fconfigure $f1 -translation lf -eofchar {}
sl@0	4223	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4224	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4225	close $f1
sl@0	4226	set f1 [open $path(test1) r]
sl@0	4227	seek $f1 10 current
sl@0	4228	seek $f1 10 current
sl@0	4229	set c [tell $f1]
sl@0	4230	close $f1
sl@0	4231	set c
sl@0	4232	} 20
sl@0	4233	test io-34.6 {Tcl_Seek to offset from end of file} {
sl@0	4234	file delete $path(test1)
sl@0	4235	set f1 [open $path(test1) w]
sl@0	4236	fconfigure $f1 -translation lf -eofchar {}
sl@0	4237	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4238	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4239	close $f1
sl@0	4240	set f1 [open $path(test1) r]
sl@0	4241	seek $f1 -10 end
sl@0	4242	set c [tell $f1]
sl@0	4243	set r [read $f1]
sl@0	4244	close $f1
sl@0	4245	list $c $r
sl@0	4246	} {44 {rstuvwxyz
sl@0	4247	}}
sl@0	4248	test io-34.7 {Tcl_Seek to offset from end of file, then to current position} {
sl@0	4249	file delete $path(test1)
sl@0	4250	set f1 [open $path(test1) w]
sl@0	4251	fconfigure $f1 -translation lf -eofchar {}
sl@0	4252	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4253	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4254	close $f1
sl@0	4255	set f1 [open $path(test1) r]
sl@0	4256	seek $f1 -10 end
sl@0	4257	set c1 [tell $f1]
sl@0	4258	set r1 [read $f1 5]
sl@0	4259	seek $f1 0 current
sl@0	4260	set c2 [tell $f1]
sl@0	4261	close $f1
sl@0	4262	list $c1 $r1 $c2
sl@0	4263	} {44 rstuv 49}
sl@0	4264	test io-34.8 {Tcl_Seek on pipes: not supported} {stdio openpipe} {
sl@0	4265	set f1 [open "\|[list [interpreter]]" r+]
sl@0	4266	set x [list [catch {seek $f1 0 current} msg] $msg]
sl@0	4267	close $f1
sl@0	4268	regsub {".*":} $x {"":} x
sl@0	4269	string tolower $x
sl@0	4270	} {1 {error during seek on "": invalid argument}}
sl@0	4271	test io-34.9 {Tcl_Seek, testing buffered input flushing} {
sl@0	4272	file delete $path(test3)
sl@0	4273	set f [open $path(test3) w]
sl@0	4274	fconfigure $f -eofchar {}
sl@0	4275	puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
sl@0	4276	close $f
sl@0	4277	set f [open $path(test3) RDWR]
sl@0	4278	set x [read $f 1]
sl@0	4279	seek $f 3
sl@0	4280	lappend x [read $f 1]
sl@0	4281	seek $f 0 start
sl@0	4282	lappend x [read $f 1]
sl@0	4283	seek $f 10 current
sl@0	4284	lappend x [read $f 1]
sl@0	4285	seek $f -2 end
sl@0	4286	lappend x [read $f 1]
sl@0	4287	seek $f 50 end
sl@0	4288	lappend x [read $f 1]
sl@0	4289	seek $f 1
sl@0	4290	lappend x [read $f 1]
sl@0	4291	close $f
sl@0	4292	set x
sl@0	4293	} {a d a l Y {} b}
sl@0	4294
sl@0	4295	set path(test3) [makeFile {} test3]
sl@0	4296
sl@0	4297	test io-34.10 {Tcl_Seek testing flushing of buffered input} {
sl@0	4298	set f [open $path(test3) w]
sl@0	4299	fconfigure $f -translation lf
sl@0	4300	puts $f xyz\n123
sl@0	4301	close $f
sl@0	4302	set f [open $path(test3) r+]
sl@0	4303	fconfigure $f -translation lf
sl@0	4304	set x [gets $f]
sl@0	4305	seek $f 0 current
sl@0	4306	puts $f 456
sl@0	4307	close $f
sl@0	4308	list $x [viewFile test3]
sl@0	4309	} "xyz {xyz
sl@0	4310	456}"
sl@0	4311	test io-34.11 {Tcl_Seek testing flushing of buffered output} {
sl@0	4312	set f [open $path(test3) w]
sl@0	4313	puts $f xyz\n123
sl@0	4314	close $f
sl@0	4315	set f [open $path(test3) w+]
sl@0	4316	puts $f xyzzy
sl@0	4317	seek $f 2
sl@0	4318	set x [gets $f]
sl@0	4319	close $f
sl@0	4320	list $x [viewFile test3]
sl@0	4321	} "zzy xyzzy"
sl@0	4322	test io-34.12 {Tcl_Seek testing combination of write, seek back and read} {
sl@0	4323	set f [open $path(test3) w]
sl@0	4324	fconfigure $f -translation lf -eofchar {}
sl@0	4325	puts $f xyz\n123
sl@0	4326	close $f
sl@0	4327	set f [open $path(test3) a+]
sl@0	4328	fconfigure $f -translation lf -eofchar {}
sl@0	4329	puts $f xyzzy
sl@0	4330	flush $f
sl@0	4331	set x [tell $f]
sl@0	4332	seek $f -4 cur
sl@0	4333	set y [gets $f]
sl@0	4334	close $f
sl@0	4335	list $x [viewFile test3] $y
sl@0	4336	} {14 {xyz
sl@0	4337	123
sl@0	4338	xyzzy} zzy}
sl@0	4339	test io-34.13 {Tcl_Tell at start of file} {
sl@0	4340	file delete $path(test1)
sl@0	4341	set f1 [open $path(test1) w]
sl@0	4342	set p [tell $f1]
sl@0	4343	close $f1
sl@0	4344	set p
sl@0	4345	} 0
sl@0	4346	test io-34.14 {Tcl_Tell after seek to end of file} {
sl@0	4347	file delete $path(test1)
sl@0	4348	set f1 [open $path(test1) w]
sl@0	4349	fconfigure $f1 -translation lf -eofchar {}
sl@0	4350	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4351	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4352	close $f1
sl@0	4353	set f1 [open $path(test1) r]
sl@0	4354	seek $f1 0 end
sl@0	4355	set c1 [tell $f1]
sl@0	4356	close $f1
sl@0	4357	set c1
sl@0	4358	} 54
sl@0	4359	test io-34.15 {Tcl_Tell combined with seeking} {
sl@0	4360	file delete $path(test1)
sl@0	4361	set f1 [open $path(test1) w]
sl@0	4362	fconfigure $f1 -translation lf -eofchar {}
sl@0	4363	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4364	puts $f1 "abcdefghijklmnopqrstuvwxyz"
sl@0	4365	close $f1
sl@0	4366	set f1 [open $path(test1) r]
sl@0	4367	seek $f1 10 start
sl@0	4368	set c1 [tell $f1]
sl@0	4369	seek $f1 10 current
sl@0	4370	set c2 [tell $f1]
sl@0	4371	close $f1
sl@0	4372	list $c1 $c2
sl@0	4373	} {10 20}
sl@0	4374	test io-34.16 {Tcl_tell on pipe: always -1} {stdio openpipe} {
sl@0	4375	set f1 [open "\|[list [interpreter]]" r+]
sl@0	4376	set c [tell $f1]
sl@0	4377	close $f1
sl@0	4378	set c
sl@0	4379	} -1
sl@0	4380	test io-34.17 {Tcl_Tell on pipe: always -1} {stdio openpipe} {
sl@0	4381	set f1 [open "\|[list [interpreter]]" r+]
sl@0	4382	puts $f1 {puts hello}
sl@0	4383	flush $f1
sl@0	4384	set c [tell $f1]
sl@0	4385	gets $f1
sl@0	4386	close $f1
sl@0	4387	set c
sl@0	4388	} -1
sl@0	4389	test io-34.18 {Tcl_Tell combined with seeking and reading} {
sl@0	4390	file delete $path(test2)
sl@0	4391	set f [open $path(test2) w]
sl@0	4392	fconfigure $f -translation lf -eofchar {}
sl@0	4393	puts -nonewline $f "line1\nline2\nline3\nline4\nline5\n"
sl@0	4394	close $f
sl@0	4395	set f [open $path(test2)]
sl@0	4396	fconfigure $f -translation lf
sl@0	4397	set x [tell $f]
sl@0	4398	read $f 3
sl@0	4399	lappend x [tell $f]
sl@0	4400	seek $f 2
sl@0	4401	lappend x [tell $f]
sl@0	4402	seek $f 10 current
sl@0	4403	lappend x [tell $f]
sl@0	4404	seek $f 0 end
sl@0	4405	lappend x [tell $f]
sl@0	4406	close $f
sl@0	4407	set x
sl@0	4408	} {0 3 2 12 30}
sl@0	4409	test io-34.19 {Tcl_Tell combined with opening in append mode} {
sl@0	4410	set f [open $path(test3) w]
sl@0	4411	fconfigure $f -translation lf -eofchar {}
sl@0	4412	puts $f "abcdefghijklmnopqrstuvwxyz"
sl@0	4413	puts $f "abcdefghijklmnopqrstuvwxyz"
sl@0	4414	close $f
sl@0	4415	set f [open $path(test3) a]
sl@0	4416	set c [tell $f]
sl@0	4417	close $f
sl@0	4418	set c
sl@0	4419	} 54
sl@0	4420	test io-34.20 {Tcl_Tell combined with writing} {
sl@0	4421	set f [open $path(test3) w]
sl@0	4422	set l ""
sl@0	4423	seek $f 29 start
sl@0	4424	lappend l [tell $f]
sl@0	4425	puts -nonewline $f a
sl@0	4426	seek $f 39 start
sl@0	4427	lappend l [tell $f]
sl@0	4428	puts -nonewline $f a
sl@0	4429	lappend l [tell $f]
sl@0	4430	seek $f 407 end
sl@0	4431	lappend l [tell $f]
sl@0	4432	close $f
sl@0	4433	set l
sl@0	4434	} {29 39 40 447}
sl@0	4435	test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
sl@0	4436	file delete $path(test3)
sl@0	4437	set f [open $path(test3) w]
sl@0	4438	fconfigure $f -encoding binary
sl@0	4439	set l ""
sl@0	4440	lappend l [tell $f]
sl@0	4441	puts -nonewline $f abcdef
sl@0	4442	lappend l [tell $f]
sl@0	4443	flush $f
sl@0	4444	lappend l [tell $f]
sl@0	4445	# 4GB offset!
sl@0	4446	seek $f 0x100000000
sl@0	4447	lappend l [tell $f]
sl@0	4448	puts -nonewline $f abcdef
sl@0	4449	lappend l [tell $f]
sl@0	4450	close $f
sl@0	4451	lappend l [file size $f]
sl@0	4452	# truncate...
sl@0	4453	close [open $path(test3) w]
sl@0	4454	lappend l [file size $f]
sl@0	4455	set l
sl@0	4456	} {0 6 6 4294967296 4294967302 4294967302 0}
sl@0	4457
sl@0	4458	# Test Tcl_Eof
sl@0	4459
sl@0	4460	test io-35.1 {Tcl_Eof} {
sl@0	4461	file delete $path(test1)
sl@0	4462	set f [open $path(test1) w]
sl@0	4463	puts $f hello
sl@0	4464	puts $f hello
sl@0	4465	close $f
sl@0	4466	set f [open $path(test1)]
sl@0	4467	set x [eof $f]
sl@0	4468	lappend x [eof $f]
sl@0	4469	gets $f
sl@0	4470	lappend x [eof $f]
sl@0	4471	gets $f
sl@0	4472	lappend x [eof $f]
sl@0	4473	gets $f
sl@0	4474	lappend x [eof $f]
sl@0	4475	lappend x [eof $f]
sl@0	4476	close $f
sl@0	4477	set x
sl@0	4478	} {0 0 0 0 1 1}
sl@0	4479	test io-35.2 {Tcl_Eof with pipe} {stdio openpipe} {
sl@0	4480	file delete $path(pipe)
sl@0	4481	set f1 [open $path(pipe) w]
sl@0	4482	puts $f1 {gets stdin}
sl@0	4483	puts $f1 {puts hello}
sl@0	4484	close $f1
sl@0	4485	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	4486	puts $f1 hello
sl@0	4487	set x [eof $f1]
sl@0	4488	flush $f1
sl@0	4489	lappend x [eof $f1]
sl@0	4490	gets $f1
sl@0	4491	lappend x [eof $f1]
sl@0	4492	gets $f1
sl@0	4493	lappend x [eof $f1]
sl@0	4494	close $f1
sl@0	4495	set x
sl@0	4496	} {0 0 0 1}
sl@0	4497	test io-35.3 {Tcl_Eof with pipe} {stdio openpipe} {
sl@0	4498	file delete $path(pipe)
sl@0	4499	set f1 [open $path(pipe) w]
sl@0	4500	puts $f1 {gets stdin}
sl@0	4501	puts $f1 {puts hello}
sl@0	4502	close $f1
sl@0	4503	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	4504	puts $f1 hello
sl@0	4505	set x [eof $f1]
sl@0	4506	flush $f1
sl@0	4507	lappend x [eof $f1]
sl@0	4508	gets $f1
sl@0	4509	lappend x [eof $f1]
sl@0	4510	gets $f1
sl@0	4511	lappend x [eof $f1]
sl@0	4512	gets $f1
sl@0	4513	lappend x [eof $f1]
sl@0	4514	gets $f1
sl@0	4515	lappend x [eof $f1]
sl@0	4516	close $f1
sl@0	4517	set x
sl@0	4518	} {0 0 0 1 1 1}
sl@0	4519	test io-35.4 {Tcl_Eof, eof detection on nonblocking file} {nonBlockFiles} {
sl@0	4520	file delete $path(test1)
sl@0	4521	set f [open $path(test1) w]
sl@0	4522	close $f
sl@0	4523	set f [open $path(test1) r]
sl@0	4524	fconfigure $f -blocking off
sl@0	4525	set l ""
sl@0	4526	lappend l [gets $f]
sl@0	4527	lappend l [eof $f]
sl@0	4528	close $f
sl@0	4529	set l
sl@0	4530	} {{} 1}
sl@0	4531	test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} {stdio openpipe} {
sl@0	4532	file delete $path(pipe)
sl@0	4533	set f [open $path(pipe) w]
sl@0	4534	puts $f {
sl@0	4535	exit
sl@0	4536	}
sl@0	4537	close $f
sl@0	4538	set f [open "\|[list [interpreter] $path(pipe)]" r]
sl@0	4539	set l ""
sl@0	4540	lappend l [gets $f]
sl@0	4541	lappend l [eof $f]
sl@0	4542	close $f
sl@0	4543	set l
sl@0	4544	} {{} 1}
sl@0	4545	test io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
sl@0	4546	file delete $path(test1)
sl@0	4547	set f [open $path(test1) w]
sl@0	4548	fconfigure $f -translation lf -eofchar \x1a
sl@0	4549	puts $f abc\ndef
sl@0	4550	close $f
sl@0	4551	set s [file size $path(test1)]
sl@0	4552	set f [open $path(test1) r]
sl@0	4553	fconfigure $f -translation auto -eofchar \x1a
sl@0	4554	set l [string length [read $f]]
sl@0	4555	set e [eof $f]
sl@0	4556	close $f
sl@0	4557	list $s $l $e
sl@0	4558	} {9 8 1}
sl@0	4559	test io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
sl@0	4560	file delete $path(test1)
sl@0	4561	set f [open $path(test1) w]
sl@0	4562	fconfigure $f -translation lf -eofchar \x1a
sl@0	4563	puts $f abc\ndef
sl@0	4564	close $f
sl@0	4565	set s [file size $path(test1)]
sl@0	4566	set f [open $path(test1) r]
sl@0	4567	fconfigure $f -translation lf -eofchar \x1a
sl@0	4568	set l [string length [read $f]]
sl@0	4569	set e [eof $f]
sl@0	4570	close $f
sl@0	4571	list $s $l $e
sl@0	4572	} {9 8 1}
sl@0	4573	test io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
sl@0	4574	file delete $path(test1)
sl@0	4575	set f [open $path(test1) w]
sl@0	4576	fconfigure $f -translation cr -eofchar \x1a
sl@0	4577	puts $f abc\ndef
sl@0	4578	close $f
sl@0	4579	set s [file size $path(test1)]
sl@0	4580	set f [open $path(test1) r]
sl@0	4581	fconfigure $f -translation auto -eofchar \x1a
sl@0	4582	set l [string length [read $f]]
sl@0	4583	set e [eof $f]
sl@0	4584	close $f
sl@0	4585	list $s $l $e
sl@0	4586	} {9 8 1}
sl@0	4587	test io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
sl@0	4588	file delete $path(test1)
sl@0	4589	set f [open $path(test1) w]
sl@0	4590	fconfigure $f -translation cr -eofchar \x1a
sl@0	4591	puts $f abc\ndef
sl@0	4592	close $f
sl@0	4593	set s [file size $path(test1)]
sl@0	4594	set f [open $path(test1) r]
sl@0	4595	fconfigure $f -translation cr -eofchar \x1a
sl@0	4596	set l [string length [read $f]]
sl@0	4597	set e [eof $f]
sl@0	4598	close $f
sl@0	4599	list $s $l $e
sl@0	4600	} {9 8 1}
sl@0	4601	test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
sl@0	4602	file delete $path(test1)
sl@0	4603	set f [open $path(test1) w]
sl@0	4604	fconfigure $f -translation crlf -eofchar \x1a
sl@0	4605	puts $f abc\ndef
sl@0	4606	close $f
sl@0	4607	set s [file size $path(test1)]
sl@0	4608	set f [open $path(test1) r]
sl@0	4609	fconfigure $f -translation auto -eofchar \x1a
sl@0	4610	set l [string length [read $f]]
sl@0	4611	set e [eof $f]
sl@0	4612	close $f
sl@0	4613	list $s $l $e
sl@0	4614	} {11 8 1}
sl@0	4615	test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
sl@0	4616	file delete $path(test1)
sl@0	4617	set f [open $path(test1) w]
sl@0	4618	fconfigure $f -translation crlf -eofchar \x1a
sl@0	4619	puts $f abc\ndef
sl@0	4620	close $f
sl@0	4621	set s [file size $path(test1)]
sl@0	4622	set f [open $path(test1) r]
sl@0	4623	fconfigure $f -translation crlf -eofchar \x1a
sl@0	4624	set l [string length [read $f]]
sl@0	4625	set e [eof $f]
sl@0	4626	close $f
sl@0	4627	list $s $l $e
sl@0	4628	} {11 8 1}
sl@0	4629	test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
sl@0	4630	file delete $path(test1)
sl@0	4631	set f [open $path(test1) w]
sl@0	4632	fconfigure $f -translation lf -eofchar {}
sl@0	4633	set i [format abc\ndef\n%cqrs\nuvw 26]
sl@0	4634	puts $f $i
sl@0	4635	close $f
sl@0	4636	set c [file size $path(test1)]
sl@0	4637	set f [open $path(test1) r]
sl@0	4638	fconfigure $f -translation auto -eofchar \x1a
sl@0	4639	set l [string length [read $f]]
sl@0	4640	set e [eof $f]
sl@0	4641	close $f
sl@0	4642	list $c $l $e
sl@0	4643	} {17 8 1}
sl@0	4644	test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
sl@0	4645	file delete $path(test1)
sl@0	4646	set f [open $path(test1) w]
sl@0	4647	fconfigure $f -translation lf -eofchar {}
sl@0	4648	set i [format abc\ndef\n%cqrs\nuvw 26]
sl@0	4649	puts $f $i
sl@0	4650	close $f
sl@0	4651	set c [file size $path(test1)]
sl@0	4652	set f [open $path(test1) r]
sl@0	4653	fconfigure $f -translation lf -eofchar \x1a
sl@0	4654	set l [string length [read $f]]
sl@0	4655	set e [eof $f]
sl@0	4656	close $f
sl@0	4657	list $c $l $e
sl@0	4658	} {17 8 1}
sl@0	4659	test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
sl@0	4660	file delete $path(test1)
sl@0	4661	set f [open $path(test1) w]
sl@0	4662	fconfigure $f -translation cr -eofchar {}
sl@0	4663	set i [format abc\ndef\n%cqrs\nuvw 26]
sl@0	4664	puts $f $i
sl@0	4665	close $f
sl@0	4666	set c [file size $path(test1)]
sl@0	4667	set f [open $path(test1) r]
sl@0	4668	fconfigure $f -translation auto -eofchar \x1a
sl@0	4669	set l [string length [read $f]]
sl@0	4670	set e [eof $f]
sl@0	4671	close $f
sl@0	4672	list $c $l $e
sl@0	4673	} {17 8 1}
sl@0	4674	test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
sl@0	4675	file delete $path(test1)
sl@0	4676	set f [open $path(test1) w]
sl@0	4677	fconfigure $f -translation cr -eofchar {}
sl@0	4678	set i [format abc\ndef\n%cqrs\nuvw 26]
sl@0	4679	puts $f $i
sl@0	4680	close $f
sl@0	4681	set c [file size $path(test1)]
sl@0	4682	set f [open $path(test1) r]
sl@0	4683	fconfigure $f -translation cr -eofchar \x1a
sl@0	4684	set l [string length [read $f]]
sl@0	4685	set e [eof $f]
sl@0	4686	close $f
sl@0	4687	list $c $l $e
sl@0	4688	} {17 8 1}
sl@0	4689	test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
sl@0	4690	file delete $path(test1)
sl@0	4691	set f [open $path(test1) w]
sl@0	4692	fconfigure $f -translation crlf -eofchar {}
sl@0	4693	set i [format abc\ndef\n%cqrs\nuvw 26]
sl@0	4694	puts $f $i
sl@0	4695	close $f
sl@0	4696	set c [file size $path(test1)]
sl@0	4697	set f [open $path(test1) r]
sl@0	4698	fconfigure $f -translation auto -eofchar \x1a
sl@0	4699	set l [string length [read $f]]
sl@0	4700	set e [eof $f]
sl@0	4701	close $f
sl@0	4702	list $c $l $e
sl@0	4703	} {21 8 1}
sl@0	4704	test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
sl@0	4705	file delete $path(test1)
sl@0	4706	set f [open $path(test1) w]
sl@0	4707	fconfigure $f -translation crlf -eofchar {}
sl@0	4708	set i [format abc\ndef\n%cqrs\nuvw 26]
sl@0	4709	puts $f $i
sl@0	4710	close $f
sl@0	4711	set c [file size $path(test1)]
sl@0	4712	set f [open $path(test1) r]
sl@0	4713	fconfigure $f -translation crlf -eofchar \x1a
sl@0	4714	set l [string length [read $f]]
sl@0	4715	set e [eof $f]
sl@0	4716	close $f
sl@0	4717	list $c $l $e
sl@0	4718	} {21 8 1}
sl@0	4719
sl@0	4720	# Test Tcl_InputBlocked
sl@0	4721
sl@0	4722	test io-36.1 {Tcl_InputBlocked on nonblocking pipe} {stdio openpipe} {
sl@0	4723	set f1 [open "\|[list [interpreter]]" r+]
sl@0	4724	puts $f1 {puts hello_from_pipe}
sl@0	4725	flush $f1
sl@0	4726	gets $f1
sl@0	4727	fconfigure $f1 -blocking off -buffering full
sl@0	4728	puts $f1 {puts hello}
sl@0	4729	set x ""
sl@0	4730	lappend x [gets $f1]
sl@0	4731	lappend x [fblocked $f1]
sl@0	4732	flush $f1
sl@0	4733	after 200
sl@0	4734	lappend x [gets $f1]
sl@0	4735	lappend x [fblocked $f1]
sl@0	4736	lappend x [gets $f1]
sl@0	4737	lappend x [fblocked $f1]
sl@0	4738	close $f1
sl@0	4739	set x
sl@0	4740	} {{} 1 hello 0 {} 1}
sl@0	4741	test io-36.2 {Tcl_InputBlocked on blocking pipe} {stdio openpipe} {
sl@0	4742	set f1 [open "\|[list [interpreter]]" r+]
sl@0	4743	fconfigure $f1 -buffering line
sl@0	4744	puts $f1 {puts hello_from_pipe}
sl@0	4745	set x ""
sl@0	4746	lappend x [gets $f1]
sl@0	4747	lappend x [fblocked $f1]
sl@0	4748	puts $f1 {exit}
sl@0	4749	lappend x [gets $f1]
sl@0	4750	lappend x [fblocked $f1]
sl@0	4751	lappend x [eof $f1]
sl@0	4752	close $f1
sl@0	4753	set x
sl@0	4754	} {hello_from_pipe 0 {} 0 1}
sl@0	4755	test io-36.3 {Tcl_InputBlocked vs files, short read} {
sl@0	4756	file delete $path(test1)
sl@0	4757	set f [open $path(test1) w]
sl@0	4758	puts $f abcdefghijklmnop
sl@0	4759	close $f
sl@0	4760	set f [open $path(test1) r]
sl@0	4761	set l ""
sl@0	4762	lappend l [fblocked $f]
sl@0	4763	lappend l [read $f 3]
sl@0	4764	lappend l [fblocked $f]
sl@0	4765	lappend l [read -nonewline $f]
sl@0	4766	lappend l [fblocked $f]
sl@0	4767	lappend l [eof $f]
sl@0	4768	close $f
sl@0	4769	set l
sl@0	4770	} {0 abc 0 defghijklmnop 0 1}
sl@0	4771	test io-36.4 {Tcl_InputBlocked vs files, event driven read} {fileevent} {
sl@0	4772	proc in {f} {
sl@0	4773	variable l
sl@0	4774	variable x
sl@0	4775	lappend l [read $f 3]
sl@0	4776	if {[eof $f]} {lappend l eof; close $f; set x done}
sl@0	4777	}
sl@0	4778	file delete $path(test1)
sl@0	4779	set f [open $path(test1) w]
sl@0	4780	puts $f abcdefghijklmnop
sl@0	4781	close $f
sl@0	4782	set f [open $path(test1) r]
sl@0	4783	set l ""
sl@0	4784	fileevent $f readable [namespace code [list in $f]]
sl@0	4785	variable x
sl@0	4786	vwait [namespace which -variable x]
sl@0	4787	set l
sl@0	4788	} {abc def ghi jkl mno {p
sl@0	4789	} eof}
sl@0	4790	test io-36.5 {Tcl_InputBlocked vs files, short read, nonblocking} {nonBlockFiles} {
sl@0	4791	file delete $path(test1)
sl@0	4792	set f [open $path(test1) w]
sl@0	4793	puts $f abcdefghijklmnop
sl@0	4794	close $f
sl@0	4795	set f [open $path(test1) r]
sl@0	4796	fconfigure $f -blocking off
sl@0	4797	set l ""
sl@0	4798	lappend l [fblocked $f]
sl@0	4799	lappend l [read $f 3]
sl@0	4800	lappend l [fblocked $f]
sl@0	4801	lappend l [read -nonewline $f]
sl@0	4802	lappend l [fblocked $f]
sl@0	4803	lappend l [eof $f]
sl@0	4804	close $f
sl@0	4805	set l
sl@0	4806	} {0 abc 0 defghijklmnop 0 1}
sl@0	4807	test io-36.6 {Tcl_InputBlocked vs files, event driven read} {nonBlockFiles fileevent} {
sl@0	4808	proc in {f} {
sl@0	4809	variable l
sl@0	4810	variable x
sl@0	4811	lappend l [read $f 3]
sl@0	4812	if {[eof $f]} {lappend l eof; close $f; set x done}
sl@0	4813	}
sl@0	4814	file delete $path(test1)
sl@0	4815	set f [open $path(test1) w]
sl@0	4816	puts $f abcdefghijklmnop
sl@0	4817	close $f
sl@0	4818	set f [open $path(test1) r]
sl@0	4819	fconfigure $f -blocking off
sl@0	4820	set l ""
sl@0	4821	fileevent $f readable [namespace code [list in $f]]
sl@0	4822	variable x
sl@0	4823	vwait [namespace which -variable x]
sl@0	4824	set l
sl@0	4825	} {abc def ghi jkl mno {p
sl@0	4826	} eof}
sl@0	4827
sl@0	4828	# Test Tcl_InputBuffered
sl@0	4829
sl@0	4830	test io-37.1 {Tcl_InputBuffered} {testchannel} {
sl@0	4831	set f [open $path(longfile) r]
sl@0	4832	fconfigure $f -buffersize 4096
sl@0	4833	read $f 3
sl@0	4834	set l ""
sl@0	4835	lappend l [testchannel inputbuffered $f]
sl@0	4836	lappend l [tell $f]
sl@0	4837	close $f
sl@0	4838	set l
sl@0	4839	} {4093 3}
sl@0	4840	test io-37.2 {Tcl_InputBuffered, test input flushing on seek} {testchannel} {
sl@0	4841	set f [open $path(longfile) r]
sl@0	4842	fconfigure $f -buffersize 4096
sl@0	4843	read $f 3
sl@0	4844	set l ""
sl@0	4845	lappend l [testchannel inputbuffered $f]
sl@0	4846	lappend l [tell $f]
sl@0	4847	seek $f 0 current
sl@0	4848	lappend l [testchannel inputbuffered $f]
sl@0	4849	lappend l [tell $f]
sl@0	4850	close $f
sl@0	4851	set l
sl@0	4852	} {4093 3 0 3}
sl@0	4853
sl@0	4854	# Test Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize
sl@0	4855
sl@0	4856	test io-38.1 {Tcl_GetChannelBufferSize, default buffer size} {
sl@0	4857	set f [open $path(longfile) r]
sl@0	4858	set s [fconfigure $f -buffersize]
sl@0	4859	close $f
sl@0	4860	set s
sl@0	4861	} 4096
sl@0	4862	test io-38.2 {Tcl_SetChannelBufferSize, Tcl_GetChannelBufferSize} {
sl@0	4863	set f [open $path(longfile) r]
sl@0	4864	set l ""
sl@0	4865	lappend l [fconfigure $f -buffersize]
sl@0	4866	fconfigure $f -buffersize 10000
sl@0	4867	lappend l [fconfigure $f -buffersize]
sl@0	4868	fconfigure $f -buffersize 1
sl@0	4869	lappend l [fconfigure $f -buffersize]
sl@0	4870	fconfigure $f -buffersize -1
sl@0	4871	lappend l [fconfigure $f -buffersize]
sl@0	4872	fconfigure $f -buffersize 0
sl@0	4873	lappend l [fconfigure $f -buffersize]
sl@0	4874	fconfigure $f -buffersize 100000
sl@0	4875	lappend l [fconfigure $f -buffersize]
sl@0	4876	fconfigure $f -buffersize 10000000
sl@0	4877	lappend l [fconfigure $f -buffersize]
sl@0	4878	close $f
sl@0	4879	set l
sl@0	4880	} {4096 10000 1 1 1 100000 100000}
sl@0	4881
sl@0	4882	test io-38.3 {Tcl_SetChannelBufferSize, changing buffersize between reads} {
sl@0	4883	# This test crashes the interp if Bug #427196 is not fixed
sl@0	4884
sl@0	4885	set chan [open [info script] r]
sl@0	4886	fconfigure $chan -buffersize 10
sl@0	4887	set var [read $chan 2]
sl@0	4888	fconfigure $chan -buffersize 32
sl@0	4889	append var [read $chan]
sl@0	4890	close $chan
sl@0	4891	} {}
sl@0	4892
sl@0	4893	# Test Tcl_SetChannelOption, Tcl_GetChannelOption
sl@0	4894
sl@0	4895	test io-39.1 {Tcl_GetChannelOption} {
sl@0	4896	file delete $path(test1)
sl@0	4897	set f1 [open $path(test1) w]
sl@0	4898	set x [fconfigure $f1 -blocking]
sl@0	4899	close $f1
sl@0	4900	set x
sl@0	4901	} 1
sl@0	4902	#
sl@0	4903	# Test 17.2 was removed.
sl@0	4904	#
sl@0	4905	test io-39.2 {Tcl_GetChannelOption} {
sl@0	4906	file delete $path(test1)
sl@0	4907	set f1 [open $path(test1) w]
sl@0	4908	set x [fconfigure $f1 -buffering]
sl@0	4909	close $f1
sl@0	4910	set x
sl@0	4911	} full
sl@0	4912	test io-39.3 {Tcl_GetChannelOption} {
sl@0	4913	file delete $path(test1)
sl@0	4914	set f1 [open $path(test1) w]
sl@0	4915	fconfigure $f1 -buffering line
sl@0	4916	set x [fconfigure $f1 -buffering]
sl@0	4917	close $f1
sl@0	4918	set x
sl@0	4919	} line
sl@0	4920	test io-39.4 {Tcl_GetChannelOption, Tcl_SetChannelOption} {
sl@0	4921	file delete $path(test1)
sl@0	4922	set f1 [open $path(test1) w]
sl@0	4923	set l ""
sl@0	4924	lappend l [fconfigure $f1 -buffering]
sl@0	4925	fconfigure $f1 -buffering line
sl@0	4926	lappend l [fconfigure $f1 -buffering]
sl@0	4927	fconfigure $f1 -buffering none
sl@0	4928	lappend l [fconfigure $f1 -buffering]
sl@0	4929	fconfigure $f1 -buffering line
sl@0	4930	lappend l [fconfigure $f1 -buffering]
sl@0	4931	fconfigure $f1 -buffering full
sl@0	4932	lappend l [fconfigure $f1 -buffering]
sl@0	4933	close $f1
sl@0	4934	set l
sl@0	4935	} {full line none line full}
sl@0	4936	test io-39.5 {Tcl_GetChannelOption, invariance} {
sl@0	4937	file delete $path(test1)
sl@0	4938	set f1 [open $path(test1) w]
sl@0	4939	set l ""
sl@0	4940	lappend l [fconfigure $f1 -buffering]
sl@0	4941	lappend l [list [catch {fconfigure $f1 -buffering green} msg] $msg]
sl@0	4942	lappend l [fconfigure $f1 -buffering]
sl@0	4943	close $f1
sl@0	4944	set l
sl@0	4945	} {full {1 {bad value for -buffering: must be one of full, line, or none}} full}
sl@0	4946	test io-39.6 {Tcl_SetChannelOption, multiple options} {
sl@0	4947	file delete $path(test1)
sl@0	4948	set f1 [open $path(test1) w]
sl@0	4949	fconfigure $f1 -translation lf -buffering line
sl@0	4950	puts $f1 hello
sl@0	4951	puts $f1 bye
sl@0	4952	set x [file size $path(test1)]
sl@0	4953	close $f1
sl@0	4954	set x
sl@0	4955	} 10
sl@0	4956	test io-39.7 {Tcl_SetChannelOption, buffering, translation} {
sl@0	4957	file delete $path(test1)
sl@0	4958	set f1 [open $path(test1) w]
sl@0	4959	fconfigure $f1 -translation lf
sl@0	4960	puts $f1 hello
sl@0	4961	puts $f1 bye
sl@0	4962	set x ""
sl@0	4963	fconfigure $f1 -buffering line
sl@0	4964	lappend x [file size $path(test1)]
sl@0	4965	puts $f1 really_bye
sl@0	4966	lappend x [file size $path(test1)]
sl@0	4967	close $f1
sl@0	4968	set x
sl@0	4969	} {0 21}
sl@0	4970	test io-39.8 {Tcl_SetChannelOption, different buffering options} {
sl@0	4971	file delete $path(test1)
sl@0	4972	set f1 [open $path(test1) w]
sl@0	4973	set l ""
sl@0	4974	fconfigure $f1 -translation lf -buffering none -eofchar {}
sl@0	4975	puts -nonewline $f1 hello
sl@0	4976	lappend l [file size $path(test1)]
sl@0	4977	puts -nonewline $f1 hello
sl@0	4978	lappend l [file size $path(test1)]
sl@0	4979	fconfigure $f1 -buffering full
sl@0	4980	puts -nonewline $f1 hello
sl@0	4981	lappend l [file size $path(test1)]
sl@0	4982	fconfigure $f1 -buffering none
sl@0	4983	lappend l [file size $path(test1)]
sl@0	4984	puts -nonewline $f1 hello
sl@0	4985	lappend l [file size $path(test1)]
sl@0	4986	close $f1
sl@0	4987	lappend l [file size $path(test1)]
sl@0	4988	set l
sl@0	4989	} {5 10 10 10 20 20}
sl@0	4990	test io-39.9 {Tcl_SetChannelOption, blocking mode} {nonBlockFiles} {
sl@0	4991	file delete $path(test1)
sl@0	4992	set f1 [open $path(test1) w]
sl@0	4993	close $f1
sl@0	4994	set f1 [open $path(test1) r]
sl@0	4995	set x ""
sl@0	4996	lappend x [fconfigure $f1 -blocking]
sl@0	4997	fconfigure $f1 -blocking off
sl@0	4998	lappend x [fconfigure $f1 -blocking]
sl@0	4999	lappend x [gets $f1]
sl@0	5000	lappend x [read $f1 1000]
sl@0	5001	lappend x [fblocked $f1]
sl@0	5002	lappend x [eof $f1]
sl@0	5003	close $f1
sl@0	5004	set x
sl@0	5005	} {1 0 {} {} 0 1}
sl@0	5006	test io-39.10 {Tcl_SetChannelOption, blocking mode} {stdio openpipe} {
sl@0	5007	file delete $path(pipe)
sl@0	5008	set f1 [open $path(pipe) w]
sl@0	5009	puts $f1 {
sl@0	5010	gets stdin
sl@0	5011	after 100
sl@0	5012	puts hi
sl@0	5013	gets stdin
sl@0	5014	}
sl@0	5015	close $f1
sl@0	5016	set x ""
sl@0	5017	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	5018	fconfigure $f1 -blocking off -buffering line
sl@0	5019	lappend x [fconfigure $f1 -blocking]
sl@0	5020	lappend x [gets $f1]
sl@0	5021	lappend x [fblocked $f1]
sl@0	5022	fconfigure $f1 -blocking on
sl@0	5023	puts $f1 hello
sl@0	5024	fconfigure $f1 -blocking off
sl@0	5025	lappend x [gets $f1]
sl@0	5026	lappend x [fblocked $f1]
sl@0	5027	fconfigure $f1 -blocking on
sl@0	5028	puts $f1 bye
sl@0	5029	fconfigure $f1 -blocking off
sl@0	5030	lappend x [gets $f1]
sl@0	5031	lappend x [fblocked $f1]
sl@0	5032	fconfigure $f1 -blocking on
sl@0	5033	lappend x [fconfigure $f1 -blocking]
sl@0	5034	lappend x [gets $f1]
sl@0	5035	lappend x [fblocked $f1]
sl@0	5036	lappend x [eof $f1]
sl@0	5037	lappend x [gets $f1]
sl@0	5038	lappend x [eof $f1]
sl@0	5039	close $f1
sl@0	5040	set x
sl@0	5041	} {0 {} 1 {} 1 {} 1 1 hi 0 0 {} 1}
sl@0	5042	test io-39.11 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
sl@0	5043	file delete $path(test1)
sl@0	5044	set f [open $path(test1) w]
sl@0	5045	fconfigure $f -buffersize -10
sl@0	5046	set x [fconfigure $f -buffersize]
sl@0	5047	close $f
sl@0	5048	set x
sl@0	5049	} 4096
sl@0	5050	test io-39.12 {Tcl_SetChannelOption, Tcl_GetChannelOption buffer size} {
sl@0	5051	file delete $path(test1)
sl@0	5052	set f [open $path(test1) w]
sl@0	5053	fconfigure $f -buffersize 10000000
sl@0	5054	set x [fconfigure $f -buffersize]
sl@0	5055	close $f
sl@0	5056	set x
sl@0	5057	} 4096
sl@0	5058	test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
sl@0	5059	file delete $path(test1)
sl@0	5060	set f [open $path(test1) w]
sl@0	5061	fconfigure $f -buffersize 40000
sl@0	5062	set x [fconfigure $f -buffersize]
sl@0	5063	close $f
sl@0	5064	set x
sl@0	5065	} 40000
sl@0	5066	test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
sl@0	5067	file delete $path(test1)
sl@0	5068	set f [open $path(test1) w]
sl@0	5069	fconfigure $f -encoding {}
sl@0	5070	puts -nonewline $f \xe7\x89\xa6
sl@0	5071	close $f
sl@0	5072	set f [open $path(test1) r]
sl@0	5073	fconfigure $f -encoding utf-8
sl@0	5074	set x [read $f]
sl@0	5075	close $f
sl@0	5076	set x
sl@0	5077	} \u7266
sl@0	5078	test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
sl@0	5079	file delete $path(test1)
sl@0	5080	set f [open $path(test1) w]
sl@0	5081	fconfigure $f -encoding binary
sl@0	5082	puts -nonewline $f \xe7\x89\xa6
sl@0	5083	close $f
sl@0	5084	set f [open $path(test1) r]
sl@0	5085	fconfigure $f -encoding utf-8
sl@0	5086	set x [read $f]
sl@0	5087	close $f
sl@0	5088	set x
sl@0	5089	} \u7266
sl@0	5090	test io-39.16 {Tcl_SetChannelOption: -encoding, errors} {
sl@0	5091	file delete $path(test1)
sl@0	5092	set f [open $path(test1) w]
sl@0	5093	set result [list [catch {fconfigure $f -encoding foobar} msg] $msg]
sl@0	5094	close $f
sl@0	5095	set result
sl@0	5096	} {1 {unknown encoding "foobar"}}
sl@0	5097	test io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_DATA} {stdio openpipe fileevent} {
sl@0	5098	set f [open "\|[list [interpreter] $path(cat)]" r+]
sl@0	5099	fconfigure $f -encoding binary
sl@0	5100	puts -nonewline $f "\xe7"
sl@0	5101	flush $f
sl@0	5102	fconfigure $f -encoding utf-8 -blocking 0
sl@0	5103	variable x {}
sl@0	5104	fileevent $f readable [namespace code { lappend x [read $f] }]
sl@0	5105	vwait [namespace which -variable x]
sl@0	5106	after 300 [namespace code { lappend x timeout }]
sl@0	5107	vwait [namespace which -variable x]
sl@0	5108	fconfigure $f -encoding utf-8
sl@0	5109	vwait [namespace which -variable x]
sl@0	5110	after 300 [namespace code { lappend x timeout }]
sl@0	5111	vwait [namespace which -variable x]
sl@0	5112	fconfigure $f -encoding binary
sl@0	5113	vwait [namespace which -variable x]
sl@0	5114	after 300 [namespace code { lappend x timeout }]
sl@0	5115	vwait [namespace which -variable x]
sl@0	5116	close $f
sl@0	5117	set x
sl@0	5118	} "{} timeout {} timeout \xe7 timeout"
sl@0	5119
sl@0	5120	test io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
sl@0	5121	{socket} {
sl@0	5122	proc accept {s a p} {close $s}
sl@0	5123	set s1 [socket -server [namespace code accept] 0]
sl@0	5124	set port [lindex [fconfigure $s1 -sockname] 2]
sl@0	5125	set s2 [socket 127.0.0.1 $port]
sl@0	5126	update
sl@0	5127	fconfigure $s2 -translation {auto lf}
sl@0	5128	set modes [fconfigure $s2 -translation]
sl@0	5129	close $s1
sl@0	5130	close $s2
sl@0	5131	set modes
sl@0	5132	} {auto lf}
sl@0	5133	test io-39.19 {Tcl_SetChannelOption, setting read mode independently} \
sl@0	5134	{socket} {
sl@0	5135	proc accept {s a p} {close $s}
sl@0	5136	set s1 [socket -server [namespace code accept] 0]
sl@0	5137	set port [lindex [fconfigure $s1 -sockname] 2]
sl@0	5138	set s2 [socket 127.0.0.1 $port]
sl@0	5139	update
sl@0	5140	fconfigure $s2 -translation {auto crlf}
sl@0	5141	set modes [fconfigure $s2 -translation]
sl@0	5142	close $s1
sl@0	5143	close $s2
sl@0	5144	set modes
sl@0	5145	} {auto crlf}
sl@0	5146	test io-39.20 {Tcl_SetChannelOption, setting read mode independently} \
sl@0	5147	{socket} {
sl@0	5148	proc accept {s a p} {close $s}
sl@0	5149	set s1 [socket -server [namespace code accept] 0]
sl@0	5150	set port [lindex [fconfigure $s1 -sockname] 2]
sl@0	5151	set s2 [socket 127.0.0.1 $port]
sl@0	5152	update
sl@0	5153	fconfigure $s2 -translation {auto cr}
sl@0	5154	set modes [fconfigure $s2 -translation]
sl@0	5155	close $s1
sl@0	5156	close $s2
sl@0	5157	set modes
sl@0	5158	} {auto cr}
sl@0	5159	test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
sl@0	5160	{socket} {
sl@0	5161	proc accept {s a p} {close $s}
sl@0	5162	set s1 [socket -server [namespace code accept] 0]
sl@0	5163	set port [lindex [fconfigure $s1 -sockname] 2]
sl@0	5164	set s2 [socket 127.0.0.1 $port]
sl@0	5165	update
sl@0	5166	fconfigure $s2 -translation {auto auto}
sl@0	5167	set modes [fconfigure $s2 -translation]
sl@0	5168	close $s1
sl@0	5169	close $s2
sl@0	5170	set modes
sl@0	5171	} {auto crlf}
sl@0	5172
sl@0	5173	test io-39.22 {Tcl_SetChannelOption, invariance} {unixOnly} {
sl@0	5174	file delete $path(test1)
sl@0	5175	set f1 [open $path(test1) w+]
sl@0	5176	set l ""
sl@0	5177	lappend l [fconfigure $f1 -eofchar]
sl@0	5178	fconfigure $f1 -eofchar {ON GO}
sl@0	5179	lappend l [fconfigure $f1 -eofchar]
sl@0	5180	fconfigure $f1 -eofchar D
sl@0	5181	lappend l [fconfigure $f1 -eofchar]
sl@0	5182	close $f1
sl@0	5183	set l
sl@0	5184	} {{{} {}} {O G} {D D}}
sl@0	5185
sl@0	5186	test io-39.22a {Tcl_SetChannelOption, invariance} {
sl@0	5187	file delete $path(test1)
sl@0	5188	set f1 [open $path(test1) w+]
sl@0	5189	set l [list]
sl@0	5190	fconfigure $f1 -eofchar {ON GO}
sl@0	5191	lappend l [fconfigure $f1 -eofchar]
sl@0	5192	fconfigure $f1 -eofchar D
sl@0	5193	lappend l [fconfigure $f1 -eofchar]
sl@0	5194	lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg]
sl@0	5195	close $f1
sl@0	5196	set l
sl@0	5197	} {{O G} {D D} {1 {bad value for -eofchar: should be a list of zero, one, or two elements}}}
sl@0	5198
sl@0	5199
sl@0	5200	test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
sl@0	5201	writeable, it should still have valid -eofchar and -translation options } {
sl@0	5202	set l [list]
sl@0	5203	set sock [socket -server [namespace code accept] 0]
sl@0	5204	lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
sl@0	5205	close $sock
sl@0	5206	set l
sl@0	5207	} {{{}} auto}
sl@0	5208	test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
sl@0	5209	writable so we can't change -eofchar or -translation } {
sl@0	5210	set l [list]
sl@0	5211	set sock [socket -server [namespace code accept] 0]
sl@0	5212	fconfigure $sock -eofchar D -translation lf
sl@0	5213	lappend l [fconfigure $sock -eofchar] [fconfigure $sock -translation]
sl@0	5214	close $sock
sl@0	5215	set l
sl@0	5216	} {{{}} auto}
sl@0	5217
sl@0	5218	test io-40.1 {POSIX open access modes: RDWR} {
sl@0	5219	file delete $path(test3)
sl@0	5220	set f [open $path(test3) w]
sl@0	5221	puts $f xyzzy
sl@0	5222	close $f
sl@0	5223	set f [open $path(test3) RDWR]
sl@0	5224	puts -nonewline $f "ab"
sl@0	5225	seek $f 0 current
sl@0	5226	set x [gets $f]
sl@0	5227	close $f
sl@0	5228	set f [open $path(test3) r]
sl@0	5229	lappend x [gets $f]
sl@0	5230	close $f
sl@0	5231	set x
sl@0	5232	} {zzy abzzy}
sl@0	5233	test io-40.2 {POSIX open access modes: CREAT} {unixOnly} {
sl@0	5234	file delete $path(test3)
sl@0	5235	set f [open $path(test3) {WRONLY CREAT} 0600]
sl@0	5236	file stat $path(test3) stats
sl@0	5237	set x [format "0%o" [expr $stats(mode)&0777]]
sl@0	5238	puts $f "line 1"
sl@0	5239	close $f
sl@0	5240	set f [open $path(test3) r]
sl@0	5241	lappend x [gets $f]
sl@0	5242	close $f
sl@0	5243	set x
sl@0	5244	} {0600 {line 1}}
sl@0	5245
sl@0	5246	# some tests can only be run is umask is 2
sl@0	5247	# if "umask" cannot be run, the tests will be skipped.
sl@0	5248	catch {testConstraint umask2 [expr {[exec umask] == 2}]}
sl@0	5249
sl@0	5250	test io-40.3 {POSIX open access modes: CREAT} {unixOnly umask2} {
sl@0	5251	# This test only works if your umask is 2, like ouster's.
sl@0	5252	file delete $path(test3)
sl@0	5253	set f [open $path(test3) {WRONLY CREAT}]
sl@0	5254	close $f
sl@0	5255	file stat test3 stats
sl@0	5256	format "0%o" [expr $stats(mode)&0777]
sl@0	5257	} 0664
sl@0	5258	test io-40.4 {POSIX open access modes: CREAT} {
sl@0	5259	file delete $path(test3)
sl@0	5260	set f [open $path(test3) w]
sl@0	5261	fconfigure $f -eofchar {}
sl@0	5262	puts $f xyzzy
sl@0	5263	close $f
sl@0	5264	set f [open $path(test3) {WRONLY CREAT}]
sl@0	5265	fconfigure $f -eofchar {}
sl@0	5266	puts -nonewline $f "ab"
sl@0	5267	close $f
sl@0	5268	set f [open $path(test3) r]
sl@0	5269	set x [gets $f]
sl@0	5270	close $f
sl@0	5271	set x
sl@0	5272	} abzzy
sl@0	5273	test io-40.5 {POSIX open access modes: APPEND} {
sl@0	5274	file delete $path(test3)
sl@0	5275	set f [open $path(test3) w]
sl@0	5276	fconfigure $f -translation lf -eofchar {}
sl@0	5277	puts $f xyzzy
sl@0	5278	close $f
sl@0	5279	set f [open $path(test3) {WRONLY APPEND}]
sl@0	5280	fconfigure $f -translation lf
sl@0	5281	puts $f "new line"
sl@0	5282	seek $f 0
sl@0	5283	puts $f "abc"
sl@0	5284	close $f
sl@0	5285	set f [open $path(test3) r]
sl@0	5286	fconfigure $f -translation lf
sl@0	5287	set x ""
sl@0	5288	seek $f 6 current
sl@0	5289	lappend x [gets $f]
sl@0	5290	lappend x [gets $f]
sl@0	5291	close $f
sl@0	5292	set x
sl@0	5293	} {{new line} abc}
sl@0	5294	test io-40.6 {POSIX open access modes: EXCL} -match regexp -body {
sl@0	5295	file delete $path(test3)
sl@0	5296	set f [open $path(test3) w]
sl@0	5297	puts $f xyzzy
sl@0	5298	close $f
sl@0	5299	open $path(test3) {WRONLY CREAT EXCL}
sl@0	5300	} -returnCodes error -result {(?i)couldn't open ".*test3": file (already )?exists}
sl@0	5301	test io-40.7 {POSIX open access modes: EXCL} {
sl@0	5302	file delete $path(test3)
sl@0	5303	set f [open $path(test3) {WRONLY CREAT EXCL}]
sl@0	5304	fconfigure $f -eofchar {}
sl@0	5305	puts $f "A test line"
sl@0	5306	close $f
sl@0	5307	viewFile test3
sl@0	5308	} {A test line}
sl@0	5309	test io-40.8 {POSIX open access modes: TRUNC} {
sl@0	5310	file delete $path(test3)
sl@0	5311	set f [open $path(test3) w]
sl@0	5312	puts $f xyzzy
sl@0	5313	close $f
sl@0	5314	set f [open $path(test3) {WRONLY TRUNC}]
sl@0	5315	puts $f abc
sl@0	5316	close $f
sl@0	5317	set f [open $path(test3) r]
sl@0	5318	set x [gets $f]
sl@0	5319	close $f
sl@0	5320	set x
sl@0	5321	} abc
sl@0	5322	test io-40.9 {POSIX open access modes: NONBLOCK} {nonPortable macOrUnix} {
sl@0	5323	file delete $path(test3)
sl@0	5324	set f [open $path(test3) {WRONLY NONBLOCK CREAT}]
sl@0	5325	puts $f "NONBLOCK test"
sl@0	5326	close $f
sl@0	5327	set f [open $path(test3) r]
sl@0	5328	set x [gets $f]
sl@0	5329	close $f
sl@0	5330	set x
sl@0	5331	} {NONBLOCK test}
sl@0	5332	test io-40.10 {POSIX open access modes: RDONLY} {
sl@0	5333	set f [open $path(test1) w]
sl@0	5334	puts $f "two lines: this one"
sl@0	5335	puts $f "and this"
sl@0	5336	close $f
sl@0	5337	set f [open $path(test1) RDONLY]
sl@0	5338	set x [list [gets $f] [catch {puts $f Test} msg] $msg]
sl@0	5339	close $f
sl@0	5340	string compare [string tolower $x] \
sl@0	5341	[list {two lines: this one} 1 \
sl@0	5342	[format "channel \"%s\" wasn't opened for writing" $f]]
sl@0	5343	} 0
sl@0	5344	test io-40.11 {POSIX open access modes: RDONLY} -match regexp -body {
sl@0	5345	file delete $path(test3)
sl@0	5346	open $path(test3) RDONLY
sl@0	5347	} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
sl@0	5348	test io-40.12 {POSIX open access modes: WRONLY} -match regexp -body {
sl@0	5349	file delete $path(test3)
sl@0	5350	open $path(test3) WRONLY
sl@0	5351	} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
sl@0	5352	test io-40.13 {POSIX open access modes: WRONLY} {
sl@0	5353	makeFile xyzzy test3
sl@0	5354	set f [open $path(test3) WRONLY]
sl@0	5355	fconfigure $f -eofchar {}
sl@0	5356	puts -nonewline $f "ab"
sl@0	5357	seek $f 0 current
sl@0	5358	set x [list [catch {gets $f} msg] $msg]
sl@0	5359	close $f
sl@0	5360	lappend x [viewFile test3]
sl@0	5361	string compare [string tolower $x] \
sl@0	5362	[list 1 "channel \"$f\" wasn't opened for reading" abzzy]
sl@0	5363	} 0
sl@0	5364	test io-40.14 {POSIX open access modes: RDWR} -match regexp -body {
sl@0	5365	file delete $path(test3)
sl@0	5366	open $path(test3) RDWR
sl@0	5367	} -returnCodes error -result {(?i)couldn't open ".*test3": no such file or directory}
sl@0	5368	test io-40.15 {POSIX open access modes: RDWR} {
sl@0	5369	makeFile xyzzy test3
sl@0	5370	set f [open $path(test3) RDWR]
sl@0	5371	puts -nonewline $f "ab"
sl@0	5372	seek $f 0 current
sl@0	5373	set x [gets $f]
sl@0	5374	close $f
sl@0	5375	lappend x [viewFile test3]
sl@0	5376	} {zzy abzzy}
sl@0	5377	if {![file exists ~/_test_] && [file writable ~]} {
sl@0	5378	test io-40.16 {tilde substitution in open} -setup {
sl@0	5379	makeFile {Some text} _test_ ~
sl@0	5380	} -body {
sl@0	5381	file exists [file join $env(HOME) _test_]
sl@0	5382	} -cleanup {
sl@0	5383	removeFile _test_ ~
sl@0	5384	} -result 1
sl@0	5385	}
sl@0	5386	test io-40.17 {tilde substitution in open} {
sl@0	5387	set home $env(HOME)
sl@0	5388	unset env(HOME)
sl@0	5389	set x [list [catch {open ~/foo} msg] $msg]
sl@0	5390	set env(HOME) $home
sl@0	5391	set x
sl@0	5392	} {1 {couldn't find HOME environment variable to expand path}}
sl@0	5393
sl@0	5394	test io-41.1 {Tcl_FileeventCmd: errors} {fileevent} {
sl@0	5395	list [catch {fileevent foo} msg] $msg
sl@0	5396	} {1 {wrong # args: should be "fileevent channelId event ?script?"}}
sl@0	5397	test io-41.2 {Tcl_FileeventCmd: errors} {fileevent} {
sl@0	5398	list [catch {fileevent foo bar baz q} msg] $msg
sl@0	5399	} {1 {wrong # args: should be "fileevent channelId event ?script?"}}
sl@0	5400	test io-41.3 {Tcl_FileeventCmd: errors} {fileevent} {
sl@0	5401	list [catch {fileevent gorp readable} msg] $msg
sl@0	5402	} {1 {can not find channel named "gorp"}}
sl@0	5403	test io-41.4 {Tcl_FileeventCmd: errors} {fileevent} {
sl@0	5404	list [catch {fileevent gorp writable} msg] $msg
sl@0	5405	} {1 {can not find channel named "gorp"}}
sl@0	5406	test io-41.5 {Tcl_FileeventCmd: errors} {fileevent} {
sl@0	5407	list [catch {fileevent gorp who-knows} msg] $msg
sl@0	5408	} {1 {bad event name "who-knows": must be readable or writable}}
sl@0	5409
sl@0	5410	#
sl@0	5411	# Test fileevent on a file
sl@0	5412	#
sl@0	5413
sl@0	5414	set path(foo) [makeFile {} foo]
sl@0	5415	set f [open $path(foo) w+]
sl@0	5416
sl@0	5417	test io-42.1 {Tcl_FileeventCmd: creating, deleting, querying} {fileevent} {
sl@0	5418	list [fileevent $f readable] [fileevent $f writable]
sl@0	5419	} {{} {}}
sl@0	5420	test io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} {
sl@0	5421	set result {}
sl@0	5422	fileevent $f r "first script"
sl@0	5423	lappend result [fileevent $f readable]
sl@0	5424	fileevent $f r "new script"
sl@0	5425	lappend result [fileevent $f readable]
sl@0	5426	fileevent $f r "yet another"
sl@0	5427	lappend result [fileevent $f readable]
sl@0	5428	fileevent $f r ""
sl@0	5429	lappend result [fileevent $f readable]
sl@0	5430	} {{first script} {new script} {yet another} {}}
sl@0	5431	test io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
sl@0	5432	set result {}
sl@0	5433	fileevent $f r "first scr\0ipt"
sl@0	5434	lappend result [string length [fileevent $f readable]]
sl@0	5435	fileevent $f r "new scr\0ipt"
sl@0	5436	lappend result [string length [fileevent $f readable]]
sl@0	5437	fileevent $f r "yet ano\0ther"
sl@0	5438	lappend result [string length [fileevent $f readable]]
sl@0	5439	fileevent $f r ""
sl@0	5440	lappend result [fileevent $f readable]
sl@0	5441	} {13 11 12 {}}
sl@0	5442
sl@0	5443	test io-43.1 {Tcl_FileeventCmd: creating, deleting, querying} {stdio unixExecs fileevent} {
sl@0	5444	set result {}
sl@0	5445	fileevent $f readable "script 1"
sl@0	5446	lappend result [fileevent $f readable] [fileevent $f writable]
sl@0	5447	fileevent $f writable "write script"
sl@0	5448	lappend result [fileevent $f readable] [fileevent $f writable]
sl@0	5449	fileevent $f readable {}
sl@0	5450	lappend result [fileevent $f readable] [fileevent $f writable]
sl@0	5451	fileevent $f writable {}
sl@0	5452	lappend result [fileevent $f readable] [fileevent $f writable]
sl@0	5453	} {{script 1} {} {script 1} {write script} {} {write script} {} {}}
sl@0	5454	test io-43.2 {Tcl_FileeventCmd: deleting when many present} -setup {
sl@0	5455	set f2 [open "\|[list cat -u]" r+]
sl@0	5456	set f3 [open "\|[list cat -u]" r+]
sl@0	5457	} -constraints {stdio unixExecs fileevent openpipe} -body {
sl@0	5458	set result {}
sl@0	5459	lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
sl@0	5460	fileevent $f r "read f"
sl@0	5461	fileevent $f2 r "read f2"
sl@0	5462	fileevent $f3 r "read f3"
sl@0	5463	lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
sl@0	5464	fileevent $f2 r {}
sl@0	5465	lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
sl@0	5466	fileevent $f3 r {}
sl@0	5467	lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
sl@0	5468	fileevent $f r {}
sl@0	5469	lappend result [fileevent $f r] [fileevent $f2 r] [fileevent $f3 r]
sl@0	5470	} -cleanup {
sl@0	5471	catch {close $f2}
sl@0	5472	catch {close $f3}
sl@0	5473	} -result {{} {} {} {read f} {read f2} {read f3} {read f} {} {read f3} {read f} {} {} {} {} {}}
sl@0	5474
sl@0	5475	test io-44.1 {FileEventProc procedure: normal read event} -setup {
sl@0	5476	set f2 [open "\|[list cat -u]" r+]
sl@0	5477	set f3 [open "\|[list cat -u]" r+]
sl@0	5478	} -constraints {stdio unixExecs fileevent openpipe} -body {
sl@0	5479	fileevent $f2 readable [namespace code {
sl@0	5480	set x [gets $f2]; fileevent $f2 readable {}
sl@0	5481	}]
sl@0	5482	puts $f2 text; flush $f2
sl@0	5483	variable x initial
sl@0	5484	vwait [namespace which -variable x]
sl@0	5485	set x
sl@0	5486	} -cleanup {
sl@0	5487	catch {close $f2}
sl@0	5488	catch {close $f3}
sl@0	5489	} -result {text}
sl@0	5490	test io-44.2 {FileEventProc procedure: error in read event} -setup {
sl@0	5491	set f2 [open "\|[list cat -u]" r+]
sl@0	5492	set f3 [open "\|[list cat -u]" r+]
sl@0	5493	} -constraints {stdio unixExecs fileevent openpipe} -body {
sl@0	5494	proc ::bgerror args "set [namespace which -variable x] \$args"
sl@0	5495	fileevent $f2 readable {error bogus}
sl@0	5496	puts $f2 text; flush $f2
sl@0	5497	variable x initial
sl@0	5498	vwait [namespace which -variable x]
sl@0	5499	rename ::bgerror {}
sl@0	5500	list $x [fileevent $f2 readable]
sl@0	5501	} -cleanup {
sl@0	5502	catch {close $f2}
sl@0	5503	catch {close $f3}
sl@0	5504	} -result {bogus {}}
sl@0	5505	test io-44.3 {FileEventProc procedure: normal write event} -setup {
sl@0	5506	set f2 [open "\|[list cat -u]" r+]
sl@0	5507	set f3 [open "\|[list cat -u]" r+]
sl@0	5508	} -constraints {stdio unixExecs fileevent openpipe} -body {
sl@0	5509	fileevent $f2 writable [namespace code {
sl@0	5510	lappend x "triggered"
sl@0	5511	incr count -1
sl@0	5512	if {$count <= 0} {
sl@0	5513	fileevent $f2 writable {}
sl@0	5514	}
sl@0	5515	}]
sl@0	5516	variable x initial
sl@0	5517	set count 3
sl@0	5518	vwait [namespace which -variable x]
sl@0	5519	vwait [namespace which -variable x]
sl@0	5520	vwait [namespace which -variable x]
sl@0	5521	set x
sl@0	5522	} -cleanup {
sl@0	5523	catch {close $f2}
sl@0	5524	catch {close $f3}
sl@0	5525	} -result {initial triggered triggered triggered}
sl@0	5526	test io-44.4 {FileEventProc procedure: eror in write event} -setup {
sl@0	5527	set f2 [open "\|[list cat -u]" r+]
sl@0	5528	set f3 [open "\|[list cat -u]" r+]
sl@0	5529	} -constraints {stdio unixExecs fileevent openpipe} -body {
sl@0	5530	proc ::bgerror args "set [namespace which -variable x] \$args"
sl@0	5531	fileevent $f2 writable {error bad-write}
sl@0	5532	variable x initial
sl@0	5533	vwait [namespace which -variable x]
sl@0	5534	rename ::bgerror {}
sl@0	5535	list $x [fileevent $f2 writable]
sl@0	5536	} -cleanup {
sl@0	5537	catch {close $f2}
sl@0	5538	catch {close $f3}
sl@0	5539	} -result {bad-write {}}
sl@0	5540	test io-44.5 {FileEventProc procedure: end of file} {stdio unixExecs openpipe fileevent} {
sl@0	5541	set f4 [open "\|[list [interpreter] $path(cat) << foo]" r]
sl@0	5542	fileevent $f4 readable [namespace code {
sl@0	5543	if {[gets $f4 line] < 0} {
sl@0	5544	lappend x eof
sl@0	5545	fileevent $f4 readable {}
sl@0	5546	} else {
sl@0	5547	lappend x $line
sl@0	5548	}
sl@0	5549	}]
sl@0	5550	variable x initial
sl@0	5551	vwait [namespace which -variable x]
sl@0	5552	vwait [namespace which -variable x]
sl@0	5553	close $f4
sl@0	5554	set x
sl@0	5555	} {initial foo eof}
sl@0	5556
sl@0	5557
sl@0	5558	close $f
sl@0	5559	makeFile "foo bar" foo
sl@0	5560	test io-45.1 {DeleteFileEvent, cleanup on close} {fileevent} {
sl@0	5561	set f [open $path(foo) r]
sl@0	5562	fileevent $f readable [namespace code {
sl@0	5563	lappend x "binding triggered: \"[gets $f]\""
sl@0	5564	fileevent $f readable {}
sl@0	5565	}]
sl@0	5566	close $f
sl@0	5567	set x initial
sl@0	5568	after 100 [namespace code { set y done }]
sl@0	5569	variable y
sl@0	5570	vwait [namespace which -variable y]
sl@0	5571	set x
sl@0	5572	} {initial}
sl@0	5573	test io-45.2 {DeleteFileEvent, cleanup on close} {fileevent} {
sl@0	5574	set f [open $path(foo) r]
sl@0	5575	set f2 [open $path(foo) r]
sl@0	5576	fileevent $f readable [namespace code {
sl@0	5577	lappend x "f triggered: \"[gets $f]\""
sl@0	5578	fileevent $f readable {}
sl@0	5579	}]
sl@0	5580	fileevent $f2 readable [namespace code {
sl@0	5581	lappend x "f2 triggered: \"[gets $f2]\""
sl@0	5582	fileevent $f2 readable {}
sl@0	5583	}]
sl@0	5584	close $f
sl@0	5585	variable x initial
sl@0	5586	vwait [namespace which -variable x]
sl@0	5587	close $f2
sl@0	5588	set x
sl@0	5589	} {initial {f2 triggered: "foo bar"}}
sl@0	5590	test io-45.3 {DeleteFileEvent, cleanup on close} {fileevent} {
sl@0	5591	set f [open $path(foo) r]
sl@0	5592	set f2 [open $path(foo) r]
sl@0	5593	set f3 [open $path(foo) r]
sl@0	5594	fileevent $f readable {f script}
sl@0	5595	fileevent $f2 readable {f2 script}
sl@0	5596	fileevent $f3 readable {f3 script}
sl@0	5597	set x {}
sl@0	5598	close $f2
sl@0	5599	lappend x [catch {fileevent $f readable} msg] $msg \
sl@0	5600	[catch {fileevent $f2 readable}] \
sl@0	5601	[catch {fileevent $f3 readable} msg] $msg
sl@0	5602	close $f3
sl@0	5603	lappend x [catch {fileevent $f readable} msg] $msg \
sl@0	5604	[catch {fileevent $f2 readable}] \
sl@0	5605	[catch {fileevent $f3 readable}]
sl@0	5606	close $f
sl@0	5607	lappend x [catch {fileevent $f readable}] \
sl@0	5608	[catch {fileevent $f2 readable}] \
sl@0	5609	[catch {fileevent $f3 readable}]
sl@0	5610	} {0 {f script} 1 0 {f3 script} 0 {f script} 1 1 1 1 1}
sl@0	5611
sl@0	5612	# Execute these tests only if the "testfevent" command is present.
sl@0	5613	testConstraint testfevent [llength [info commands testfevent]]
sl@0	5614
sl@0	5615	test io-46.1 {Tcl event loop vs multiple interpreters} {testfevent fileevent} {
sl@0	5616	testfevent create
sl@0	5617	set script "set f \[[list open $path(foo) r]]\n"
sl@0	5618	append script {
sl@0	5619	set x "no event"
sl@0	5620	fileevent $f readable [namespace code {
sl@0	5621	set x "f triggered: [gets $f]"
sl@0	5622	fileevent $f readable {}
sl@0	5623	}]
sl@0	5624	}
sl@0	5625	testfevent cmd $script
sl@0	5626	after 1 ;# We must delay because Windows takes a little time to notice
sl@0	5627	update
sl@0	5628	testfevent cmd {close $f}
sl@0	5629	list [testfevent cmd {set x}] [testfevent cmd {info commands after}]
sl@0	5630	} {{f triggered: foo bar} after}
sl@0	5631	test io-46.2 {Tcl event loop vs multiple interpreters} testfevent {
sl@0	5632	testfevent create
sl@0	5633	testfevent cmd {
sl@0	5634	variable x 0
sl@0	5635	after 100 {set x triggered}
sl@0	5636	vwait [namespace which -variable x]
sl@0	5637	set x
sl@0	5638	}
sl@0	5639	} {triggered}
sl@0	5640	test io-46.3 {Tcl event loop vs multiple interpreters} testfevent {
sl@0	5641	testfevent create
sl@0	5642	testfevent cmd {
sl@0	5643	set x 0
sl@0	5644	after 10 {lappend x timer}
sl@0	5645	after 30
sl@0	5646	set result $x
sl@0	5647	update idletasks
sl@0	5648	lappend result $x
sl@0	5649	update
sl@0	5650	lappend result $x
sl@0	5651	}
sl@0	5652	} {0 0 {0 timer}}
sl@0	5653
sl@0	5654	test io-47.1 {fileevent vs multiple interpreters} {testfevent fileevent} {
sl@0	5655	set f [open $path(foo) r]
sl@0	5656	set f2 [open $path(foo) r]
sl@0	5657	set f3 [open $path(foo) r]
sl@0	5658	fileevent $f readable {script 1}
sl@0	5659	testfevent create
sl@0	5660	testfevent share $f2
sl@0	5661	testfevent cmd "fileevent $f2 readable {script 2}"
sl@0	5662	fileevent $f3 readable {sript 3}
sl@0	5663	set x {}
sl@0	5664	lappend x [fileevent $f2 readable]
sl@0	5665	testfevent delete
sl@0	5666	lappend x [fileevent $f readable] [fileevent $f2 readable] \
sl@0	5667	[fileevent $f3 readable]
sl@0	5668	close $f
sl@0	5669	close $f2
sl@0	5670	close $f3
sl@0	5671	set x
sl@0	5672	} {{} {script 1} {} {sript 3}}
sl@0	5673	test io-47.2 {deleting fileevent on interpreter delete} {testfevent fileevent} {
sl@0	5674	set f [open $path(foo) r]
sl@0	5675	set f2 [open $path(foo) r]
sl@0	5676	set f3 [open $path(foo) r]
sl@0	5677	set f4 [open $path(foo) r]
sl@0	5678	fileevent $f readable {script 1}
sl@0	5679	testfevent create
sl@0	5680	testfevent share $f2
sl@0	5681	testfevent share $f3
sl@0	5682	testfevent cmd "fileevent $f2 readable {script 2}
sl@0	5683	fileevent $f3 readable {script 3}"
sl@0	5684	fileevent $f4 readable {script 4}
sl@0	5685	testfevent delete
sl@0	5686	set x [list [fileevent $f readable] [fileevent $f2 readable] \
sl@0	5687	[fileevent $f3 readable] [fileevent $f4 readable]]
sl@0	5688	close $f
sl@0	5689	close $f2
sl@0	5690	close $f3
sl@0	5691	close $f4
sl@0	5692	set x
sl@0	5693	} {{script 1} {} {} {script 4}}
sl@0	5694	test io-47.3 {deleting fileevent on interpreter delete} {testfevent fileevent} {
sl@0	5695	set f [open $path(foo) r]
sl@0	5696	set f2 [open $path(foo) r]
sl@0	5697	set f3 [open $path(foo) r]
sl@0	5698	set f4 [open $path(foo) r]
sl@0	5699	testfevent create
sl@0	5700	testfevent share $f3
sl@0	5701	testfevent share $f4
sl@0	5702	fileevent $f readable {script 1}
sl@0	5703	fileevent $f2 readable {script 2}
sl@0	5704	testfevent cmd "fileevent $f3 readable {script 3}
sl@0	5705	fileevent $f4 readable {script 4}"
sl@0	5706	testfevent delete
sl@0	5707	set x [list [fileevent $f readable] [fileevent $f2 readable] \
sl@0	5708	[fileevent $f3 readable] [fileevent $f4 readable]]
sl@0	5709	close $f
sl@0	5710	close $f2
sl@0	5711	close $f3
sl@0	5712	close $f4
sl@0	5713	set x
sl@0	5714	} {{script 1} {script 2} {} {}}
sl@0	5715	test io-47.4 {file events on shared files and multiple interpreters} {testfevent fileevent} {
sl@0	5716	set f [open $path(foo) r]
sl@0	5717	set f2 [open $path(foo) r]
sl@0	5718	testfevent create
sl@0	5719	testfevent share $f
sl@0	5720	testfevent cmd "fileevent $f readable {script 1}"
sl@0	5721	fileevent $f readable {script 2}
sl@0	5722	fileevent $f2 readable {script 3}
sl@0	5723	set x [list [fileevent $f2 readable] \
sl@0	5724	[testfevent cmd "fileevent $f readable"] \
sl@0	5725	[fileevent $f readable]]
sl@0	5726	testfevent delete
sl@0	5727	close $f
sl@0	5728	close $f2
sl@0	5729	set x
sl@0	5730	} {{script 3} {script 1} {script 2}}
sl@0	5731	test io-47.5 {file events on shared files, deleting file events} {testfevent fileevent} {
sl@0	5732	set f [open $path(foo) r]
sl@0	5733	testfevent create
sl@0	5734	testfevent share $f
sl@0	5735	testfevent cmd "fileevent $f readable {script 1}"
sl@0	5736	fileevent $f readable {script 2}
sl@0	5737	testfevent cmd "fileevent $f readable {}"
sl@0	5738	set x [list [testfevent cmd "fileevent $f readable"] \
sl@0	5739	[fileevent $f readable]]
sl@0	5740	testfevent delete
sl@0	5741	close $f
sl@0	5742	set x
sl@0	5743	} {{} {script 2}}
sl@0	5744	test io-47.6 {file events on shared files, deleting file events} {testfevent fileevent} {
sl@0	5745	set f [open $path(foo) r]
sl@0	5746	testfevent create
sl@0	5747	testfevent share $f
sl@0	5748	testfevent cmd "fileevent $f readable {script 1}"
sl@0	5749	fileevent $f readable {script 2}
sl@0	5750	fileevent $f readable {}
sl@0	5751	set x [list [testfevent cmd "fileevent $f readable"] \
sl@0	5752	[fileevent $f readable]]
sl@0	5753	testfevent delete
sl@0	5754	close $f
sl@0	5755	set x
sl@0	5756	} {{script 1} {}}
sl@0	5757
sl@0	5758	set path(bar) [makeFile {} bar]
sl@0	5759
sl@0	5760	test io-48.1 {testing readability conditions} {fileevent} {
sl@0	5761	set f [open $path(bar) w]
sl@0	5762	puts $f abcdefg
sl@0	5763	puts $f abcdefg
sl@0	5764	puts $f abcdefg
sl@0	5765	puts $f abcdefg
sl@0	5766	puts $f abcdefg
sl@0	5767	close $f
sl@0	5768	set f [open $path(bar) r]
sl@0	5769	fileevent $f readable [namespace code [list consume $f]]
sl@0	5770	proc consume {f} {
sl@0	5771	variable l
sl@0	5772	variable x
sl@0	5773	lappend l called
sl@0	5774	if {[eof $f]} {
sl@0	5775	close $f
sl@0	5776	set x done
sl@0	5777	} else {
sl@0	5778	gets $f
sl@0	5779	}
sl@0	5780	}
sl@0	5781	set l ""
sl@0	5782	variable x not_done
sl@0	5783	vwait [namespace which -variable x]
sl@0	5784	list $x $l
sl@0	5785	} {done {called called called called called called called}}
sl@0	5786	test io-48.2 {testing readability conditions} {nonBlockFiles fileevent} {
sl@0	5787	set f [open $path(bar) w]
sl@0	5788	puts $f abcdefg
sl@0	5789	puts $f abcdefg
sl@0	5790	puts $f abcdefg
sl@0	5791	puts $f abcdefg
sl@0	5792	puts $f abcdefg
sl@0	5793	close $f
sl@0	5794	set f [open $path(bar) r]
sl@0	5795	fileevent $f readable [namespace code [list consume $f]]
sl@0	5796	fconfigure $f -blocking off
sl@0	5797	proc consume {f} {
sl@0	5798	variable x
sl@0	5799	variable l
sl@0	5800	lappend l called
sl@0	5801	if {[eof $f]} {
sl@0	5802	close $f
sl@0	5803	set x done
sl@0	5804	} else {
sl@0	5805	gets $f
sl@0	5806	}
sl@0	5807	}
sl@0	5808	set l ""
sl@0	5809	variable x not_done
sl@0	5810	vwait [namespace which -variable x]
sl@0	5811	list $x $l
sl@0	5812	} {done {called called called called called called called}}
sl@0	5813
sl@0	5814	set path(my_script) [makeFile {} my_script]
sl@0	5815
sl@0	5816	test io-48.3 {testing readability conditions} {stdio unixOnly nonBlockFiles openpipe fileevent} {
sl@0	5817	set f [open $path(bar) w]
sl@0	5818	puts $f abcdefg
sl@0	5819	puts $f abcdefg
sl@0	5820	puts $f abcdefg
sl@0	5821	puts $f abcdefg
sl@0	5822	puts $f abcdefg
sl@0	5823	close $f
sl@0	5824	set f [open $path(my_script) w]
sl@0	5825	puts $f {
sl@0	5826	proc copy_slowly {f} {
sl@0	5827	while {![eof $f]} {
sl@0	5828	puts [gets $f]
sl@0	5829	after 200
sl@0	5830	}
sl@0	5831	close $f
sl@0	5832	}
sl@0	5833	}
sl@0	5834	close $f
sl@0	5835	set f [open "\|[list [interpreter]]" r+]
sl@0	5836	fileevent $f readable [namespace code [list consume $f]]
sl@0	5837	fconfigure $f -buffering line
sl@0	5838	fconfigure $f -blocking off
sl@0	5839	proc consume {f} {
sl@0	5840	variable l
sl@0	5841	variable x
sl@0	5842	if {[eof $f]} {
sl@0	5843	set x done
sl@0	5844	} else {
sl@0	5845	gets $f
sl@0	5846	lappend l [fblocked $f]
sl@0	5847	gets $f
sl@0	5848	lappend l [fblocked $f]
sl@0	5849	}
sl@0	5850	}
sl@0	5851	set l ""
sl@0	5852	variable x not_done
sl@0	5853	puts $f [list source $path(my_script)]
sl@0	5854	puts $f "set f \[[list open $path(bar) r]]"
sl@0	5855	puts $f {copy_slowly $f}
sl@0	5856	puts $f {exit}
sl@0	5857	vwait [namespace which -variable x]
sl@0	5858	close $f
sl@0	5859	list $x $l
sl@0	5860	} {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
sl@0	5861	test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fileevent} {
sl@0	5862	file delete $path(test1)
sl@0	5863	set f [open $path(test1) w]
sl@0	5864	fconfigure $f -translation lf
sl@0	5865	variable c [format "abc\ndef\n%c" 26]
sl@0	5866	puts -nonewline $f $c
sl@0	5867	close $f
sl@0	5868	proc consume {f} {
sl@0	5869	variable l
sl@0	5870	variable c
sl@0	5871	variable x
sl@0	5872	if {[eof $f]} {
sl@0	5873	set x done
sl@0	5874	close $f
sl@0	5875	} else {
sl@0	5876	lappend l [gets $f]
sl@0	5877	incr c
sl@0	5878	}
sl@0	5879	}
sl@0	5880	set c 0
sl@0	5881	set l ""
sl@0	5882	set f [open $path(test1) r]
sl@0	5883	fconfigure $f -translation auto -eofchar \x1a
sl@0	5884	fileevent $f readable [namespace code [list consume $f]]
sl@0	5885	variable x
sl@0	5886	vwait [namespace which -variable x]
sl@0	5887	list $c $l
sl@0	5888	} {3 {abc def {}}}
sl@0	5889	test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {fileevent} {
sl@0	5890	file delete $path(test1)
sl@0	5891	set f [open $path(test1) w]
sl@0	5892	fconfigure $f -translation lf
sl@0	5893	set c [format "abc\ndef\n%cfoo\nbar\n" 26]
sl@0	5894	puts -nonewline $f $c
sl@0	5895	close $f
sl@0	5896	proc consume {f} {
sl@0	5897	variable l
sl@0	5898	variable x
sl@0	5899	variable c
sl@0	5900	if {[eof $f]} {
sl@0	5901	set x done
sl@0	5902	close $f
sl@0	5903	} else {
sl@0	5904	lappend l [gets $f]
sl@0	5905	incr c
sl@0	5906	}
sl@0	5907	}
sl@0	5908	set c 0
sl@0	5909	set l ""
sl@0	5910	set f [open $path(test1) r]
sl@0	5911	fconfigure $f -eofchar \x1a -translation auto
sl@0	5912	fileevent $f readable [namespace code [list consume $f]]
sl@0	5913	variable x
sl@0	5914	vwait [namespace which -variable x]
sl@0	5915	list $c $l
sl@0	5916	} {3 {abc def {}}}
sl@0	5917	test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fileevent} {
sl@0	5918	file delete $path(test1)
sl@0	5919	set f [open $path(test1) w]
sl@0	5920	fconfigure $f -translation cr
sl@0	5921	set c [format "abc\ndef\n%c" 26]
sl@0	5922	puts -nonewline $f $c
sl@0	5923	close $f
sl@0	5924	proc consume {f} {
sl@0	5925	variable l
sl@0	5926	variable x
sl@0	5927	variable c
sl@0	5928	if {[eof $f]} {
sl@0	5929	set x done
sl@0	5930	close $f
sl@0	5931	} else {
sl@0	5932	lappend l [gets $f]
sl@0	5933	incr c
sl@0	5934	}
sl@0	5935	}
sl@0	5936	set c 0
sl@0	5937	set l ""
sl@0	5938	set f [open $path(test1) r]
sl@0	5939	fconfigure $f -translation auto -eofchar \x1a
sl@0	5940	fileevent $f readable [namespace code [list consume $f]]
sl@0	5941	variable x
sl@0	5942	vwait [namespace which -variable x]
sl@0	5943	list $c $l
sl@0	5944	} {3 {abc def {}}}
sl@0	5945	test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {fileevent} {
sl@0	5946	file delete $path(test1)
sl@0	5947	set f [open $path(test1) w]
sl@0	5948	fconfigure $f -translation cr
sl@0	5949	set c [format "abc\ndef\n%cfoo\nbar\n" 26]
sl@0	5950	puts -nonewline $f $c
sl@0	5951	close $f
sl@0	5952	proc consume {f} {
sl@0	5953	variable l
sl@0	5954	variable c
sl@0	5955	variable x
sl@0	5956	if {[eof $f]} {
sl@0	5957	set x done
sl@0	5958	close $f
sl@0	5959	} else {
sl@0	5960	lappend l [gets $f]
sl@0	5961	incr c
sl@0	5962	}
sl@0	5963	}
sl@0	5964	set c 0
sl@0	5965	set l ""
sl@0	5966	set f [open $path(test1) r]
sl@0	5967	fconfigure $f -eofchar \x1a -translation auto
sl@0	5968	fileevent $f readable [namespace code [list consume $f]]
sl@0	5969	variable x
sl@0	5970	vwait [namespace which -variable x]
sl@0	5971	list $c $l
sl@0	5972	} {3 {abc def {}}}
sl@0	5973	test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {fileevent} {
sl@0	5974	file delete $path(test1)
sl@0	5975	set f [open $path(test1) w]
sl@0	5976	fconfigure $f -translation crlf
sl@0	5977	set c [format "abc\ndef\n%c" 26]
sl@0	5978	puts -nonewline $f $c
sl@0	5979	close $f
sl@0	5980	proc consume {f} {
sl@0	5981	variable l
sl@0	5982	variable x
sl@0	5983	variable c
sl@0	5984	if {[eof $f]} {
sl@0	5985	set x done
sl@0	5986	close $f
sl@0	5987	} else {
sl@0	5988	lappend l [gets $f]
sl@0	5989	incr c
sl@0	5990	}
sl@0	5991	}
sl@0	5992	set c 0
sl@0	5993	set l ""
sl@0	5994	set f [open $path(test1) r]
sl@0	5995	fconfigure $f -translation auto -eofchar \x1a
sl@0	5996	fileevent $f readable [namespace code [list consume $f]]
sl@0	5997	variable x
sl@0	5998	vwait [namespace which -variable x]
sl@0	5999	list $c $l
sl@0	6000	} {3 {abc def {}}}
sl@0	6001	test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fileevent} {
sl@0	6002	file delete $path(test1)
sl@0	6003	set f [open $path(test1) w]
sl@0	6004	fconfigure $f -translation crlf
sl@0	6005	set c [format "abc\ndef\n%cfoo\nbar\n" 26]
sl@0	6006	puts -nonewline $f $c
sl@0	6007	close $f
sl@0	6008	proc consume {f} {
sl@0	6009	variable l
sl@0	6010	variable c
sl@0	6011	variable x
sl@0	6012	if {[eof $f]} {
sl@0	6013	set x done
sl@0	6014	close $f
sl@0	6015	} else {
sl@0	6016	lappend l [gets $f]
sl@0	6017	incr c
sl@0	6018	}
sl@0	6019	}
sl@0	6020	set c 0
sl@0	6021	set l ""
sl@0	6022	set f [open $path(test1) r]
sl@0	6023	fconfigure $f -eofchar \x1a -translation auto
sl@0	6024	fileevent $f readable [namespace code [list consume $f]]
sl@0	6025	variable x
sl@0	6026	vwait [namespace which -variable x]
sl@0	6027	list $c $l
sl@0	6028	} {3 {abc def {}}}
sl@0	6029	test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {fileevent} {
sl@0	6030	file delete $path(test1)
sl@0	6031	set f [open $path(test1) w]
sl@0	6032	fconfigure $f -translation lf
sl@0	6033	set c [format "abc\ndef\n%cfoo\nbar\n" 26]
sl@0	6034	puts -nonewline $f $c
sl@0	6035	close $f
sl@0	6036	proc consume {f} {
sl@0	6037	variable l
sl@0	6038	variable c
sl@0	6039	variable x
sl@0	6040	if {[eof $f]} {
sl@0	6041	set x done
sl@0	6042	close $f
sl@0	6043	} else {
sl@0	6044	lappend l [gets $f]
sl@0	6045	incr c
sl@0	6046	}
sl@0	6047	}
sl@0	6048	set c 0
sl@0	6049	set l ""
sl@0	6050	set f [open $path(test1) r]
sl@0	6051	fconfigure $f -eofchar \x1a -translation lf
sl@0	6052	fileevent $f readable [namespace code [list consume $f]]
sl@0	6053	variable x
sl@0	6054	vwait [namespace which -variable x]
sl@0	6055	list $c $l
sl@0	6056	} {3 {abc def {}}}
sl@0	6057	test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fileevent} {
sl@0	6058	file delete $path(test1)
sl@0	6059	set f [open $path(test1) w]
sl@0	6060	fconfigure $f -translation lf
sl@0	6061	set c [format "abc\ndef\n%c" 26]
sl@0	6062	puts -nonewline $f $c
sl@0	6063	close $f
sl@0	6064	proc consume {f} {
sl@0	6065	variable l
sl@0	6066	variable x
sl@0	6067	variable c
sl@0	6068	if {[eof $f]} {
sl@0	6069	set x done
sl@0	6070	close $f
sl@0	6071	} else {
sl@0	6072	lappend l [gets $f]
sl@0	6073	incr c
sl@0	6074	}
sl@0	6075	}
sl@0	6076	set c 0
sl@0	6077	set l ""
sl@0	6078	set f [open $path(test1) r]
sl@0	6079	fconfigure $f -translation lf -eofchar \x1a
sl@0	6080	fileevent $f readable [namespace code [list consume $f]]
sl@0	6081	variable x
sl@0	6082	vwait [namespace which -variable x]
sl@0	6083	list $c $l
sl@0	6084	} {3 {abc def {}}}
sl@0	6085	test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {fileevent} {
sl@0	6086	file delete $path(test1)
sl@0	6087	set f [open $path(test1) w]
sl@0	6088	fconfigure $f -translation cr
sl@0	6089	set c [format "abc\ndef\n%cfoo\nbar\n" 26]
sl@0	6090	puts -nonewline $f $c
sl@0	6091	close $f
sl@0	6092	proc consume {f} {
sl@0	6093	variable l
sl@0	6094	variable x
sl@0	6095	variable c
sl@0	6096	if {[eof $f]} {
sl@0	6097	set x done
sl@0	6098	close $f
sl@0	6099	} else {
sl@0	6100	lappend l [gets $f]
sl@0	6101	incr c
sl@0	6102	}
sl@0	6103	}
sl@0	6104	set c 0
sl@0	6105	set l ""
sl@0	6106	set f [open $path(test1) r]
sl@0	6107	fconfigure $f -eofchar \x1a -translation cr
sl@0	6108	fileevent $f readable [namespace code [list consume $f]]
sl@0	6109	variable x
sl@0	6110	vwait [namespace which -variable x]
sl@0	6111	list $c $l
sl@0	6112	} {3 {abc def {}}}
sl@0	6113	test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fileevent} {
sl@0	6114	file delete $path(test1)
sl@0	6115	set f [open $path(test1) w]
sl@0	6116	fconfigure $f -translation cr
sl@0	6117	set c [format "abc\ndef\n%c" 26]
sl@0	6118	puts -nonewline $f $c
sl@0	6119	close $f
sl@0	6120	proc consume {f} {
sl@0	6121	variable c
sl@0	6122	variable x
sl@0	6123	variable l
sl@0	6124	if {[eof $f]} {
sl@0	6125	set x done
sl@0	6126	close $f
sl@0	6127	} else {
sl@0	6128	lappend l [gets $f]
sl@0	6129	incr c
sl@0	6130	}
sl@0	6131	}
sl@0	6132	set c 0
sl@0	6133	set l ""
sl@0	6134	set f [open $path(test1) r]
sl@0	6135	fconfigure $f -translation cr -eofchar \x1a
sl@0	6136	fileevent $f readable [namespace code [list consume $f]]
sl@0	6137	variable x
sl@0	6138	vwait [namespace which -variable x]
sl@0	6139	list $c $l
sl@0	6140	} {3 {abc def {}}}
sl@0	6141	test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {fileevent} {
sl@0	6142	file delete $path(test1)
sl@0	6143	set f [open $path(test1) w]
sl@0	6144	fconfigure $f -translation crlf
sl@0	6145	set c [format "abc\ndef\n%cfoo\nbar\n" 26]
sl@0	6146	puts -nonewline $f $c
sl@0	6147	close $f
sl@0	6148	proc consume {f} {
sl@0	6149	variable c
sl@0	6150	variable x
sl@0	6151	variable l
sl@0	6152	if {[eof $f]} {
sl@0	6153	set x done
sl@0	6154	close $f
sl@0	6155	} else {
sl@0	6156	lappend l [gets $f]
sl@0	6157	incr c
sl@0	6158	}
sl@0	6159	}
sl@0	6160	set c 0
sl@0	6161	set l ""
sl@0	6162	set f [open $path(test1) r]
sl@0	6163	fconfigure $f -eofchar \x1a -translation crlf
sl@0	6164	fileevent $f readable [namespace code [list consume $f]]
sl@0	6165	variable x
sl@0	6166	vwait [namespace which -variable x]
sl@0	6167	list $c $l
sl@0	6168	} {3 {abc def {}}}
sl@0	6169	test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {fileevent} {
sl@0	6170	file delete $path(test1)
sl@0	6171	set f [open $path(test1) w]
sl@0	6172	fconfigure $f -translation crlf
sl@0	6173	set c [format "abc\ndef\n%c" 26]
sl@0	6174	puts -nonewline $f $c
sl@0	6175	close $f
sl@0	6176	proc consume {f} {
sl@0	6177	variable c
sl@0	6178	variable x
sl@0	6179	variable l
sl@0	6180	if {[eof $f]} {
sl@0	6181	set x done
sl@0	6182	close $f
sl@0	6183	} else {
sl@0	6184	lappend l [gets $f]
sl@0	6185	incr c
sl@0	6186	}
sl@0	6187	}
sl@0	6188	set c 0
sl@0	6189	set l ""
sl@0	6190	set f [open $path(test1) r]
sl@0	6191	fconfigure $f -translation crlf -eofchar \x1a
sl@0	6192	fileevent $f readable [namespace code [list consume $f]]
sl@0	6193	variable x
sl@0	6194	vwait [namespace which -variable x]
sl@0	6195	list $c $l
sl@0	6196	} {3 {abc def {}}}
sl@0	6197
sl@0	6198	test io-49.1 {testing crlf reading, leftover cr disgorgment} {
sl@0	6199	file delete $path(test1)
sl@0	6200	set f [open $path(test1) w]
sl@0	6201	fconfigure $f -translation lf
sl@0	6202	puts -nonewline $f "a\rb\rc\r\n"
sl@0	6203	close $f
sl@0	6204	set f [open $path(test1) r]
sl@0	6205	set l ""
sl@0	6206	lappend l [file size $path(test1)]
sl@0	6207	fconfigure $f -translation crlf
sl@0	6208	lappend l [read $f 1]
sl@0	6209	lappend l [tell $f]
sl@0	6210	lappend l [read $f 1]
sl@0	6211	lappend l [tell $f]
sl@0	6212	lappend l [read $f 1]
sl@0	6213	lappend l [tell $f]
sl@0	6214	lappend l [read $f 1]
sl@0	6215	lappend l [tell $f]
sl@0	6216	lappend l [read $f 1]
sl@0	6217	lappend l [tell $f]
sl@0	6218	lappend l [read $f 1]
sl@0	6219	lappend l [tell $f]
sl@0	6220	lappend l [eof $f]
sl@0	6221	lappend l [read $f 1]
sl@0	6222	lappend l [eof $f]
sl@0	6223	close $f
sl@0	6224	set l
sl@0	6225	} "7 a 1 [list \r] 2 b 3 [list \r] 4 c 5 {
sl@0	6226	} 7 0 {} 1"
sl@0	6227	test io-49.2 {testing crlf reading, leftover cr disgorgment} {
sl@0	6228	file delete $path(test1)
sl@0	6229	set f [open $path(test1) w]
sl@0	6230	fconfigure $f -translation lf
sl@0	6231	puts -nonewline $f "a\rb\rc\r\n"
sl@0	6232	close $f
sl@0	6233	set f [open $path(test1) r]
sl@0	6234	set l ""
sl@0	6235	lappend l [file size $path(test1)]
sl@0	6236	fconfigure $f -translation crlf
sl@0	6237	lappend l [read $f 2]
sl@0	6238	lappend l [tell $f]
sl@0	6239	lappend l [read $f 2]
sl@0	6240	lappend l [tell $f]
sl@0	6241	lappend l [read $f 2]
sl@0	6242	lappend l [tell $f]
sl@0	6243	lappend l [eof $f]
sl@0	6244	lappend l [read $f 2]
sl@0	6245	lappend l [tell $f]
sl@0	6246	lappend l [eof $f]
sl@0	6247	close $f
sl@0	6248	set l
sl@0	6249	} "7 [list a\r] 2 [list b\r] 4 [list c\n] 7 0 {} 7 1"
sl@0	6250	test io-49.3 {testing crlf reading, leftover cr disgorgment} {
sl@0	6251	file delete $path(test1)
sl@0	6252	set f [open $path(test1) w]
sl@0	6253	fconfigure $f -translation lf
sl@0	6254	puts -nonewline $f "a\rb\rc\r\n"
sl@0	6255	close $f
sl@0	6256	set f [open $path(test1) r]
sl@0	6257	set l ""
sl@0	6258	lappend l [file size $path(test1)]
sl@0	6259	fconfigure $f -translation crlf
sl@0	6260	lappend l [read $f 3]
sl@0	6261	lappend l [tell $f]
sl@0	6262	lappend l [read $f 3]
sl@0	6263	lappend l [tell $f]
sl@0	6264	lappend l [eof $f]
sl@0	6265	lappend l [read $f 3]
sl@0	6266	lappend l [tell $f]
sl@0	6267	lappend l [eof $f]
sl@0	6268	close $f
sl@0	6269	set l
sl@0	6270	} "7 [list a\rb] 3 [list \rc\n] 7 0 {} 7 1"
sl@0	6271	test io-49.4 {testing crlf reading, leftover cr disgorgment} {
sl@0	6272	file delete $path(test1)
sl@0	6273	set f [open $path(test1) w]
sl@0	6274	fconfigure $f -translation lf
sl@0	6275	puts -nonewline $f "a\rb\rc\r\n"
sl@0	6276	close $f
sl@0	6277	set f [open $path(test1) r]
sl@0	6278	set l ""
sl@0	6279	lappend l [file size $path(test1)]
sl@0	6280	fconfigure $f -translation crlf
sl@0	6281	lappend l [read $f 3]
sl@0	6282	lappend l [tell $f]
sl@0	6283	lappend l [gets $f]
sl@0	6284	lappend l [tell $f]
sl@0	6285	lappend l [eof $f]
sl@0	6286	lappend l [gets $f]
sl@0	6287	lappend l [tell $f]
sl@0	6288	lappend l [eof $f]
sl@0	6289	close $f
sl@0	6290	set l
sl@0	6291	} "7 [list a\rb] 3 [list \rc] 7 0 {} 7 1"
sl@0	6292	test io-49.5 {testing crlf reading, leftover cr disgorgment} {
sl@0	6293	file delete $path(test1)
sl@0	6294	set f [open $path(test1) w]
sl@0	6295	fconfigure $f -translation lf
sl@0	6296	puts -nonewline $f "a\rb\rc\r\n"
sl@0	6297	close $f
sl@0	6298	set f [open $path(test1) r]
sl@0	6299	set l ""
sl@0	6300	lappend l [file size $path(test1)]
sl@0	6301	fconfigure $f -translation crlf
sl@0	6302	lappend l [set x [gets $f]]
sl@0	6303	lappend l [tell $f]
sl@0	6304	lappend l [gets $f]
sl@0	6305	lappend l [tell $f]
sl@0	6306	lappend l [eof $f]
sl@0	6307	close $f
sl@0	6308	set l
sl@0	6309	} [list 7 a\rb\rc 7 {} 7 1]
sl@0	6310
sl@0	6311	testConstraint testchannelevent [llength [info commands testchannelevent]]
sl@0	6312	test io-50.1 {testing handler deletion} {testchannelevent} {
sl@0	6313	file delete $path(test1)
sl@0	6314	set f [open $path(test1) w]
sl@0	6315	close $f
sl@0	6316	set f [open $path(test1) r]
sl@0	6317	testchannelevent $f add readable [namespace code [list delhandler $f]]
sl@0	6318	proc delhandler {f} {
sl@0	6319	variable z
sl@0	6320	set z called
sl@0	6321	testchannelevent $f delete 0
sl@0	6322	}
sl@0	6323	set z not_called
sl@0	6324	update
sl@0	6325	close $f
sl@0	6326	set z
sl@0	6327	} called
sl@0	6328	test io-50.2 {testing handler deletion with multiple handlers} {testchannelevent} {
sl@0	6329	file delete $path(test1)
sl@0	6330	set f [open $path(test1) w]
sl@0	6331	close $f
sl@0	6332	set f [open $path(test1) r]
sl@0	6333	testchannelevent $f add readable [namespace code [list delhandler $f 1]]
sl@0	6334	testchannelevent $f add readable [namespace code [list delhandler $f 0]]
sl@0	6335	proc delhandler {f i} {
sl@0	6336	variable z
sl@0	6337	lappend z "called delhandler $f $i"
sl@0	6338	testchannelevent $f delete 0
sl@0	6339	}
sl@0	6340	set z ""
sl@0	6341	update
sl@0	6342	close $f
sl@0	6343	string compare [string tolower $z] \
sl@0	6344	[list [list called delhandler $f 0] [list called delhandler $f 1]]
sl@0	6345	} 0
sl@0	6346	test io-50.3 {testing handler deletion with multiple handlers} {testchannelevent} {
sl@0	6347	file delete $path(test1)
sl@0	6348	set f [open $path(test1) w]
sl@0	6349	close $f
sl@0	6350	set f [open $path(test1) r]
sl@0	6351	testchannelevent $f add readable [namespace code [list notcalled $f 1]]
sl@0	6352	testchannelevent $f add readable [namespace code [list delhandler $f 0]]
sl@0	6353	set z ""
sl@0	6354	proc notcalled {f i} {
sl@0	6355	variable z
sl@0	6356	lappend z "notcalled was called!! $f $i"
sl@0	6357	}
sl@0	6358	proc delhandler {f i} {
sl@0	6359	variable z
sl@0	6360	testchannelevent $f delete 1
sl@0	6361	lappend z "delhandler $f $i called"
sl@0	6362	testchannelevent $f delete 0
sl@0	6363	lappend z "delhandler $f $i deleted myself"
sl@0	6364	}
sl@0	6365	set z ""
sl@0	6366	update
sl@0	6367	close $f
sl@0	6368	string compare [string tolower $z] \
sl@0	6369	[list [list delhandler $f 0 called] \
sl@0	6370	[list delhandler $f 0 deleted myself]]
sl@0	6371	} 0
sl@0	6372	test io-50.4 {testing handler deletion vs reentrant calls} {testchannelevent} {
sl@0	6373	file delete $path(test1)
sl@0	6374	set f [open $path(test1) w]
sl@0	6375	close $f
sl@0	6376	set f [open $path(test1) r]
sl@0	6377	testchannelevent $f add readable [namespace code [list delrecursive $f]]
sl@0	6378	proc delrecursive {f} {
sl@0	6379	variable z
sl@0	6380	variable u
sl@0	6381	if {"$u" == "recursive"} {
sl@0	6382	testchannelevent $f delete 0
sl@0	6383	lappend z "delrecursive deleting recursive"
sl@0	6384	} else {
sl@0	6385	lappend z "delrecursive calling recursive"
sl@0	6386	set u recursive
sl@0	6387	update
sl@0	6388	}
sl@0	6389	}
sl@0	6390	set u toplevel
sl@0	6391	set z ""
sl@0	6392	update
sl@0	6393	close $f
sl@0	6394	string compare [string tolower $z] \
sl@0	6395	{{delrecursive calling recursive} {delrecursive deleting recursive}}
sl@0	6396	} 0
sl@0	6397	test io-50.5 {testing handler deletion vs reentrant calls} {testchannelevent} {
sl@0	6398	file delete $path(test1)
sl@0	6399	set f [open $path(test1) w]
sl@0	6400	close $f
sl@0	6401	set f [open $path(test1) r]
sl@0	6402	testchannelevent $f add readable [namespace code [list notcalled $f]]
sl@0	6403	testchannelevent $f add readable [namespace code [list del $f]]
sl@0	6404	proc notcalled {f} {
sl@0	6405	variable z
sl@0	6406	lappend z "notcalled was called!! $f"
sl@0	6407	}
sl@0	6408	proc del {f} {
sl@0	6409	variable u
sl@0	6410	variable z
sl@0	6411	if {"$u" == "recursive"} {
sl@0	6412	testchannelevent $f delete 1
sl@0	6413	testchannelevent $f delete 0
sl@0	6414	lappend z "del deleted notcalled"
sl@0	6415	lappend z "del deleted myself"
sl@0	6416	} else {
sl@0	6417	set u recursive
sl@0	6418	lappend z "del calling recursive"
sl@0	6419	update
sl@0	6420	lappend z "del after update"
sl@0	6421	}
sl@0	6422	}
sl@0	6423	set z ""
sl@0	6424	set u toplevel
sl@0	6425	update
sl@0	6426	close $f
sl@0	6427	string compare [string tolower $z] \
sl@0	6428	[list {del calling recursive} {del deleted notcalled} \
sl@0	6429	{del deleted myself} {del after update}]
sl@0	6430	} 0
sl@0	6431	test io-50.6 {testing handler deletion vs reentrant calls} {testchannelevent} {
sl@0	6432	file delete $path(test1)
sl@0	6433	set f [open $path(test1) w]
sl@0	6434	close $f
sl@0	6435	set f [open $path(test1) r]
sl@0	6436	testchannelevent $f add readable [namespace code [list second $f]]
sl@0	6437	testchannelevent $f add readable [namespace code [list first $f]]
sl@0	6438	proc first {f} {
sl@0	6439	variable u
sl@0	6440	variable z
sl@0	6441	if {"$u" == "toplevel"} {
sl@0	6442	lappend z "first called"
sl@0	6443	set u first
sl@0	6444	update
sl@0	6445	lappend z "first after update"
sl@0	6446	} else {
sl@0	6447	lappend z "first called not toplevel"
sl@0	6448	}
sl@0	6449	}
sl@0	6450	proc second {f} {
sl@0	6451	variable u
sl@0	6452	variable z
sl@0	6453	if {"$u" == "first"} {
sl@0	6454	lappend z "second called, first time"
sl@0	6455	set u second
sl@0	6456	testchannelevent $f delete 0
sl@0	6457	} elseif {"$u" == "second"} {
sl@0	6458	lappend z "second called, second time"
sl@0	6459	testchannelevent $f delete 0
sl@0	6460	} else {
sl@0	6461	lappend z "second called, cannot happen!"
sl@0	6462	testchannelevent $f removeall
sl@0	6463	}
sl@0	6464	}
sl@0	6465	set z ""
sl@0	6466	set u toplevel
sl@0	6467	update
sl@0	6468	close $f
sl@0	6469	string compare [string tolower $z] \
sl@0	6470	[list {first called} {first called not toplevel} \
sl@0	6471	{second called, first time} {second called, second time} \
sl@0	6472	{first after update}]
sl@0	6473	} 0
sl@0	6474
sl@0	6475	test io-51.1 {Test old socket deletion on Macintosh} {socket} {
sl@0	6476	set x 0
sl@0	6477	set result ""
sl@0	6478	proc accept {s a p} {
sl@0	6479	variable x
sl@0	6480	variable wait
sl@0	6481	fconfigure $s -blocking off
sl@0	6482	puts $s "sock[incr x]"
sl@0	6483	close $s
sl@0	6484	set wait done
sl@0	6485	}
sl@0	6486	set ss [socket -server [namespace code accept] 0]
sl@0	6487	variable wait ""
sl@0	6488	set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
sl@0	6489	vwait [namespace which -variable wait]
sl@0	6490	lappend result [gets $cs]
sl@0	6491	close $cs
sl@0	6492
sl@0	6493	set wait ""
sl@0	6494	set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
sl@0	6495	vwait [namespace which -variable wait]
sl@0	6496	lappend result [gets $cs]
sl@0	6497	close $cs
sl@0	6498
sl@0	6499	set wait ""
sl@0	6500	set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
sl@0	6501	vwait [namespace which -variable wait]
sl@0	6502	lappend result [gets $cs]
sl@0	6503	close $cs
sl@0	6504
sl@0	6505	set wait ""
sl@0	6506	set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]
sl@0	6507	vwait [namespace which -variable wait]
sl@0	6508	lappend result [gets $cs]
sl@0	6509	close $cs
sl@0	6510	close $ss
sl@0	6511	set result
sl@0	6512	} {sock1 sock2 sock3 sock4}
sl@0	6513
sl@0	6514	test io-52.1 {TclCopyChannel} {fcopy} {
sl@0	6515	file delete $path(test1)
sl@0	6516	set f1 [open $thisScript]
sl@0	6517	set f2 [open $path(test1) w]
sl@0	6518	fcopy $f1 $f2 -command { # }
sl@0	6519	catch { fcopy $f1 $f2 } msg
sl@0	6520	close $f1
sl@0	6521	close $f2
sl@0	6522	string compare $msg "channel \"$f1\" is busy"
sl@0	6523	} {0}
sl@0	6524	test io-52.2 {TclCopyChannel} {fcopy} {
sl@0	6525	file delete $path(test1)
sl@0	6526	set f1 [open $thisScript]
sl@0	6527	set f2 [open $path(test1) w]
sl@0	6528	set f3 [open $thisScript]
sl@0	6529	fcopy $f1 $f2 -command { # }
sl@0	6530	catch { fcopy $f3 $f2 } msg
sl@0	6531	close $f1
sl@0	6532	close $f2
sl@0	6533	close $f3
sl@0	6534	string compare $msg "channel \"$f2\" is busy"
sl@0	6535	} {0}
sl@0	6536	test io-52.3 {TclCopyChannel} {fcopy} {
sl@0	6537	file delete $path(test1)
sl@0	6538	set f1 [open $thisScript]
sl@0	6539	set f2 [open $path(test1) w]
sl@0	6540	fconfigure $f1 -translation lf -blocking 0
sl@0	6541	fconfigure $f2 -translation cr -blocking 0
sl@0	6542	set s0 [fcopy $f1 $f2]
sl@0	6543	set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
sl@0	6544	close $f1
sl@0	6545	close $f2
sl@0	6546	set s1 [file size $thisScript]
sl@0	6547	set s2 [file size $path(test1)]
sl@0	6548	if {("$s1" == "$s2") && ($s0 == $s1)} {
sl@0	6549	lappend result ok
sl@0	6550	}
sl@0	6551	set result
sl@0	6552	} {0 0 ok}
sl@0	6553	test io-52.4 {TclCopyChannel} {fcopy} {
sl@0	6554	file delete $path(test1)
sl@0	6555	set f1 [open $thisScript]
sl@0	6556	set f2 [open $path(test1) w]
sl@0	6557	fconfigure $f1 -translation lf -blocking 0
sl@0	6558	fconfigure $f2 -translation cr -blocking 0
sl@0	6559	fcopy $f1 $f2 -size 40
sl@0	6560	set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
sl@0	6561	close $f1
sl@0	6562	close $f2
sl@0	6563	lappend result [file size $path(test1)]
sl@0	6564	} {0 0 40}
sl@0	6565	test io-52.5 {TclCopyChannel} {fcopy} {
sl@0	6566	file delete $path(test1)
sl@0	6567	set f1 [open $thisScript]
sl@0	6568	set f2 [open $path(test1) w]
sl@0	6569	fconfigure $f1 -translation lf -blocking 0
sl@0	6570	fconfigure $f2 -translation lf -blocking 0
sl@0	6571	fcopy $f1 $f2 -size -1
sl@0	6572	set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
sl@0	6573	close $f1
sl@0	6574	close $f2
sl@0	6575	set s1 [file size $thisScript]
sl@0	6576	set s2 [file size $path(test1)]
sl@0	6577	if {"$s1" == "$s2"} {
sl@0	6578	lappend result ok
sl@0	6579	}
sl@0	6580	set result
sl@0	6581	} {0 0 ok}
sl@0	6582	test io-52.6 {TclCopyChannel} {fcopy} {
sl@0	6583	file delete $path(test1)
sl@0	6584	set f1 [open $thisScript]
sl@0	6585	set f2 [open $path(test1) w]
sl@0	6586	fconfigure $f1 -translation lf -blocking 0
sl@0	6587	fconfigure $f2 -translation lf -blocking 0
sl@0	6588	set s0 [fcopy $f1 $f2 -size [expr [file size $thisScript] + 5]]
sl@0	6589	set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
sl@0	6590	close $f1
sl@0	6591	close $f2
sl@0	6592	set s1 [file size $thisScript]
sl@0	6593	set s2 [file size $path(test1)]
sl@0	6594	if {("$s1" == "$s2") && ($s0 == $s1)} {
sl@0	6595	lappend result ok
sl@0	6596	}
sl@0	6597	set result
sl@0	6598	} {0 0 ok}
sl@0	6599	test io-52.7 {TclCopyChannel} {fcopy} {
sl@0	6600	file delete $path(test1)
sl@0	6601	set f1 [open $thisScript]
sl@0	6602	set f2 [open $path(test1) w]
sl@0	6603	fconfigure $f1 -translation lf -blocking 0
sl@0	6604	fconfigure $f2 -translation lf -blocking 0
sl@0	6605	fcopy $f1 $f2
sl@0	6606	set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
sl@0	6607	set s1 [file size $thisScript]
sl@0	6608	set s2 [file size $path(test1)]
sl@0	6609	close $f1
sl@0	6610	close $f2
sl@0	6611	if {"$s1" == "$s2"} {
sl@0	6612	lappend result ok
sl@0	6613	}
sl@0	6614	set result
sl@0	6615	} {0 0 ok}
sl@0	6616	test io-52.8 {TclCopyChannel} {stdio openpipe fcopy} {
sl@0	6617	file delete $path(test1)
sl@0	6618	file delete $path(pipe)
sl@0	6619	set f1 [open $path(pipe) w]
sl@0	6620	fconfigure $f1 -translation lf
sl@0	6621	puts $f1 "
sl@0	6622	puts ready
sl@0	6623	gets stdin
sl@0	6624	set f1 \[open [list $thisScript] r\]
sl@0	6625	fconfigure \$f1 -translation lf
sl@0	6626	puts \[read \$f1 100\]
sl@0	6627	close \$f1
sl@0	6628	"
sl@0	6629	close $f1
sl@0	6630	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	6631	fconfigure $f1 -translation lf
sl@0	6632	gets $f1
sl@0	6633	puts $f1 ready
sl@0	6634	flush $f1
sl@0	6635	set f2 [open $path(test1) w]
sl@0	6636	fconfigure $f2 -translation lf
sl@0	6637	set s0 [fcopy $f1 $f2 -size 40]
sl@0	6638	catch {close $f1}
sl@0	6639	close $f2
sl@0	6640	list $s0 [file size $path(test1)]
sl@0	6641	} {40 40}
sl@0	6642
sl@0	6643	# Empty files, to register them with the test facility
sl@0	6644	set path(kyrillic.txt) [makeFile {} kyrillic.txt]
sl@0	6645	set path(utf8-fcopy.txt) [makeFile {} utf8-fcopy.txt]
sl@0	6646	set path(utf8-rp.txt) [makeFile {} utf8-rp.txt]
sl@0	6647
sl@0	6648	# Create kyrillic file, use lf translation to avoid os eol issues
sl@0	6649	set out [open $path(kyrillic.txt) w]
sl@0	6650	fconfigure $out -encoding koi8-r -translation lf
sl@0	6651	puts $out "\u0410\u0410"
sl@0	6652	close $out
sl@0	6653
sl@0	6654	test io-52.9 {TclCopyChannel & encodings} {fcopy} {
sl@0	6655	# Copy kyrillic to UTF-8, using fcopy.
sl@0	6656
sl@0	6657	set in [open $path(kyrillic.txt) r]
sl@0	6658	set out [open $path(utf8-fcopy.txt) w]
sl@0	6659
sl@0	6660	fconfigure $in -encoding koi8-r -translation lf
sl@0	6661	fconfigure $out -encoding utf-8 -translation lf
sl@0	6662
sl@0	6663	fcopy $in $out
sl@0	6664	close $in
sl@0	6665	close $out
sl@0	6666
sl@0	6667	# Do the same again, but differently (read/puts).
sl@0	6668
sl@0	6669	set in [open $path(kyrillic.txt) r]
sl@0	6670	set out [open $path(utf8-rp.txt) w]
sl@0	6671
sl@0	6672	fconfigure $in -encoding koi8-r -translation lf
sl@0	6673	fconfigure $out -encoding utf-8 -translation lf
sl@0	6674
sl@0	6675	puts -nonewline $out [read $in]
sl@0	6676
sl@0	6677	close $in
sl@0	6678	close $out
sl@0	6679
sl@0	6680	list [file size $path(kyrillic.txt)] \
sl@0	6681	[file size $path(utf8-fcopy.txt)] \
sl@0	6682	[file size $path(utf8-rp.txt)]
sl@0	6683	} {3 5 5}
sl@0	6684
sl@0	6685	test io-52.10 {TclCopyChannel & encodings} {fcopy} {
sl@0	6686	# encoding to binary (=> implies that the
sl@0	6687	# internal utf-8 is written)
sl@0	6688
sl@0	6689	set in [open $path(kyrillic.txt) r]
sl@0	6690	set out [open $path(utf8-fcopy.txt) w]
sl@0	6691
sl@0	6692	fconfigure $in -encoding koi8-r -translation lf
sl@0	6693	# -translation binary is also -encoding binary
sl@0	6694	fconfigure $out -translation binary
sl@0	6695
sl@0	6696	fcopy $in $out
sl@0	6697	close $in
sl@0	6698	close $out
sl@0	6699
sl@0	6700	file size $path(utf8-fcopy.txt)
sl@0	6701	} 5
sl@0	6702
sl@0	6703	test io-52.11 {TclCopyChannel & encodings} {fcopy} {
sl@0	6704	# binary to encoding => the input has to be
sl@0	6705	# in utf-8 to make sense to the encoder
sl@0	6706
sl@0	6707	set in [open $path(utf8-fcopy.txt) r]
sl@0	6708	set out [open $path(kyrillic.txt) w]
sl@0	6709
sl@0	6710	# -translation binary is also -encoding binary
sl@0	6711	fconfigure $in -translation binary
sl@0	6712	fconfigure $out -encoding koi8-r -translation lf
sl@0	6713
sl@0	6714	fcopy $in $out
sl@0	6715	close $in
sl@0	6716	close $out
sl@0	6717
sl@0	6718	file size $path(kyrillic.txt)
sl@0	6719	} 3
sl@0	6720
sl@0	6721	test io-53.1 {CopyData} {fcopy} {
sl@0	6722	file delete $path(test1)
sl@0	6723	set f1 [open $thisScript]
sl@0	6724	set f2 [open $path(test1) w]
sl@0	6725	fconfigure $f1 -translation lf -blocking 0
sl@0	6726	fconfigure $f2 -translation cr -blocking 0
sl@0	6727	fcopy $f1 $f2 -size 0
sl@0	6728	set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
sl@0	6729	close $f1
sl@0	6730	close $f2
sl@0	6731	lappend result [file size $path(test1)]
sl@0	6732	} {0 0 0}
sl@0	6733	test io-53.2 {CopyData} {fcopy} {
sl@0	6734	file delete $path(test1)
sl@0	6735	set f1 [open $thisScript]
sl@0	6736	set f2 [open $path(test1) w]
sl@0	6737	fconfigure $f1 -translation lf -blocking 0
sl@0	6738	fconfigure $f2 -translation cr -blocking 0
sl@0	6739	fcopy $f1 $f2 -command [namespace code {set s0}]
sl@0	6740	set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
sl@0	6741	variable s0
sl@0	6742	vwait [namespace which -variable s0]
sl@0	6743	close $f1
sl@0	6744	close $f2
sl@0	6745	set s1 [file size $thisScript]
sl@0	6746	set s2 [file size $path(test1)]
sl@0	6747	if {("$s1" == "$s2") && ($s0 == $s1)} {
sl@0	6748	lappend result ok
sl@0	6749	}
sl@0	6750	set result
sl@0	6751	} {0 0 ok}
sl@0	6752	test io-53.3 {CopyData: background read underflow} {stdio unixOnly openpipe fcopy} {
sl@0	6753	file delete $path(test1)
sl@0	6754	file delete $path(pipe)
sl@0	6755	set f1 [open $path(pipe) w]
sl@0	6756	puts -nonewline $f1 {
sl@0	6757	puts ready
sl@0	6758	flush stdout ;# Don't assume line buffered!
sl@0	6759	fcopy stdin stdout -command { set x }
sl@0	6760	vwait x
sl@0	6761	set f [}
sl@0	6762	puts $f1 [list open $path(test1) w]]
sl@0	6763	puts $f1 {
sl@0	6764	fconfigure $f -translation lf
sl@0	6765	puts $f "done"
sl@0	6766	close $f
sl@0	6767	}
sl@0	6768	close $f1
sl@0	6769	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	6770	set result [gets $f1]
sl@0	6771	puts $f1 line1
sl@0	6772	flush $f1
sl@0	6773	lappend result [gets $f1]
sl@0	6774	puts $f1 line2
sl@0	6775	flush $f1
sl@0	6776	lappend result [gets $f1]
sl@0	6777	close $f1
sl@0	6778	after 500
sl@0	6779	set f [open $path(test1)]
sl@0	6780	lappend result [read $f]
sl@0	6781	close $f
sl@0	6782	set result
sl@0	6783	} "ready line1 line2 {done\n}"
sl@0	6784	test io-53.4 {CopyData: background write overflow} {stdio unixOnly openpipe fileevent fcopy} {
sl@0	6785	set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
sl@0	6786	variable x
sl@0	6787	for {set x 0} {$x < 12} {incr x} {
sl@0	6788	append big $big
sl@0	6789	}
sl@0	6790	file delete $path(test1)
sl@0	6791	file delete $path(pipe)
sl@0	6792	set f1 [open $path(pipe) w]
sl@0	6793	puts $f1 {
sl@0	6794	puts ready
sl@0	6795	fcopy stdin stdout -command { set x }
sl@0	6796	vwait x
sl@0	6797	set f [open $path(test1) w]
sl@0	6798	fconfigure $f -translation lf
sl@0	6799	puts $f "done"
sl@0	6800	close $f
sl@0	6801	}
sl@0	6802	close $f1
sl@0	6803	set f1 [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	6804	set result [gets $f1]
sl@0	6805	fconfigure $f1 -blocking 0
sl@0	6806	puts $f1 $big
sl@0	6807	flush $f1
sl@0	6808	after 500
sl@0	6809	set result ""
sl@0	6810	fileevent $f1 read [namespace code {
sl@0	6811	append result [read $f1 1024]
sl@0	6812	if {[string length $result] >= [string length $big]} {
sl@0	6813	set x done
sl@0	6814	}
sl@0	6815	}]
sl@0	6816	vwait [namespace which -variable x]
sl@0	6817	close $f1
sl@0	6818	set big {}
sl@0	6819	set x
sl@0	6820	} done
sl@0	6821	set result {}
sl@0	6822
sl@0	6823	proc FcopyTestAccept {sock args} {
sl@0	6824	after 1000 "close $sock"
sl@0	6825	}
sl@0	6826	proc FcopyTestDone {bytes {error {}}} {
sl@0	6827	variable fcopyTestDone
sl@0	6828	if {[string length $error]} {
sl@0	6829	set fcopyTestDone 1
sl@0	6830	} else {
sl@0	6831	set fcopyTestDone 0
sl@0	6832	}
sl@0	6833	}
sl@0	6834
sl@0	6835	test io-53.5 {CopyData: error during fcopy} {socket fcopy} {
sl@0	6836	variable fcopyTestDone
sl@0	6837	set listen [socket -server [namespace code FcopyTestAccept] 0]
sl@0	6838	set in [open $thisScript] ;# 126 K
sl@0	6839	set out [socket 127.0.0.1 [lindex [fconfigure $listen -sockname] 2]]
sl@0	6840	catch {unset fcopyTestDone}
sl@0	6841	close $listen ;# This means the socket open never really succeeds
sl@0	6842	fcopy $in $out -command [namespace code FcopyTestDone]
sl@0	6843	variable fcopyTestDone
sl@0	6844	if ![info exists fcopyTestDone] {
sl@0	6845	vwait [namespace which -variable fcopyTestDone] ;# The error occurs here in the b.g.
sl@0	6846	}
sl@0	6847	close $in
sl@0	6848	close $out
sl@0	6849	set fcopyTestDone ;# 1 for error condition
sl@0	6850	} 1
sl@0	6851	test io-53.6 {CopyData: error during fcopy} {stdio openpipe fcopy} {
sl@0	6852	variable fcopyTestDone
sl@0	6853	file delete $path(pipe)
sl@0	6854	file delete $path(test1)
sl@0	6855	catch {unset fcopyTestDone}
sl@0	6856	set f1 [open $path(pipe) w]
sl@0	6857	puts $f1 "exit 1"
sl@0	6858	close $f1
sl@0	6859	set in [open "\|[list [interpreter] $path(pipe)]" r+]
sl@0	6860	set out [open $path(test1) w]
sl@0	6861	fcopy $in $out -command [namespace code FcopyTestDone]
sl@0	6862	variable fcopyTestDone
sl@0	6863	if ![info exists fcopyTestDone] {
sl@0	6864	vwait [namespace which -variable fcopyTestDone]
sl@0	6865	}
sl@0	6866	catch {close $in}
sl@0	6867	close $out
sl@0	6868	set fcopyTestDone ;# 0 for plain end of file
sl@0	6869	} {0}
sl@0	6870
sl@0	6871	proc doFcopy {in out {bytes 0} {error {}}} {
sl@0	6872	variable fcopyTestDone
sl@0	6873	variable fcopyTestCount
sl@0	6874	incr fcopyTestCount $bytes
sl@0	6875	if {[string length $error]} {
sl@0	6876	set fcopyTestDone 1
sl@0	6877	} elseif {[eof $in]} {
sl@0	6878	set fcopyTestDone 0
sl@0	6879	} else {
sl@0	6880	# Delay next fcopy to wait for size>0 input bytes
sl@0	6881	after 100 [list
sl@0	6882	fcopy $in $out -size 1000 \
sl@0	6883	-command [namespace code [list doFcopy $in $out]]
sl@0	6884	]
sl@0	6885	}
sl@0	6886	}
sl@0	6887
sl@0	6888	test io-53.7 {CopyData: Flooding fcopy from pipe} {stdio openpipe fcopy} {
sl@0	6889	variable fcopyTestDone
sl@0	6890	file delete $path(pipe)
sl@0	6891	catch {unset fcopyTestDone}
sl@0	6892	set fcopyTestCount 0
sl@0	6893	set f1 [open $path(pipe) w]
sl@0	6894	puts $f1 {
sl@0	6895	# Write 10 bytes / 10 msec
sl@0	6896	proc Write {count} {
sl@0	6897	puts -nonewline "1234567890"
sl@0	6898	if {[incr count -1]} {
sl@0	6899	after 10 [list Write $count]
sl@0	6900	} else {
sl@0	6901	set ::ready 1
sl@0	6902	}
sl@0	6903	}
sl@0	6904	fconfigure stdout -buffering none
sl@0	6905	Write 345 ;# 3450 bytes ~3.45 sec
sl@0	6906	vwait ready
sl@0	6907	exit 0
sl@0	6908	}
sl@0	6909	close $f1
sl@0	6910	set in [open "\|[list [interpreter] $path(pipe) &]" r+]
sl@0	6911	set out [open $path(test1) w]
sl@0	6912	doFcopy $in $out
sl@0	6913	variable fcopyTestDone
sl@0	6914	if ![info exists fcopyTestDone] {
sl@0	6915	vwait [namespace which -variable fcopyTestDone]
sl@0	6916	}
sl@0	6917	catch {close $in}
sl@0	6918	close $out
sl@0	6919	# -1=error 0=script error N=number of bytes
sl@0	6920	expr ($fcopyTestDone == 0) ? $fcopyTestCount : -1
sl@0	6921	} {3450}
sl@0	6922
sl@0	6923	test io-54.1 {Recursive channel events} {socket fileevent} {
sl@0	6924	# This test checks to see if file events are delivered during recursive
sl@0	6925	# event loops when there is buffered data on the channel.
sl@0	6926
sl@0	6927	proc accept {s a p} {
sl@0	6928	variable as
sl@0	6929	fconfigure $s -translation lf
sl@0	6930	puts $s "line 1\nline2\nline3"
sl@0	6931	flush $s
sl@0	6932	set as $s
sl@0	6933	}
sl@0	6934	proc readit {s next} {
sl@0	6935	variable x
sl@0	6936	variable result
sl@0	6937	lappend result $next
sl@0	6938	if {$next == 1} {
sl@0	6939	fileevent $s readable [namespace code [list readit $s 2]]
sl@0	6940	vwait [namespace which -variable x]
sl@0	6941	}
sl@0	6942	incr x
sl@0	6943	}
sl@0	6944	set ss [socket -server [namespace code accept] 0]
sl@0	6945
sl@0	6946	# We need to delay on some systems until the creation of the
sl@0	6947	# server socket completes.
sl@0	6948
sl@0	6949	set done 0
sl@0	6950	for {set i 0} {$i < 10} {incr i} {
sl@0	6951	if {![catch {set cs [socket [info hostname] [lindex [fconfigure $ss -sockname] 2]]}]} {
sl@0	6952	set done 1
sl@0	6953	break
sl@0	6954	}
sl@0	6955	after 100
sl@0	6956	}
sl@0	6957	if {$done == 0} {
sl@0	6958	close $ss
sl@0	6959	error "failed to connect to server"
sl@0	6960	}
sl@0	6961	variable result {}
sl@0	6962	variable x 0
sl@0	6963	variable as
sl@0	6964	vwait [namespace which -variable as]
sl@0	6965	fconfigure $cs -translation lf
sl@0	6966	lappend result [gets $cs]
sl@0	6967	fconfigure $cs -blocking off
sl@0	6968	fileevent $cs readable [namespace code [list readit $cs 1]]
sl@0	6969	set a [after 2000 [namespace code { set x failure }]]
sl@0	6970	vwait [namespace which -variable x]
sl@0	6971	after cancel $a
sl@0	6972	close $as
sl@0	6973	close $ss
sl@0	6974	close $cs
sl@0	6975	list $result $x
sl@0	6976	} {{{line 1} 1 2} 2}
sl@0	6977	test io-54.2 {Testing for busy-wait in recursive channel events} {socket fileevent} {
sl@0	6978	set accept {}
sl@0	6979	set after {}
sl@0	6980	variable s [socket -server [namespace code accept] 0]
sl@0	6981	proc accept {s a p} {
sl@0	6982	variable counter
sl@0	6983	variable accept
sl@0	6984
sl@0	6985	set accept $s
sl@0	6986	set counter 0
sl@0	6987	fconfigure $s -blocking off -buffering line -translation lf
sl@0	6988	fileevent $s readable [namespace code "doit $s"]
sl@0	6989	}
sl@0	6990	proc doit {s} {
sl@0	6991	variable counter
sl@0	6992	variable after
sl@0	6993
sl@0	6994	incr counter
sl@0	6995	set l [gets $s]
sl@0	6996	if {"$l" == ""} {
sl@0	6997	fileevent $s readable [namespace code "doit1 $s"]
sl@0	6998	set after [after 1000 [namespace code newline]]
sl@0	6999	}
sl@0	7000	}
sl@0	7001	proc doit1 {s} {
sl@0	7002	variable counter
sl@0	7003	variable accept
sl@0	7004
sl@0	7005	incr counter
sl@0	7006	set l [gets $s]
sl@0	7007	close $s
sl@0	7008	set accept {}
sl@0	7009	}
sl@0	7010	proc producer {} {
sl@0	7011	variable s
sl@0	7012	variable writer
sl@0	7013
sl@0	7014	set writer [socket 127.0.0.1 [lindex [fconfigure $s -sockname] 2]]
sl@0	7015	fconfigure $writer -buffering line
sl@0	7016	puts -nonewline $writer hello
sl@0	7017	flush $writer
sl@0	7018	}
sl@0	7019	proc newline {} {
sl@0	7020	variable done
sl@0	7021	variable writer
sl@0	7022
sl@0	7023	puts $writer hello
sl@0	7024	flush $writer
sl@0	7025	set done 1
sl@0	7026	}
sl@0	7027	producer
sl@0	7028	variable done
sl@0	7029	vwait [namespace which -variable done]
sl@0	7030	close $writer
sl@0	7031	close $s
sl@0	7032	after cancel $after
sl@0	7033	if {$accept != {}} {close $accept}
sl@0	7034	set counter
sl@0	7035	} 1
sl@0	7036
sl@0	7037	set path(fooBar) [makeFile {} fooBar]
sl@0	7038
sl@0	7039	test io-55.1 {ChannelEventScriptInvoker: deletion} {fileevent} {
sl@0	7040	variable x
sl@0	7041	proc eventScript {fd} {
sl@0	7042	variable x
sl@0	7043	close $fd
sl@0	7044	error "planned error"
sl@0	7045	set x whoops
sl@0	7046	}
sl@0	7047	proc ::bgerror {args} "set [namespace which -variable x] got_error"
sl@0	7048	set f [open $path(fooBar) w]
sl@0	7049	fileevent $f writable [namespace code [list eventScript $f]]
sl@0	7050	variable x not_done
sl@0	7051	vwait [namespace which -variable x]
sl@0	7052	set x
sl@0	7053	} {got_error}
sl@0	7054
sl@0	7055	test io-56.1 {ChannelTimerProc} {testchannelevent} {
sl@0	7056	set f [open $path(fooBar) w]
sl@0	7057	puts $f "this is a test"
sl@0	7058	close $f
sl@0	7059	set f [open $path(fooBar) r]
sl@0	7060	testchannelevent $f add readable [namespace code {
sl@0	7061	read $f 1
sl@0	7062	incr x
sl@0	7063	}]
sl@0	7064	variable x 0
sl@0	7065	vwait [namespace which -variable x]
sl@0	7066	vwait [namespace which -variable x]
sl@0	7067	set result $x
sl@0	7068	testchannelevent $f set 0 none
sl@0	7069	after idle [namespace code {set y done}]
sl@0	7070	variable y
sl@0	7071	vwait [namespace which -variable y]
sl@0	7072	close $f
sl@0	7073	lappend result $y
sl@0	7074	} {2 done}
sl@0	7075
sl@0	7076	test io-57.1 {buffered data and file events, gets} {fileevent} {
sl@0	7077	proc accept {sock args} {
sl@0	7078	variable s2
sl@0	7079	set s2 $sock
sl@0	7080	}
sl@0	7081	set server [socket -server [namespace code accept] 0]
sl@0	7082	set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
sl@0	7083	variable s2
sl@0	7084	vwait [namespace which -variable s2]
sl@0	7085	update
sl@0	7086	fileevent $s2 readable [namespace code {lappend result readable}]
sl@0	7087	puts $s "12\n34567890"
sl@0	7088	flush $s
sl@0	7089	variable result [gets $s2]
sl@0	7090	after 1000 [namespace code {lappend result timer}]
sl@0	7091	vwait [namespace which -variable result]
sl@0	7092	lappend result [gets $s2]
sl@0	7093	vwait [namespace which -variable result]
sl@0	7094	close $s
sl@0	7095	close $s2
sl@0	7096	close $server
sl@0	7097	set result
sl@0	7098	} {12 readable 34567890 timer}
sl@0	7099	test io-57.2 {buffered data and file events, read} {fileevent} {
sl@0	7100	proc accept {sock args} {
sl@0	7101	variable s2
sl@0	7102	set s2 $sock
sl@0	7103	}
sl@0	7104	set server [socket -server [namespace code accept] 0]
sl@0	7105	set s [socket 127.0.0.1 [lindex [fconfigure $server -sockname] 2]]
sl@0	7106	variable s2
sl@0	7107	vwait [namespace which -variable s2]
sl@0	7108	update
sl@0	7109	fileevent $s2 readable [namespace code {lappend result readable}]
sl@0	7110	puts -nonewline $s "1234567890"
sl@0	7111	flush $s
sl@0	7112	variable result [read $s2 1]
sl@0	7113	after 1000 [namespace code {lappend result timer}]
sl@0	7114	vwait [namespace which -variable result]
sl@0	7115	lappend result [read $s2 9]
sl@0	7116	vwait [namespace which -variable result]
sl@0	7117	close $s
sl@0	7118	close $s2
sl@0	7119	close $server
sl@0	7120	set result
sl@0	7121	} {1 readable 234567890 timer}
sl@0	7122
sl@0	7123	test io-58.1 {Tcl_NotifyChannel and error when closing} {stdio unixOrPc openpipe fileevent} {
sl@0	7124	set out [open $path(script) w]
sl@0	7125	puts $out {
sl@0	7126	puts "normal message from pipe"
sl@0	7127	puts stderr "error message from pipe"
sl@0	7128	exit 1
sl@0	7129	}
sl@0	7130	proc readit {pipe} {
sl@0	7131	variable x
sl@0	7132	variable result
sl@0	7133	if {[eof $pipe]} {
sl@0	7134	set x [catch {close $pipe} line]
sl@0	7135	lappend result catch $line
sl@0	7136	} else {
sl@0	7137	gets $pipe line
sl@0	7138	lappend result gets $line
sl@0	7139	}
sl@0	7140	}
sl@0	7141	close $out
sl@0	7142	set pipe [open "\|[list [interpreter] $path(script)]" r]
sl@0	7143	fileevent $pipe readable [namespace code [list readit $pipe]]
sl@0	7144	variable x ""
sl@0	7145	set result ""
sl@0	7146	vwait [namespace which -variable x]
sl@0	7147	list $x $result
sl@0	7148	} {1 {gets {normal message from pipe} gets {} catch {error message from pipe}}}
sl@0	7149
sl@0	7150
sl@0	7151	testConstraint testmainthread [llength [info commands testmainthread]]
sl@0	7152	test io-59.1 {Thread reference of channels} {testmainthread testchannel} {
sl@0	7153	# TIP #10
sl@0	7154	# More complicated tests (like that the reference changes as a
sl@0	7155	# channel is moved from thread to thread) can be done only in the
sl@0	7156	# extension which fully implements the moving of channels between
sl@0	7157	# threads, i.e. 'Threads'. Or we have to extend [testthread] as well.
sl@0	7158
sl@0	7159	set f [open $path(longfile) r]
sl@0	7160	set result [testchannel mthread $f]
sl@0	7161	close $f
sl@0	7162	string equal $result [testmainthread]
sl@0	7163	} {1}
sl@0	7164
sl@0	7165
sl@0	7166	test io-60.1 {writing illegal utf sequences} {openpipe fileevent} {
sl@0	7167	# This test will hang in older revisions of the core.
sl@0	7168
sl@0	7169	set out [open $path(script) w]
sl@0	7170	puts $out {
sl@0	7171	puts [encoding convertfrom identity \xe2]
sl@0	7172	exit 1
sl@0	7173	}
sl@0	7174	proc readit {pipe} {
sl@0	7175	variable x
sl@0	7176	variable result
sl@0	7177	if {[eof $pipe]} {
sl@0	7178	set x [catch {close $pipe} line]
sl@0	7179	lappend result catch $line
sl@0	7180	} else {
sl@0	7181	gets $pipe line
sl@0	7182	lappend result gets $line
sl@0	7183	}
sl@0	7184	}
sl@0	7185	close $out
sl@0	7186	set pipe [open "\|[list [interpreter] $path(script)]" r]
sl@0	7187	fileevent $pipe readable [namespace code [list readit $pipe]]
sl@0	7188	variable x ""
sl@0	7189	set result ""
sl@0	7190	vwait [namespace which -variable x]
sl@0	7191
sl@0	7192	# cut of the remainder of the error stack, especially the filename
sl@0	7193	set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
sl@0	7194	list $x $result
sl@0	7195	} {1 {gets {} catch {error writing "stdout": invalid argument}}}
sl@0	7196
sl@0	7197	test io-61.1 {Reset eof state after changing the eof char} -setup {
sl@0	7198	set datafile [makeFile {} eofchar]
sl@0	7199	set f [open $datafile w]
sl@0	7200	fconfigure $f -translation binary
sl@0	7201	puts -nonewline $f [string repeat "Ho hum\n" 11]
sl@0	7202	puts $f =
sl@0	7203	set line [string repeat "Ge gla " 4]
sl@0	7204	puts -nonewline $f [string repeat [string trimright $line]\n 834]
sl@0	7205	close $f
sl@0	7206	} -body {
sl@0	7207	set f [open $datafile r]
sl@0	7208	fconfigure $f -eofchar =
sl@0	7209	set res {}
sl@0	7210	lappend res [read $f; tell $f]
sl@0	7211	fconfigure $f -eofchar {}
sl@0	7212	lappend res [read $f 1]
sl@0	7213	lappend res [read $f; tell $f]
sl@0	7214	# Any seek zaps the internals into a good state.
sl@0	7215	#seek $f 0 start
sl@0	7216	#seek $f 0 current
sl@0	7217	#lappend res [read $f; tell $f]
sl@0	7218	close $f
sl@0	7219	set res
sl@0	7220	} -cleanup {
sl@0	7221	removeFile eofchar
sl@0	7222	} -result {77 = 23431}
sl@0	7223
sl@0	7224	# cleanup
sl@0	7225	foreach file [list fooBar longfile script output test1 pipe my_script foo \
sl@0	7226	bar test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
sl@0	7227	removeFile $file
sl@0	7228	}
sl@0	7229	cleanupTests
sl@0	7230	}
sl@0	7231	namespace delete ::tcl::test::io
sl@0	7232	return

author	sl@SLION-WIN7.fritz.box
	Fri, 15 Jun 2012 03:10:57 +0200
changeset 0	bde4ae8d615e
permissions	-rw-r--r--