summaryrefslogtreecommitdiffstats
path: root/tests/io.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/io.test')
-rw-r--r--tests/io.test742
1 files changed, 601 insertions, 141 deletions
diff --git a/tests/io.test b/tests/io.test
index 6d556da..a910d5b 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -6,19 +6,19 @@
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
-# Copyright (c) 1991-1994 The Regents of the University of California.
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 Scriptics Corporation.
+# Copyright © 1991-1994 The Regents of the University of California.
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-namespace eval ::tcl::test::io {
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.5
+}
- if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.5
- namespace import -force ::tcltest::*
- }
+namespace eval ::tcl::test::io {
+ namespace import ::tcltest::*
variable umaskValue
variable path
@@ -31,8 +31,8 @@ namespace eval ::tcl::test::io {
catch {
::tcltest::loadTestedCommands
- package require -exact Tcltest [info patchlevel]
- set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
+ package require -exact tcl::test [info patchlevel]
+ set ::tcltestlib [info loaded {} Tcltest]
}
source [file join [file dirname [info script]] tcltests.tcl]
@@ -48,6 +48,8 @@ testConstraint testservicemode [llength [info commands testservicemode]]
testConstraint notWinCI [expr {
$::tcl_platform(platform) ne "windows" || ![info exists ::env(CI)]}]
testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
+# File permissions broken on wsl without some "exotic" wsl configuration
+testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
@@ -77,7 +79,7 @@ set path(cat) [makeFile {
if {$argv != ""} {
set f [open [lindex $argv 0]]
}
- fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A
+ fconfigure $f -encoding binary -translation lf -blocking 0 -eofchar "\x1A \x1A"
fconfigure stdout -encoding binary -translation lf -buffering none
fileevent $f readable "foo $f"
proc foo {f} {
@@ -108,14 +110,14 @@ set path(test1) [makeFile {} test1]
test io-1.6 {Tcl_WriteChars: WriteBytes} {
set f [open $path(test1) w]
fconfigure $f -encoding binary
- puts -nonewline $f "a\u4E4D\x00"
+ puts -nonewline $f "a\x4D\x00"
close $f
contents $path(test1)
} "a\x4D\x00"
test io-1.7 {Tcl_WriteChars: WriteChars} {
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
- puts -nonewline $f "a\u4e4d\x00"
+ puts -nonewline $f "a乍\x00"
close $f
contents $path(test1)
} "a\x93\xE1\x00"
@@ -272,7 +274,7 @@ test io-3.4 {WriteChars: loop over stage buffer} -body {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 16
+ fconfigure $f -encoding jis0208 -buffersize 16 -nocomplainencoding 1
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -286,7 +288,7 @@ test io-3.5 {WriteChars: saved != 0} -body {
# requested buffersize.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -299,14 +301,14 @@ test io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
# in src to the beginning of that UTF-8 character and try again.
#
# Translate the first 16 bytes, produce 14 bytes of output, 2 left over
- # (first two bytes of \uFF21 in UTF-8). Given those two bytes try
+ # (first two bytes of Ａ in UTF-8). Given those two bytes try
# translating them again, find that no bytes are read produced, and break
# to outer loop where those two bytes will have the remaining 4 bytes
- # (the last byte of \uFF21 plus the all of \uFF22) appended.
+ # (the last byte of Ａ plus the all of Ｂ) appended.
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis -buffersize 16
- puts -nonewline $f "12345678901234\uFF21\uFF22"
+ puts -nonewline $f "12345678901234ＡＢ"
set x [list [contents $path(test1)]]
close $f
lappend x [contents $path(test1)]
@@ -319,7 +321,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
# of the next channel buffer.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17 -nocomplainencoding 1
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -466,7 +468,7 @@ test io-6.3 {Tcl_GetsObj: how many have we used?} {
test io-6.4 {Tcl_GetsObj: encoding == NULL} {
set f [open $path(test1) w]
fconfigure $f -translation binary
- puts $f "\x81\u1234\x00"
+ puts $f "\x81\x34\x00"
close $f
set f [open $path(test1)]
fconfigure $f -translation binary
@@ -484,7 +486,7 @@ test io-6.5 {Tcl_GetsObj: encoding != NULL} {
set x [list [gets $f line] $line]
close $f
set x
-} [list 2 "\u4E00\u4E01"]
+} [list 2 "一丁"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
@@ -517,17 +519,17 @@ test io-6.8 {Tcl_GetsObj: remember if EOF is seen} {
puts $f "abcdef\x1Aghijk\nwombat"
close $f
set f [open $path(test1)]
- fconfigure $f -eofchar \x1A
+ fconfigure $f -eofchar "\x1A \x1A"
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
} {6 abcdef -1 {}}
test io-6.9 {Tcl_GetsObj: remember if EOF is seen} {
set f [open $path(test1) w]
- puts $f "abcdefghijk\nwom\u001Abat"
+ puts $f "abcdefghijk\nwom\x1Abat"
close $f
set f [open $path(test1)]
- fconfigure $f -eofchar \x1A
+ fconfigure $f -eofchar "\x1A \x1A"
set x [list [gets $f line] $line [gets $f line] $line]
close $f
set x
@@ -938,7 +940,7 @@ test io-6.45 {Tcl_GetsObj: input saw cr, skip right number of bytes} {stdio test
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto lf} -buffering none
- fconfigure $f -encoding unicode
+ fconfigure $f -encoding utf-16
puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
fconfigure $f -buffersize 16
gets $f
@@ -1036,7 +1038,7 @@ test io-6.52 {Tcl_GetsObj: saw EOF character} {testchannel} {
puts -nonewline $f "123456\x1Ak9012345\r"
close $f
set f [open $path(test1)]
- fconfigure $f -eofchar \x1A
+ fconfigure $f -eofchar "\x1A \x1A"
set x [list [gets $f] [testchannel queuedcr $f] [tell $f] [gets $f]]
close $f
set x
@@ -1067,14 +1069,14 @@ test io-6.55 {Tcl_GetsObj: overconverted} {
set f [open $path(test1) w]
fconfigure $f -encoding iso2022-jp
- puts $f "there\u4E00ok\n\u4E01more bytes\nhere"
+ puts $f "there一ok\n丁more bytes\nhere"
close $f
set f [open $path(test1)]
fconfigure $f -encoding iso2022-jp
set x [list [gets $f line] $line [gets $f line] $line [gets $f line] $line]
close $f
set x
-} [list 8 "there\u4E00ok" 11 "\u4E01more bytes" 4 "here"]
+} [list 8 "there一ok" 11 "丁more bytes" 4 "here"]
test io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} {stdio fileevent} {
update
set f [open "|[list [interpreter] $path(cat)]" w+]
@@ -1101,14 +1103,14 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} {
set f [open $path(test1) w]
fconfigure $f -encoding shiftjis
- puts $f "1234567890123\uFF10\uFF11\uFF12\uFF13\uFF14\nend"
+ puts $f "1234567890123０１２３４\nend"
close $f
set f [open $path(test1)]
fconfigure $f -encoding shiftjis -buffersize 16
set x [gets $f]
close $f
set x
-} "1234567890123\uFF10\uFF11\uFF12\uFF13\uFF14"
+} "1234567890123０１２３４"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
# (bufPtr->nextAdded < bufPtr->bufLength)
@@ -1134,7 +1136,7 @@ test io-7.3 {FilterInputBytes: split up character at EOF} {testchannel} {
lappend x [gets $f line] $line
close $f
set x
-} [list 15 "1234567890123\uFF10\uFF11" 18 0 1 -1 ""]
+} [list 15 "1234567890123０１" 18 0 1 -1 ""]
test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent} {
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -encoding binary -buffering none
@@ -1153,7 +1155,7 @@ test io-7.4 {FilterInputBytes: recover from split up character} {stdio fileevent
vwait [namespace which -variable x]
close $f
set x
-} [list -1 "" 1 17 "1234567890123\uFF10\uFF11\uFF12\uFF13" 0]
+} [list -1 "" 1 17 "1234567890123０１２３" 0]
test io-8.1 {PeekAhead: only go to device if no more cached data} {testchannel} {
# (bufPtr->nextPtr == NULL)
@@ -1182,7 +1184,7 @@ test io-8.2 {PeekAhead: only go to device if no more cached data} {stdio testcha
variable x
lappend x [gets $f line] $line [testchannel inputbuffered $f]
}
- fconfigure $f -encoding unicode -buffersize 16 -blocking 0
+ fconfigure $f -encoding utf-16 -buffersize 16 -blocking 0
vwait [namespace which -variable x]
fconfigure $f -translation auto -encoding ascii -blocking 1
# here
@@ -1436,7 +1438,7 @@ test io-12.4 {ReadChars: split-up char} {stdio testchannel fileevent} {
vwait [namespace which -variable x]
close $f
set x
-} [list "123456789012345" 1 "\u672C" 0]
+} [list "123456789012345" 1 "本" 0]
test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
set path(test1) [makeFile {
fconfigure stdout -encoding binary -buffering none
@@ -1469,7 +1471,7 @@ test io-12.5 {ReadChars: fileevents on partial characters} {stdio fileevent} {
vwait [namespace which -variable x]
lappend x [catch {close $f} msg] $msg
set x
-} "{} timeout {} timeout \u7266 {} eof 0 {}"
+} "{} timeout {} timeout 牦 {} eof 0 {}"
test io-12.6 {ReadChars: too many chars read} {
proc driver {cmd args} {
variable buffer
@@ -1479,7 +1481,7 @@ test io-12.6 {ReadChars: too many chars read} {
initialize {
set index($chan) 0
set buffer($chan) [encoding convertto utf-8 \
- [string repeat \uBEEF 20][string repeat . 20]]
+ [string repeat 뻯 20][string repeat . 20]]
return {initialize finalize watch read}
}
finalize {
@@ -1512,7 +1514,7 @@ test io-12.7 {ReadChars: too many chars read [bc5b790099]} {
initialize {
set index($chan) 0
set buffer($chan) [encoding convertto utf-8 \
- [string repeat \uBEEF 10]....\uBEEF]
+ [string repeat 뻯 10]....뻯]
return {initialize finalize watch read}
}
finalize {
@@ -2392,6 +2394,74 @@ test io-28.5 {Tcl_Close vs standard handles} {stdio unix testchannel} {
lsort $l
} {file1 file2}
+
+test io-28.6 {
+ close channel in write event handler
+
+ Should not produce a segmentation fault in a Tcl built with
+ --enable-symbols and -DPURIFY
+} debugpurify {
+ variable done
+ variable res
+ after 0 [list coroutine c1 apply [list {} {
+ variable done
+ set chan [chan create w {apply {args {
+ list initialize finalize watch write configure blocking
+ }}}]
+ chan configure $chan -blocking 0
+ while 1 {
+ chan event $chan writable [list [info coroutine]]
+ yield
+ close $chan
+ set done 1
+ return
+ }
+ } [namespace current]]]
+ vwait [namespace current]::done
+return success
+} success
+
+
+test io-28.7 {
+ close channel in read event handler
+
+ Should not produce a segmentation fault in a Tcl built with
+ --enable-symbols and -DPURIFY
+} debugpurify {
+ variable done
+ variable res
+ after 0 [list coroutine c1 apply [list {} {
+ variable done
+ set chan [chan create r {apply {{cmd chan args} {
+ switch $cmd {
+ blocking - finalize {
+ }
+ watch {
+ chan postevent $chan read
+ }
+ initialize {
+ list initialize finalize watch read write configure blocking
+ }
+ default {
+ error [list {unexpected command} $cmd]
+ }
+ }
+ }}}]
+ chan configure $chan -blocking 0
+ while 1 {
+ chan event $chan readable [list [info coroutine]]
+ yield
+ close $chan
+ set done 1
+ return
+ }
+ } [namespace current]]]
+ vwait [namespace current]::done
+return success
+} success
+
+
+
test io-29.1 {Tcl_WriteChars, channel not writable} {
list [catch {puts stdin hello} msg] $msg
} {1 {channel "stdin" wasn't opened for writing}}
@@ -3314,7 +3384,7 @@ test io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} {
puts -nonewline $f hello\nthere\nand\rhere\n\x1A
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set c [read $f]
close $f
set c
@@ -3326,11 +3396,11 @@ here
test io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} {win} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
puts $f hello\nthere\nand\rhere
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set c [read $f]
close $f
set c
@@ -3347,7 +3417,7 @@ test io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3367,7 +3437,7 @@ test io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3445,7 +3515,7 @@ test io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} {
puts $f $c
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set c [string length [read $f]]
set e [eof $f]
close $f
@@ -3459,7 +3529,7 @@ test io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} {
puts $f $c
close $f
set f [open $path(test1) r]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
set c [string length [read $f]]
set e [eof $f]
close $f
@@ -3473,7 +3543,7 @@ test io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} {
puts $f $c
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set c [string length [read $f]]
set e [eof $f]
close $f
@@ -3487,7 +3557,7 @@ test io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} {
puts $f $c
close $f
set f [open $path(test1) r]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
set c [string length [read $f]]
set e [eof $f]
close $f
@@ -3501,7 +3571,7 @@ test io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} {
puts $f $c
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set c [string length [read $f]]
set e [eof $f]
close $f
@@ -3515,7 +3585,7 @@ test io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} {
puts $f $c
close $f
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
set c [string length [read $f]]
set e [eof $f]
close $f
@@ -3848,7 +3918,7 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3863,11 +3933,11 @@ test io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} {
test io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
puts $f hello\nthere\nand\rhere
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3887,7 +3957,7 @@ test io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3905,7 +3975,7 @@ test io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -3989,7 +4059,7 @@ test io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -4007,7 +4077,7 @@ test io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -4025,7 +4095,7 @@ test io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -4043,7 +4113,7 @@ test io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -4061,7 +4131,7 @@ test io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -4079,7 +4149,7 @@ test io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} {
puts $f $s
close $f
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
set l ""
lappend l [gets $f]
lappend l [gets $f]
@@ -4960,12 +5030,12 @@ test io-35.5 {Tcl_Eof, eof detection on nonblocking pipe} stdio {
test io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -4974,12 +5044,12 @@ test io-35.6 {Tcl_Eof, eof char, lf write, auto read} {
test io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -4988,12 +5058,12 @@ test io-35.7 {Tcl_Eof, eof char, lf write, lf read} {
test io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5002,12 +5072,12 @@ test io-35.8 {Tcl_Eof, eof char, cr write, auto read} {
test io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5016,12 +5086,12 @@ test io-35.9 {Tcl_Eof, eof char, cr write, cr read} {
test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5030,12 +5100,12 @@ test io-35.10 {Tcl_Eof, eof char, crlf write, auto read} {
test io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5050,7 +5120,7 @@ test io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} {
close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5065,7 +5135,7 @@ test io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} {
close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5080,7 +5150,7 @@ test io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} {
close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5095,7 +5165,7 @@ test io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} {
close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5110,7 +5180,7 @@ test io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} {
close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5125,7 +5195,7 @@ test io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} {
close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
set l [string length [read $f]]
set e [eof $f]
close $f
@@ -5148,12 +5218,12 @@ test io-35.18 {Tcl_Eof, eof char, cr write, crlf read} -body {
test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
puts $f abc\ndef
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
set l [string length [set in [read $f]]]
set e [eof $f]
close $f
@@ -5162,12 +5232,12 @@ test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -body {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
puts $f {}
close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
set l [string length [set in [read $f]]]
set e [eof $f]
close $f
@@ -5196,7 +5266,7 @@ test io-35.19 {Tcl_Eof, eof char in middle, cr write, crlf read} -body {
close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
set l [string length [set in [read $f]]]
set e [eof $f]
close $f
@@ -5211,7 +5281,7 @@ test io-35.20 {Tcl_Eof, eof char in middle, cr write, crlf read} {
close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
set l [string length [set in [read $f]]]
set e [eof $f]
close $f
@@ -5594,7 +5664,7 @@ test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
set x [read $f]
close $f
set x
-} \u7266
+} 牦
test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
@@ -5606,7 +5676,7 @@ test io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
set x [read $f]
close $f
set x
-} \u7266
+} 牦
test io-39.16 {Tcl_SetChannelOption: -encoding (shortened to "-en"), errors} -body {
file delete $path(test1)
set f [open $path(test1) w]
@@ -5702,7 +5772,7 @@ test io-39.22 {Tcl_SetChannelOption, invariance} {unix} {
lappend l [fconfigure $f1 -eofchar]
fconfigure $f1 -eofchar {ON GO}
lappend l [fconfigure $f1 -eofchar]
- fconfigure $f1 -eofchar D
+ fconfigure $f1 -eofchar {D D}
lappend l [fconfigure $f1 -eofchar]
close $f1
set l
@@ -5713,7 +5783,7 @@ test io-39.22a {Tcl_SetChannelOption, invariance} {
set l [list]
fconfigure $f1 -eofchar {ON GO}
lappend l [fconfigure $f1 -eofchar]
- fconfigure $f1 -eofchar D
+ fconfigure $f1 -eofchar {D D}
lappend l [fconfigure $f1 -eofchar]
lappend l [list [catch {fconfigure $f1 -eofchar {1 2 3}} msg] $msg]
close $f1
@@ -5752,11 +5822,11 @@ test io-40.1 {POSIX open access modes: RDWR} {
close $f
set x
} {zzy abzzy}
-test io-40.2 {POSIX open access modes: CREAT} {unix} {
+test io-40.2 {POSIX open access modes: CREAT} {unix notWsl} {
file delete $path(test3)
set f [open $path(test3) {WRONLY CREAT} 0o600]
file stat $path(test3) stats
- set x [format "0o%o" [expr {$stats(mode)&0o777}]]
+ set x [format "%#o" [expr {$stats(mode)&0o777}]]
puts $f "line 1"
close $f
set f [open $path(test3) r]
@@ -5764,7 +5834,7 @@ test io-40.2 {POSIX open access modes: CREAT} {unix} {
close $f
set x
} {0o600 {line 1}}
-test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
+test io-40.3 {POSIX open access modes: CREAT} {unix umask notWsl} {
# This test only works if your umask is 2, like ouster's.
file delete $path(test3)
set f [open $path(test3) {WRONLY CREAT}]
@@ -6086,6 +6156,70 @@ test io-44.5 {FileEventProc procedure: end of file} -constraints {
} -result {initial foo eof}
close $f
+
+test io-44.6 {FileEventProc procedure: write-only non-blocking channel} -setup {
+} -constraints {stdio fileevent openpipe} -body {
+
+ namespace eval refchan {
+ namespace ensemble create
+ namespace export *
+
+
+ proc finalize {chan args} {
+ namespace delete c_$chan
+ }
+
+ proc initialize {chan args} {
+ namespace eval c_$chan {}
+ namespace upvar c_$chan watching watching
+ set watching {}
+ list finalize initialize seek watch write
+ }
+
+
+ proc watch {chan args} {
+ namespace upvar c_$chan watching watching
+ foreach arg $args {
+ switch $arg {
+ write {
+ if {$arg ni $watching} {
+ lappend watching $arg
+ }
+ chan postevent $chan $arg
+ }
+ }
+ }
+ }
+
+
+ proc write {chan args} {
+ chan postevent $chan write
+ return 1
+ }
+ }
+ set f [chan create w [namespace which refchan]]
+ chan configure $f -blocking 0
+ set data "some data"
+ set x 0
+ chan event $f writable [namespace code {
+ puts $f $data
+ incr count [string length $data]
+ if {$count > 262144} {
+ chan event $f writable {}
+ set x done
+ }
+ }]
+ set token [after 10000 [namespace code {
+ set x timeout
+ }]]
+ vwait [namespace which -variable x]
+ return $x
+} -cleanup {
+ after cancel $token
+ catch {chan close $f}
+} -result done
+
+
makeFile "foo bar" foo
test io-45.1 {DeleteFileEvent, cleanup on close} {fileevent} {
@@ -6414,7 +6548,7 @@ test io-48.4 {lf write, testing readability, ^Z termination, auto read mode} {fi
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6442,7 +6576,7 @@ test io-48.5 {lf write, testing readability, ^Z in middle, auto read mode} {file
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6470,7 +6604,7 @@ test io-48.6 {cr write, testing readability, ^Z termination, auto read mode} {fi
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6498,7 +6632,7 @@ test io-48.7 {cr write, testing readability, ^Z in middle, auto read mode} {file
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6526,7 +6660,7 @@ test io-48.8 {crlf write, testing readability, ^Z termination, auto read mode} {
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6554,7 +6688,7 @@ test io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode} {fi
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation auto -eofchar \x1A
+ fconfigure $f -translation auto -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6582,7 +6716,7 @@ test io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} {filee
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6610,7 +6744,7 @@ test io-48.11 {lf write, testing readability, ^Z termination, lf read mode} {fil
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation lf -eofchar \x1A
+ fconfigure $f -translation lf -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6638,7 +6772,7 @@ test io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} {filee
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6666,7 +6800,7 @@ test io-48.13 {cr write, testing readability, ^Z termination, cr read mode} {fil
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation cr -eofchar \x1A
+ fconfigure $f -translation cr -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6694,7 +6828,7 @@ test io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mode} {f
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -6722,7 +6856,7 @@ test io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} {filee
set c 0
set l ""
set f [open $path(test1) r]
- fconfigure $f -translation crlf -eofchar \x1A
+ fconfigure $f -translation crlf -eofchar "\x1A \x1A"
fileevent $f readable [namespace code [list consume $f]]
variable x
vwait [namespace which -variable x]
@@ -7114,8 +7248,8 @@ test io-52.3 {TclCopyChannel} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- fconfigure $f1 -translation lf -blocking 0
- fconfigure $f2 -translation cr -blocking 0
+ fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ fconfigure $f2 -translation cr -encoding iso8859-1 -blocking 0
set s0 [fcopy $f1 $f2]
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
@@ -7155,8 +7289,8 @@ test io-52.5 {TclCopyChannel, all} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- fconfigure $f1 -translation lf -blocking 0
- fconfigure $f2 -translation lf -blocking 0
+ fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
fcopy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
@@ -7172,8 +7306,8 @@ test io-52.5a {TclCopyChannel, all, other negative value} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- fconfigure $f1 -translation lf -blocking 0
- fconfigure $f2 -translation lf -blocking 0
+ fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
fcopy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
@@ -7189,8 +7323,8 @@ test io-52.5b {TclCopyChannel, all, wrap to negative value} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- fconfigure $f1 -translation lf -blocking 0
- fconfigure $f2 -translation lf -blocking 0
+ fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
fcopy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
@@ -7206,8 +7340,8 @@ test io-52.6 {TclCopyChannel} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- fconfigure $f1 -translation lf -blocking 0
- fconfigure $f2 -translation lf -blocking 0
+ fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
set s0 [fcopy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
close $f1
@@ -7223,8 +7357,8 @@ test io-52.7 {TclCopyChannel} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- fconfigure $f1 -translation lf -blocking 0
- fconfigure $f2 -translation lf -blocking 0
+ fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ fconfigure $f2 -translation lf -encoding iso8859-1 -blocking 0
fcopy $f1 $f2
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
set s1 [file size $thisScript]
@@ -7269,7 +7403,7 @@ set path(utf8-rp.txt) [makeFile {} utf8-rp.txt]
# Create kyrillic file, use lf translation to avoid os eol issues
set out [open $path(kyrillic.txt) w]
fconfigure $out -encoding koi8-r -translation lf
-puts $out "\u0410\u0410"
+puts $out "АА"
close $out
test io-52.9 {TclCopyChannel & encodings} {fcopy} {
# Copy kyrillic to UTF-8, using fcopy.
@@ -7321,7 +7455,7 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy} {
test io-52.11 {TclCopyChannel & encodings} -setup {
set out [open $path(utf8-fcopy.txt) w]
fconfigure $out -encoding utf-8 -translation lf
- puts $out "\u0410\u0410"
+ puts $out "АА"
close $out
} -constraints {fcopy} -body {
# binary to encoding => the input has to be
@@ -7484,6 +7618,103 @@ test io-52.19 {coverage of eofChar handling} {
close $out
file size $path(test2)
} 8
+test io-52.20 {TclCopyChannel & encodings} -setup {
+ set out [open $path(utf8-fcopy.txt) w]
+ fconfigure $out -encoding utf-8 -translation lf
+ puts $out "Á"
+ close $out
+} -constraints {fcopy} -body {
+ # binary to encoding => the input has to be
+ # in utf-8 to make sense to the encoder
+
+ set in [open $path(utf8-fcopy.txt) r]
+ set out [open $path(kyrillic.txt) w]
+
+ # Using "-encoding ascii" means reading the "Á" gives an error
+ fconfigure $in -encoding ascii -strictencoding 1
+ fconfigure $out -encoding koi8-r -translation lf
+
+ fcopy $in $out
+} -cleanup {
+ close $in
+ close $out
+} -returnCodes 1 -match glob -result {error reading "file*": illegal byte sequence}
+test io-52.21 {TclCopyChannel & encodings} -setup {
+ set out [open $path(utf8-fcopy.txt) w]
+ fconfigure $out -encoding utf-8 -translation lf
+ puts $out "Á"
+ close $out
+} -constraints {fcopy} -body {
+ # binary to encoding => the input has to be
+ # in utf-8 to make sense to the encoder
+
+ set in [open $path(utf8-fcopy.txt) r]
+ set out [open $path(kyrillic.txt) w]
+
+ # Using "-encoding ascii" means writing the "Á" gives an error
+ fconfigure $in -encoding utf-8
+ fconfigure $out -encoding ascii -translation lf -strictencoding 1
+
+ fcopy $in $out
+} -cleanup {
+ close $in
+ close $out
+} -returnCodes 1 -match glob -result {error writing "file*": illegal byte sequence}
+test io-52.22 {TclCopyChannel & encodings} -setup {
+ set out [open $path(utf8-fcopy.txt) w]
+ fconfigure $out -encoding utf-8 -translation lf
+ puts $out "Á"
+ close $out
+} -constraints {fcopy} -body {
+ # binary to encoding => the input has to be
+ # in utf-8 to make sense to the encoder
+
+ set in [open $path(utf8-fcopy.txt) r]
+ set out [open $path(kyrillic.txt) w]
+
+ # Using "-encoding ascii" means reading the "Á" gives an error
+ fconfigure $in -encoding ascii -strictencoding 1
+ fconfigure $out -encoding koi8-r -translation lf
+ proc ::xxx args {
+ set ::s0 $args
+ }
+
+ fcopy $in $out -command ::xxx
+ vwait ::s0
+ set ::s0
+} -cleanup {
+ close $in
+ close $out
+ unset ::s0
+} -match glob -result {0 {error reading "file*": illegal byte sequence}}
+test io-52.23 {TclCopyChannel & encodings} -setup {
+ set out [open $path(utf8-fcopy.txt) w]
+ fconfigure $out -encoding utf-8 -translation lf
+ puts $out "Á"
+ close $out
+} -constraints {fcopy} -body {
+ # binary to encoding => the input has to be
+ # in utf-8 to make sense to the encoder
+
+ set in [open $path(utf8-fcopy.txt) r]
+ set out [open $path(kyrillic.txt) w]
+
+ # Using "-encoding ascii" means writing the "Á" gives an error
+ fconfigure $in -encoding utf-8
+ fconfigure $out -encoding ascii -translation lf -strictencoding 1
+ proc ::xxx args {
+ set ::s0 $args
+ }
+
+ fcopy $in $out -command ::xxx
+ vwait ::s0
+ set ::s0
+} -cleanup {
+ close $in
+ close $out
+ unset ::s0
+} -match glob -result {0 {error writing "file*": illegal byte sequence}}
+
test io-53.1 {CopyData} {fcopy} {
file delete $path(test1)
@@ -7501,8 +7732,8 @@ test io-53.2 {CopyData} {fcopy} {
file delete $path(test1)
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- fconfigure $f1 -translation lf -blocking 0
- fconfigure $f2 -translation cr -blocking 0
+ fconfigure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ fconfigure $f2 -translation cr -encoding iso8859-1 -blocking 0
fcopy $f1 $f2 -command [namespace code {set s0}]
set result [list [fconfigure $f1 -blocking] [fconfigure $f2 -blocking]]
variable s0
@@ -8465,7 +8696,7 @@ test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
# cut of the remainder of the error stack, especially the filename
set result [lreplace $result 3 3 [lindex [split [lindex $result 3] \n] 0]]
list $x $result
-} {1 {gets ABC catch {error writing "stdout": invalid argument}}}
+} {1 {gets ABC catch {error writing "stdout": illegal byte sequence}}}
test io-61.1 {Reset eof state after changing the eof char} -setup {
set datafile [makeFile {} eofchar]
@@ -8799,7 +9030,7 @@ test io-73.5 {effect of eof on encoding end flags} -setup {
read $rfd
} -body {
set result [eof $rfd]
- puts -nonewline $wfd "more\u00C2\u00A0data"
+ puts -nonewline $wfd more\xC2\xA0data
lappend result [eof $rfd]
lappend result [read $rfd]
lappend result [eof $rfd]
@@ -8807,7 +9038,7 @@ test io-73.5 {effect of eof on encoding end flags} -setup {
close $wfd
close $rfd
removeFile io-73.5
-} -result [list 1 1 more\u00A0data 1]
+} -result [list 1 1 more\xA0data 1]
test io-74.1 {[104f2885bb] improper cache validity check} -setup {
set fn [makeFile {} io-74.1]
@@ -8829,17 +9060,17 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup {
# The following tests 75.1 to 75.5 exercise strict or tolerant channel
# encoding.
-# TCL 8.6 only offers tolerant channel encoding, what is tested here.
+# TCL 8.7 only offers tolerant channel encoding, what is tested here.
test io-75.1 {multibyte encoding error read results in raw bytes} -setup {
set fn [makeFile {} io-75.1]
set f [open $fn w+]
fconfigure $f -encoding binary
# In UTF-8, a byte 0xCx starts a multibyte sequence and must be followed
# by a byte > 0x7F. This is violated to get an invalid sequence.
- puts -nonewline $f "A\xC0\x40"
+ puts -nonewline $f A\xC0\x40
flush $f
seek $f 0
- fconfigure $f -encoding utf-8 -buffering none
+ fconfigure $f -encoding utf-8 -nocomplainencoding 1 -buffering none
} -body {
set d [read $f]
binary scan $d H* hd
@@ -8847,33 +9078,33 @@ test io-75.1 {multibyte encoding error read results in raw bytes} -setup {
} -cleanup {
close $f
removeFile io-75.1
-} -result "41c040"
+} -result 41c040
-test io-75.2 {unrepresentable character write passes and is replaced by ?} -setup {
+test io-75.2 {unrepresentable character write passes and is replaced by ? (-nocomplainencoding 1)} -setup {
set fn [makeFile {} io-75.2]
set f [open $fn w+]
- fconfigure $f -encoding iso8859-1
+ fconfigure $f -encoding iso8859-1 -nocomplainencoding 1
} -body {
- puts -nonewline $f "A\u2022"
+ puts -nonewline $f A\u2022
flush $f
seek $f 0
read $f
} -cleanup {
close $f
removeFile io-75.2
-} -result "A?"
+} -result A?
# Incomplete sequence test.
# This error may IMHO only be detected with the close.
# But the read already returns the incomplete sequence.
-test io-75.3 {incomplete multibyte encoding read is ignored} -setup {
+test io-75.3 {incomplete multibyte encoding read is ignored (-nocomplainencoding 1)} -setup {
set fn [makeFile {} io-75.3]
set f [open $fn w+]
fconfigure $f -encoding binary
puts -nonewline $f "A\xC0"
flush $f
seek $f 0
- fconfigure $f -encoding utf-8 -buffering none
+ fconfigure $f -encoding utf-8 -buffering none -nocomplainencoding 1
} -body {
set d [read $f]
close $f
@@ -8881,20 +9112,20 @@ test io-75.3 {incomplete multibyte encoding read is ignored} -setup {
set hd
} -cleanup {
removeFile io-75.3
-} -result "41c0"
+} -result 41c0
# As utf-8 has a special treatment in multi-byte decoding, also test another
# one.
-test io-75.4 {shiftjis encoding error read results in raw bytes} -setup {
+test io-75.4 {shiftjis encoding error read results in raw bytes (-nocomplainencoding 1)} -setup {
set fn [makeFile {} io-75.4]
set f [open $fn w+]
fconfigure $f -encoding binary
# In shiftjis, \x81 starts a two-byte sequence.
# But 2nd byte \xFF is not allowed
- puts -nonewline $f "A\x81\xFFA"
+ puts -nonewline $f A\x81\xFFA
flush $f
seek $f 0
- fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf
+ fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -nocomplainencoding 1
} -body {
set d [read $f]
binary scan $d H* hd
@@ -8902,17 +9133,16 @@ test io-75.4 {shiftjis encoding error read results in raw bytes} -setup {
} -cleanup {
close $f
removeFile io-75.4
-} -result "4181ff41"
+} -result 4181ff41
-test io-75.5 {incomplete shiftjis encoding read is ignored} -setup {
+test io-75.5 {invalid utf-8 encoding read is ignored (-nocomplainencoding 1)} -setup {
set fn [makeFile {} io-75.5]
set f [open $fn w+]
fconfigure $f -encoding binary
- # \x81 announces a two byte sequence.
- puts -nonewline $f "A\x81"
+ puts -nonewline $f A\x81
flush $f
seek $f 0
- fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf
+ fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -nocomplainencoding 1
} -body {
set d [read $f]
close $f
@@ -8920,11 +9150,241 @@ test io-75.5 {incomplete shiftjis encoding read is ignored} -setup {
set hd
} -cleanup {
removeFile io-75.5
-} -result "4181"
+} -result 4181
+
+test io-75.8 {invalid utf-8 encoding eof handling (-strictencoding 1)} -setup {
+ set fn [makeFile {} io-75.8]
+ set f [open $fn w+]
+ fconfigure $f -encoding binary
+ # \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes precedence.
+ puts -nonewline $f A\x1A\x81
+ flush $f
+ seek $f 0
+ fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A -translation lf -strictencoding 1
+} -body {
+ set d [read $f]
+ binary scan $d H* hd
+ lappend hd [eof $f]
+ lappend hd [read $f]
+ close $f
+ set hd
+} -cleanup {
+ removeFile io-75.8
+} -result {41 1 {}}
+test io-75.9 {unrepresentable character write passes and is replaced by ?} -setup {
+ set fn [makeFile {} io-75.9]
+ set f [open $fn w+]
+ fconfigure $f -encoding iso8859-1 -strictencoding 1
+} -body {
+ catch {puts -nonewline $f "A\u2022"} msg
+ flush $f
+ seek $f 0
+ list [read $f] $msg
+} -cleanup {
+ close $f
+ removeFile io-75.9
+} -match glob -result [list {A} {error writing "*": illegal byte sequence}]
+
+# Incomplete sequence test.
+# This error may IMHO only be detected with the close.
+# But the read already returns the incomplete sequence.
+test io-75.10 {incomplete multibyte encoding read is ignored} -setup {
+ set fn [makeFile {} io-75.10]
+ set f [open $fn w+]
+ fconfigure $f -encoding binary
+ puts -nonewline $f A\xC0
+ flush $f
+ seek $f 0
+ fconfigure $f -encoding utf-8 -buffering none
+} -body {
+ set d [read $f]
+ close $f
+ binary scan $d H* hd
+ set hd
+} -cleanup {
+ removeFile io-75.10
+} -result 41c0
+# The current result returns the orphan byte as byte.
+# This may be expected due to special utf-8 handling.
+
+# As utf-8 has a special treatment in multi-byte decoding, also test another
+# one.
+test io-75.11 {shiftjis encoding error read results in raw bytes} -setup {
+ set fn [makeFile {} io-75.11]
+ set f [open $fn w+]
+ fconfigure $f -encoding binary
+ # In shiftjis, \x81 starts a two-byte sequence.
+ # But 2nd byte \xFF is not allowed
+ puts -nonewline $f A\x81\xFFA
+ flush $f
+ seek $f 0
+ fconfigure $f -encoding shiftjis -buffering none -eofchar "" -translation lf -strictencoding 1
+} -body {
+ set d [read $f]
+ binary scan $d H* hd
+ lappend hd [catch {set d [read $f]} msg]
+ lappend hd $msg
+} -cleanup {
+ close $f
+ removeFile io-75.11
+} -match glob -result {41 1 {error reading "*": illegal byte sequence}}
+
+test io-75.12 {invalid utf-8 encoding read is ignored} -setup {
+ set fn [makeFile {} io-75.12]
+ set f [open $fn w+]
+ fconfigure $f -encoding binary
+ puts -nonewline $f A\x81
+ flush $f
+ seek $f 0
+ fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf
+} -body {
+ set d [read $f]
+ close $f
+ binary scan $d H* hd
+ set hd
+} -cleanup {
+ removeFile io-75.12
+} -result 4181
+test io-75.13 {invalid utf-8 encoding read is not ignored (-strictencoding 1)} -setup {
+ set fn [makeFile {} io-75.13]
+ set f [open $fn w+]
+ fconfigure $f -encoding binary
+ # \x81 is invalid in utf-8
+ puts -nonewline $f "A\x81"
+ flush $f
+ seek $f 0
+ fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf -strictencoding 1
+} -body {
+ set d [read $f]
+ binary scan $d H* hd
+ lappend hd [catch {read $f} msg]
+ close $f
+ lappend hd $msg
+} -cleanup {
+ removeFile io-75.13
+} -match glob -result {41 1 {error reading "*": illegal byte sequence}}
# ### ### ### ######### ######### #########
+
+
+test io-76.0 {channel modes} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile r]
+} -constraints testchannel -body {
+ testchannel mode $f
+} -cleanup {
+ close $f
+ removeFile dummy
+} -result {read {}}
+
+test io-76.1 {channel modes} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile w]
+} -constraints testchannel -body {
+ testchannel mode $f
+} -cleanup {
+ close $f
+ removeFile dummy
+} -result {{} write}
+
+test io-76.2 {channel modes} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile r+]
+} -constraints testchannel -body {
+ testchannel mode $f
+} -cleanup {
+ close $f
+ removeFile dummy
+} -result {read write}
+
+test io-76.3 {channel mode dropping} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile r]
+} -constraints testchannel -body {
+ testchannel mremove-wr $f
+ list [testchannel mode $f] [testchannel maxmode $f]
+} -cleanup {
+ close $f
+ removeFile dummy
+} -result {{read {}} {read {}}}
+
+test io-76.4 {channel mode dropping} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile r]
+} -constraints testchannel -body {
+ testchannel mremove-rd $f
+} -returnCodes error -cleanup {
+ close $f
+ removeFile dummy
+} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
+
+test io-76.5 {channel mode dropping} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile w]
+} -constraints testchannel -body {
+ testchannel mremove-rd $f
+ list [testchannel mode $f] [testchannel maxmode $f]
+} -cleanup {
+ close $f
+ removeFile dummy
+} -result {{{} write} {{} write}}
+
+test io-76.6 {channel mode dropping} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile w]
+} -constraints testchannel -body {
+ testchannel mremove-wr $f
+} -returnCodes error -cleanup {
+ close $f
+ removeFile dummy
+} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
+
+test io-76.7 {channel mode dropping} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile r+]
+} -constraints testchannel -body {
+ testchannel mremove-rd $f
+ list [testchannel mode $f] [testchannel maxmode $f]
+} -cleanup {
+ close $f
+ removeFile dummy
+} -result {{{} write} {read write}}
+
+test io-76.8 {channel mode dropping} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile r+]
+} -constraints testchannel -body {
+ testchannel mremove-wr $f
+ list [testchannel mode $f] [testchannel maxmode $f]
+} -cleanup {
+ close $f
+ removeFile dummy
+} -result {{read {}} {read write}}
+
+test io-76.9 {channel mode dropping} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile r+]
+} -constraints testchannel -body {
+ testchannel mremove-wr $f
+ testchannel mremove-rd $f
+} -returnCodes error -cleanup {
+ close $f
+ removeFile dummy
+} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
+
+test io-76.10 {channel mode dropping} -setup {
+ set datafile [makeFile {some characters} dummy]
+ set f [open $datafile r+]
+} -constraints testchannel -body {
+ testchannel mremove-rd $f
+ testchannel mremove-wr $f
+} -returnCodes error -cleanup {
+ close $f
+ removeFile dummy
+} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"}
+
# cleanup
foreach file [list fooBar longfile script script2 output test1 pipe my_script \
test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] {
generated by cgit v0.12 at 2024-09-28 15:37:33 (GMT)