summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--tests/chanio.test285
-rw-r--r--tests/cmdAH.test17
-rw-r--r--tests/fCmd.test105
-rw-r--r--tests/tcltest.test15
-rw-r--r--tests/unixFCmd.test12
-rw-r--r--win/tclWinTest.c31
6 files changed, 241 insertions, 224 deletions
diff --git a/tests/chanio.test b/tests/chanio.test
index 1c689fb..81c31d8 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -8,7 +8,7 @@
#
# Copyright (c) 1991-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 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.
@@ -45,6 +45,8 @@ namespace eval ::tcl::test::io {
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...
@@ -74,7 +76,7 @@ namespace eval ::tcl::test::io {
if {$argv != ""} {
set f [open [lindex $argv 0]]
}
- chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1a
+ chan configure $f -encoding binary -translation lf -blocking 0 -eofchar \x1A
chan configure stdout -encoding binary -translation lf -buffering none
chan event $f readable "foo $f"
proc foo {f} {
@@ -110,17 +112,17 @@ set path(test1) [makeFile {} test1]
test chan-io-1.6 {Tcl_WriteChars: WriteBytes} {
set f [open $path(test1) w]
chan configure $f -encoding binary
- chan puts -nonewline $f "a\u4e4d\0"
+ chan puts -nonewline $f a\u4E4D\x00
chan close $f
contents $path(test1)
-} "a\x4d\x00"
+} aM\x00
test chan-io-1.7 {Tcl_WriteChars: WriteChars} {
set f [open $path(test1) w]
chan configure $f -encoding shiftjis
- chan puts -nonewline $f "a\u4e4d\0"
+ chan puts -nonewline $f "a\u4E4D\0"
chan close $f
contents $path(test1)
-} "a\x93\xe1\x00"
+} "a\x93\xE1\x00"
set path(test2) [makeFile {} test2]
test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
# This test written for SF bug #506297.
@@ -133,7 +135,7 @@ test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
chan close $f
contents $path(test2)
-} " \x1b\$B\$O\x1b(B"
+} " \x1B\$B\$O\x1B(B"
test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
# When closing a channel with an encoding that appends escape bytes, check
# for the case where the escape bytes overflow the current IO buffer. The
@@ -243,7 +245,7 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -bod
} -cleanup {
chan close $f
} -result "\r\n12"
-test chan-io-3.4 {WriteChars: loop over stage buffer} {
+test chan-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]
chan configure $f -encoding jis0208 -buffersize 16
@@ -251,8 +253,10 @@ test chan-io-3.4 {WriteChars: loop over stage buffer} {
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
-} [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
-test chan-io-3.5 {WriteChars: saved != 0} {
+} -cleanup {
+ catch {chan close $f}
+} -result [list "!)!)!)!)!)!)!)!)" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test chan-io-3.5 {WriteChars: saved != 0} -body {
# Bytes produced by UtfToExternal from end of last channel buffer had to
# be moved to beginning of next channel buffer to preserve requested
# buffersize.
@@ -262,24 +266,28 @@ test chan-io-3.5 {WriteChars: saved != 0} {
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
-} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
-test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} {
+} -cleanup {
+ catch {chan close $f}
+} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test chan-io-3.6 {WriteChars: (stageRead + dstWrote == 0)} -body {
# One incomplete UTF-8 character at end of staging buffer. Backup in src
# to the beginning of that UTF-8 character and try again.
#
# Translate the first 16 bytes, produce 14 bytes of output, 2 left over
- # (first two bytes of \uff21 in UTF-8). Given those two bytes try
+ # (first two bytes of \uFF21 in UTF-8). Given those two bytes try
# translating them again, find that no bytes are read produced, and break
# to outer loop where those two bytes will have the remaining 4 bytes (the
- # last byte of \uff21 plus the all of \uff22) appended.
+ # last byte of \uFF21 plus the all of \uFF22) appended.
set f [open $path(test1) w]
chan configure $f -encoding shiftjis -buffersize 16
- chan puts -nonewline $f "12345678901234\uff21\uff22"
+ chan puts -nonewline $f 12345678901234\uFF21\uFF22
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
-} [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
-test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
+} -cleanup {
+ catch {chan close $f}
+} -result [list "12345678901234\x82\x60" "12345678901234\x82\x60\x82\x61"]
+test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} -body {
# When translating UTF-8 to external, the produced bytes went past end of
# the channel buffer. This is done on purpose - we then truncate the bytes
# at the end of the partial character to preserve the requested blocksize
@@ -291,8 +299,10 @@ test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
-} [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
-test chan-io-3.8 {WriteChars: reset sawLF after each buffer} {
+} -cleanup {
+ catch {chan close $f}
+} -result [list "!)!)!)!)!)!)!)!)!" "!)!)!)!)!)!)!)!)!)!)!)!)!)!)!)"]
+test chan-io-3.8 {WriteChars: reset sawLF after each buffer} -body {
set f [open $path(test1) w]
chan configure $f -encoding ascii -buffering line -translation lf \
-buffersize 16
@@ -300,7 +310,9 @@ test chan-io-3.8 {WriteChars: reset sawLF after each buffer} {
set x [list [contents $path(test1)]]
chan close $f
lappend x [contents $path(test1)]
-} [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
+} -cleanup {
+ catch {chan close $f}
+} -result [list "abcdefg\nhijklmno" "abcdefg\nhijklmnopqrstuvwxyz"]
test chan-io-4.1 {TranslateOutputEOL: lf} {
# search for \n
@@ -416,7 +428,7 @@ test chan-io-6.3 {Tcl_GetsObj: how many have we used?} -body {
test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
- chan puts $f "\x81\u1234\0"
+ chan puts $f "\x81\u1234\x00"
chan close $f
set f [open $path(test1)]
chan configure $f -translation binary
@@ -427,14 +439,14 @@ test chan-io-6.4 {Tcl_GetsObj: encoding == NULL} -body {
test chan-io-6.5 {Tcl_GetsObj: encoding != NULL} -body {
set f [open $path(test1) w]
chan configure $f -translation binary
- chan puts $f "\x88\xea\x92\x9a"
+ chan puts $f "\x88\xEA\x92\x9A"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
list [chan gets $f line] $line
} -cleanup {
chan close $f
-} -result [list 2 "\u4e00\u4e01"]
+} -result [list 2 "\u4E00\u4E01"]
set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
@@ -462,20 +474,20 @@ test chan-io-6.7 {Tcl_GetsObj: error in input} -constraints stdio -body {
} -result {-1}
test chan-io-6.8 {Tcl_GetsObj: remember if EOF is seen} -body {
set f [open $path(test1) w]
- chan puts $f "abcdef\x1aghijk\nwombat"
+ chan puts $f "abcdef\x1Aghijk\nwombat"
chan close $f
set f [open $path(test1)]
- chan configure $f -eofchar \x1a
+ chan configure $f -eofchar \x1A
list [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
chan close $f
} -result {6 abcdef -1 {}}
test chan-io-6.9 {Tcl_GetsObj: remember if EOF is seen} -body {
set f [open $path(test1) w]
- chan puts $f "abcdefghijk\nwom\u001abat"
+ chan puts $f "abcdefghijk\nwom\u001Abat"
chan close $f
set f [open $path(test1)]
- chan configure $f -eofchar \x1a
+ chan configure $f -eofchar \x1A
list [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
chan close $f
@@ -860,7 +872,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
- chan puts -nonewline $f "\nabcd\refg\x1a"
+ chan puts -nonewline $f "\nabcd\refg\x1A"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line
} -cleanup {
@@ -878,7 +890,7 @@ test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
- chan puts -nonewline $f "abcd\refg\x1a"
+ chan puts -nonewline $f "abcd\refg\x1A"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
lappend x [chan gets $f line] $line
} -cleanup {
@@ -914,7 +926,7 @@ test chan-io-6.46 {Tcl_GetsObj: input saw cr, followed by just \n should give eo
chan configure $f -blocking 0
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
- chan puts -nonewline $f "\n\x1a"
+ chan puts -nonewline $f "\n\x1A"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
} -cleanup {
chan close $f
@@ -980,10 +992,10 @@ test chan-io-6.52 {Tcl_GetsObj: saw EOF character} -constraints {testchannel} -b
# if (eof != NULL)
set f [open $path(test1) w]
chan configure $f -translation lf
- chan puts -nonewline $f "123456\x1ak9012345\r"
+ chan puts -nonewline $f "123456\x1Ak9012345\r"
chan close $f
set f [open $path(test1)]
- chan configure $f -eofchar \x1a
+ chan configure $f -eofchar \x1A
list [chan gets $f] [testchannel queuedcr $f] [chan tell $f] [chan gets $f]
} -cleanup {
chan close $f
@@ -1011,14 +1023,14 @@ test chan-io-6.55 {Tcl_GetsObj: overconverted} -body {
# Tcl_ExternalToUtf(), make sure state updated
set f [open $path(test1) w]
chan configure $f -encoding iso2022-jp
- chan puts $f "there\u4e00ok\n\u4e01more bytes\nhere"
+ chan puts $f "there\u4E00ok\n\u4E01more bytes\nhere"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding iso2022-jp
list [chan gets $f line] $line [chan gets $f line] $line [chan gets $f line] $line
} -cleanup {
chan close $f
-} -result [list 8 "there\u4e00ok" 11 "\u4e01more bytes" 4 "here"]
+} -result [list 8 "there\u4E00ok" 11 "\u4E01more bytes" 4 "here"]
test chan-io-6.56 {Tcl_GetsObj: incomplete lines should disable file events} -setup {
update
variable x {}
@@ -1052,19 +1064,19 @@ test chan-io-7.1 {FilterInputBytes: split up character at end of buffer} -body {
# (result == TCL_CONVERT_MULTIBYTE)
set f [open $path(test1) w]
chan configure $f -encoding shiftjis
- chan puts $f "1234567890123\uff10\uff11\uff12\uff13\uff14\nend"
+ chan puts $f "1234567890123\uFF10\uFF11\uFF12\uFF13\uFF14\nend"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis -buffersize 16
chan gets $f
} -cleanup {
chan close $f
-} -result "1234567890123\uff10\uff11\uff12\uff13\uff14"
+} -result "1234567890123\uFF10\uFF11\uFF12\uFF13\uFF14"
test chan-io-7.2 {FilterInputBytes: split up character in middle of buffer} -body {
# (bufPtr->nextAdded < bufPtr->bufLength)
set f [open $path(test1) w]
chan configure $f -encoding binary
- chan puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
+ chan puts -nonewline $f "1234567890\n123\x82\x4F\x82\x50\x82"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
@@ -1077,7 +1089,7 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
} -constraints {testchannel} -body {
set f [open $path(test1) w]
chan configure $f -encoding binary
- chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
+ chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
chan close $f
set f [open $path(test1)]
chan configure $f -encoding shiftjis
@@ -1086,13 +1098,13 @@ test chan-io-7.3 {FilterInputBytes: split up character at EOF} -setup {
lappend x [chan gets $f line] $line
} -cleanup {
chan close $f
-} -result [list 15 "1234567890123\uff10\uff11" 18 0 1 -1 ""]
+} -result [list 15 "1234567890123\uFF10\uFF11" 18 0 1 -1 ""]
test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
variable x ""
} -constraints {stdio fileevent} -body {
set f [openpipe w+ $path(cat)]
chan configure $f -encoding binary -buffering none
- chan puts -nonewline $f "1234567890123\x82\x4f\x82\x50\x82"
+ chan puts -nonewline $f "1234567890123\x82\x4F\x82\x50\x82"
chan configure $f -encoding shiftjis -blocking 0
chan event $f read [namespace code {
lappend x [chan gets $f line] $line [chan blocked $f]
@@ -1105,7 +1117,7 @@ test chan-io-7.4 {FilterInputBytes: recover from split up character} -setup {
return $x
} -cleanup {
chan close $f
-} -result [list -1 "" 1 17 "1234567890123\uff10\uff11\uff12\uff13" 0]
+} -result [list -1 "" 1 17 "1234567890123\uFF10\uFF11\uFF12\uFF13" 0]
test chan-io-8.1 {PeekAhead: only go to device if no more cached data} -constraints {testchannel} -body {
# (bufPtr->nextPtr == NULL)
@@ -1200,7 +1212,7 @@ test chan-io-8.7 {PeekAhead: cleanup} -setup {
chan puts -nonewline $f "abcdefghijklmno\r"
# here
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
- chan puts -nonewline $f "\x1a"
+ chan puts -nonewline $f \x1A
lappend x [chan gets $f line] $line
} -cleanup {
chan close $f
@@ -1356,22 +1368,22 @@ test chan-io-12.4 {ReadChars: split-up char} -setup {
chan configure $f -encoding shiftjis
vwait [namespace which -variable x]
chan configure $f -encoding binary -blocking 1
- chan puts -nonewline $f "\x7b"
+ chan puts -nonewline $f \x7B
after 500 ;# Give the cat process time to catch up
chan configure $f -encoding shiftjis -blocking 0
vwait [namespace which -variable x]
return $x
} -cleanup {
chan close $f
-} -result [list "123456789012345" 1 "\u672c" 0]
+} -result [list "123456789012345" 1 \u672C 0]
test chan-io-12.5 {ReadChars: chan events on partial characters} -setup {
variable x {}
} -constraints {stdio fileevent} -body {
set path(test1) [makeFile {
chan configure stdout -encoding binary -buffering none
- chan gets stdin; chan puts -nonewline "\xe7"
- chan gets stdin; chan puts -nonewline "\x89"
- chan gets stdin; chan puts -nonewline "\xa6"
+ chan gets stdin; chan puts -nonewline \xE7
+ chan gets stdin; chan puts -nonewline \x89
+ chan gets stdin; chan puts -nonewline \xA6
} test1]
set f [openpipe r+ $path(test1)]
chan event $f readable [namespace code {
@@ -1525,7 +1537,7 @@ test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body {
chan close $f
} -result "abcd\ndef"
test chan-io-13.11 {TranslateInputEOL: EOF char} -body {
- # (*chanPtr->inEofChar != '\0')
+ # (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\ndefgh"
@@ -1537,7 +1549,7 @@ test chan-io-13.11 {TranslateInputEOL: EOF char} -body {
chan close $f
} -result "abcd\nd"
test chan-io-13.12 {TranslateInputEOL: find EOF char in src} -body {
- # (*chanPtr->inEofChar != '\0')
+ # (*chanPtr->inEofChar != '\x00')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "\r\n\r\n\r\nab\r\n\r\ndef\r\n\r\n\r\n"
@@ -1873,7 +1885,7 @@ test chan-io-20.2 {Tcl_CreateChannel: initial settings} -constraints {win} -body
list [chan configure $f -eofchar] [chan configure $f -translation]
} -cleanup {
chan close $f
-} -result [list [list \x1a ""] {auto crlf}]
+} -result [list [list \x1A ""] {auto crlf}]
test chan-io-20.3 {Tcl_CreateChannel: initial settings} -constraints {unix} -body {
set f [open $path(test1) w+]
list [chan configure $f -eofchar] [chan configure $f -translation]
@@ -3086,10 +3098,10 @@ test chan-io-30.16 {Tcl_Write ^Z at end, Tcl_Read auto} -setup {
} -body {
set f [open $path(test1) w]
chan configure $f -translation lf
- chan puts -nonewline $f hello\nthere\nand\rhere\n\x1a
+ chan puts -nonewline $f hello\nthere\nand\rhere\n\x1A
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
chan read $f
} -cleanup {
chan close $f
@@ -3102,11 +3114,11 @@ test chan-io-30.17 {Tcl_Write, implicit ^Z at end, Tcl_Read auto} -setup {
file delete $path(test1)
} -constraints {win} -body {
set f [open $path(test1) w]
- chan configure $f -eofchar \x1a -translation lf
+ chan configure $f -translation lf -eofchar \x1A
chan puts $f hello\nthere\nand\rhere
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
chan read $f
} -cleanup {
chan close $f
@@ -3124,7 +3136,7 @@ test chan-io-30.18 {Tcl_Write, ^Z in middle, Tcl_Read auto} -setup {
chan puts $f $s
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3145,7 +3157,7 @@ test chan-io-30.19 {Tcl_Write, ^Z no newline in middle, Tcl_Read auto} -setup {
chan puts $f $s
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
set l ""
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3178,7 +3190,7 @@ test chan-io-30.20 {Tcl_Write, ^Z in middle ignored, Tcl_Read lf} -setup {
lappend l [chan eof $f]
} -cleanup {
chan close $f
-} -result "abc def 0 \x1aghi 0 qrs 0 {} 1"
+} -result "abc def 0 \x1Aghi 0 qrs 0 {} 1"
test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup {
file delete $path(test1)
set l ""
@@ -3190,7 +3202,7 @@ test chan-io-30.21 {Tcl_Write, ^Z in middle ignored, Tcl_Read cr} -setup {
set f [open $path(test1) r]
chan configure $f -translation cr -eofchar {}
set x [chan gets $f]
- lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
+ lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3208,7 +3220,7 @@ test chan-io-30.22 {Tcl_Write, ^Z in middle ignored, Tcl_Read crlf} -setup {
set f [open $path(test1) r]
chan configure $f -translation crlf -eofchar {}
set x [chan gets $f]
- lappend l [string equal $x "abc\ndef\n\x1aghi\nqrs\n"]
+ lappend l [string equal $x "abc\ndef\n\x1Aghi\nqrs\n"]
lappend l [chan eof $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3223,7 +3235,7 @@ test chan-io-30.23 {Tcl_Write lf, ^Z in middle, Tcl_Read auto} -setup {
chan puts $f [format abc\ndef\n%cqrs\ntuv 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3237,7 +3249,7 @@ test chan-io-30.24 {Tcl_Write lf, ^Z in middle, Tcl_Read lf} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation lf -eofchar \x1a
+ chan configure $f -translation lf -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3251,7 +3263,7 @@ test chan-io-30.25 {Tcl_Write cr, ^Z in middle, Tcl_Read auto} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3265,7 +3277,7 @@ test chan-io-30.26 {Tcl_Write cr, ^Z in middle, Tcl_Read cr} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation cr -eofchar \x1a
+ chan configure $f -translation cr -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3279,7 +3291,7 @@ test chan-io-30.27 {Tcl_Write crlf, ^Z in middle, Tcl_Read auto} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3293,7 +3305,7 @@ test chan-io-30.28 {Tcl_Write crlf, ^Z in middle, Tcl_Read crlf} -setup {
chan puts $f $c
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation crlf -eofchar \x1a
+ chan configure $f -translation crlf -eofchar \x1A
list [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -3644,7 +3656,7 @@ test chan-io-31.18 {Tcl_Write ^Z at end, Tcl_Gets auto} -setup {
chan puts $f [format "hello\nthere\nand\rhere\n\%c" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3660,11 +3672,11 @@ test chan-io-31.19 {Tcl_Write, implicit ^Z at end, Tcl_Gets auto} -setup {
set l ""
} -body {
set f [open $path(test1) w]
- chan configure $f -eofchar \x1a -translation lf
+ chan configure $f -translation lf -eofchar \x1A
chan puts $f hello\nthere\nand\rhere
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan gets $f]
@@ -3684,8 +3696,7 @@ test chan-io-31.20 {Tcl_Write, ^Z in middle, Tcl_Gets auto, eofChar} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a
- chan configure $f -translation auto
+ chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3703,7 +3714,7 @@ test chan-io-31.21 {Tcl_Write, no newline ^Z in middle, Tcl_Gets auto, eofChar}
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3733,7 +3744,7 @@ test chan-io-31.22 {Tcl_Write, ^Z in middle ignored, Tcl_Gets lf} -setup {
lappend l [chan eof $f]
} -cleanup {
chan close $f
-} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup {
file delete $path(test1)
set l ""
@@ -3755,7 +3766,7 @@ test chan-io-31.23 {Tcl_Write, ^Z in middle ignored, Tcl_Gets cr} -setup {
lappend l [chan eof $f]
} -cleanup {
chan close $f
-} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup {
file delete $path(test1)
set l ""
@@ -3777,7 +3788,7 @@ test chan-io-31.24 {Tcl_Write, ^Z in middle ignored, Tcl_Gets crlf} -setup {
lappend l [chan eof $f]
} -cleanup {
chan close $f
-} -result "abc def 0 \x1aqrs 0 tuv 0 {} 1"
+} -result "abc def 0 \x1Aqrs 0 tuv 0 {} 1"
test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup {
file delete $path(test1)
set l ""
@@ -3787,7 +3798,7 @@ test chan-io-31.25 {Tcl_Write lf, ^Z in middle, Tcl_Gets auto} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3805,7 +3816,7 @@ test chan-io-31.26 {Tcl_Write lf, ^Z in middle, Tcl_Gets lf} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation lf -eofchar \x1a
+ chan configure $f -translation lf -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3823,7 +3834,7 @@ test chan-io-31.27 {Tcl_Write cr, ^Z in middle, Tcl_Gets auto} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3841,7 +3852,7 @@ test chan-io-31.28 {Tcl_Write cr, ^Z in middle, Tcl_Gets cr} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation cr -eofchar \x1a
+ chan configure $f -translation cr -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3859,7 +3870,7 @@ test chan-io-31.29 {Tcl_Write crlf, ^Z in middle, Tcl_Gets auto} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -3877,7 +3888,7 @@ test chan-io-31.30 {Tcl_Write crlf, ^Z in middle, Tcl_Gets crlf} -setup {
chan puts $f [format "abc\ndef\n%cqrs\ntuv" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation crlf -eofchar \x1a
+ chan configure $f -translation crlf -eofchar \x1A
lappend l [chan gets $f]
lappend l [chan gets $f]
lappend l [chan eof $f]
@@ -4633,12 +4644,12 @@ test chan-io-35.6 {Tcl_Eof, eof char, lf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
- chan configure $f -translation lf -eofchar \x1a
+ chan configure $f -translation lf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4647,12 +4658,12 @@ test chan-io-35.7 {Tcl_Eof, eof char, lf write, lf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
- chan configure $f -translation lf -eofchar \x1a
+ chan configure $f -translation lf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation lf -eofchar \x1a
+ chan configure $f -translation lf -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4661,12 +4672,12 @@ test chan-io-35.8 {Tcl_Eof, eof char, cr write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
- chan configure $f -translation cr -eofchar \x1a
+ chan configure $f -translation cr -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4675,12 +4686,12 @@ test chan-io-35.9 {Tcl_Eof, eof char, cr write, cr read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
- chan configure $f -translation cr -eofchar \x1a
+ chan configure $f -translation cr -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation cr -eofchar \x1a
+ chan configure $f -translation cr -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4689,12 +4700,12 @@ test chan-io-35.10 {Tcl_Eof, eof char, crlf write, auto read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
- chan configure $f -translation crlf -eofchar \x1a
+ chan configure $f -translation crlf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4703,12 +4714,12 @@ test chan-io-35.11 {Tcl_Eof, eof char, crlf write, crlf read} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
- chan configure $f -translation crlf -eofchar \x1a
+ chan configure $f -translation crlf -eofchar \x1A
chan puts $f abc\ndef
chan close $f
set s [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation crlf -eofchar \x1a
+ chan configure $f -translation crlf -eofchar \x1A
list $s [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4722,7 +4733,7 @@ test chan-io-35.12 {Tcl_Eof, eof char in middle, lf write, auto read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4736,7 +4747,7 @@ test chan-io-35.13 {Tcl_Eof, eof char in middle, lf write, lf read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation lf -eofchar \x1a
+ chan configure $f -translation lf -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4750,7 +4761,7 @@ test chan-io-35.14 {Tcl_Eof, eof char in middle, cr write, auto read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4764,7 +4775,7 @@ test chan-io-35.15 {Tcl_Eof, eof char in middle, cr write, cr read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation cr -eofchar \x1a
+ chan configure $f -translation cr -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4778,7 +4789,7 @@ test chan-io-35.16 {Tcl_Eof, eof char in middle, crlf write, auto read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -4792,7 +4803,7 @@ test chan-io-35.17 {Tcl_Eof, eof char in middle, crlf write, crlf read} -setup {
chan close $f
set c [file size $path(test1)]
set f [open $path(test1) r]
- chan configure $f -translation crlf -eofchar \x1a
+ chan configure $f -translation crlf -eofchar \x1A
list $c [string length [chan read $f]] [chan eof $f]
} -cleanup {
chan close $f
@@ -5162,7 +5173,7 @@ test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
} -body {
set f [open $path(test1) w]
chan configure $f -encoding {}
- chan puts -nonewline $f \xe7\x89\xa6
+ chan puts -nonewline $f \xE7\x89\xA6
chan close $f
set f [open $path(test1) r]
chan configure $f -encoding utf-8
@@ -5175,7 +5186,7 @@ test chan-io-39.15 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
} -body {
set f [open $path(test1) w]
chan configure $f -encoding binary
- chan puts -nonewline $f \xe7\x89\xa6
+ chan puts -nonewline $f \xE7\x89\xA6
chan close $f
set f [open $path(test1) r]
chan configure $f -encoding utf-8
@@ -5196,7 +5207,7 @@ test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_
} -constraints {stdio fileevent} -body {
set f [openpipe r+ $path(cat)]
chan configure $f -encoding binary
- chan puts -nonewline $f "\xe7"
+ chan puts -nonewline $f \xE7
chan flush $f
chan configure $f -encoding utf-8 -blocking 0
chan event $f readable [namespace code { lappend x [chan read $f] }]
@@ -5214,7 +5225,7 @@ test chan-io-39.17 {Tcl_SetChannelOption: -encoding, clearing CHANNEL_NEED_MORE_
return $x
} -cleanup {
chan close $f
-} -result "{} timeout {} timeout \xe7 timeout"
+} -result "{} timeout {} timeout \xE7 timeout"
test chan-io-39.18 {Tcl_SetChannelOption, setting read mode independently} \
-constraints {socket} -body {
proc accept {s a p} {chan close $s}
@@ -5333,7 +5344,7 @@ test chan-io-40.1 {POSIX open access modes: RDWR} -setup {
} -result {zzy abzzy}
test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
-} -constraints {unix} -body {
+} -constraints {unix notWsl} -body {
set f [open $path(test3) {WRONLY CREAT} 0o600]
file stat $path(test3) stats
set x [format 0o%03o [expr {$stats(mode) & 0o777}]]
@@ -5346,11 +5357,11 @@ test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
-} -constraints {unix umask} -body {
+} -constraints {unix umask notWsl} -body {
# This test only works if your umask is 2, like ouster's.
chan close [open $path(test3) {WRONLY CREAT}]
file stat $path(test3) stats
- format "0o%03o" [expr {$stats(mode) & 0o777}]
+ format 0o%03o [expr {$stats(mode) & 0o777}]
} -result [format 0o%03o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
@@ -5528,11 +5539,11 @@ test chan-io-42.2 {Tcl_FileeventCmd: replacing} {fileevent} {
} {{first script} {new script} {yet another} {}}
test chan-io-42.3 {Tcl_FileeventCmd: replacing, with NULL chars in script} {fileevent} {
set result {}
- chan event $f r "first scr\0ipt"
+ chan event $f r "first scr\x00ipt"
lappend result [string length [chan event $f readable]]
- chan event $f r "new scr\0ipt"
+ chan event $f r "new scr\x00ipt"
lappend result [string length [chan event $f readable]]
- chan event $f r "yet ano\0ther"
+ chan event $f r "yet ano\x00ther"
lappend result [string length [chan event $f readable]]
chan event $f r ""
lappend result [chan event $f readable]
@@ -5978,7 +5989,7 @@ test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6002,7 +6013,7 @@ test chan-io-48.5 {lf write, testing readability, ^Z in middle, auto read mode}
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6026,7 +6037,7 @@ test chan-io-48.6 {cr write, testing readability, ^Z termination, auto read mode
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6050,7 +6061,7 @@ test chan-io-48.7 {cr write, testing readability, ^Z in middle, auto read mode}
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6074,7 +6085,7 @@ test chan-io-48.8 {crlf write, testing readability, ^Z termination, auto read mo
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation auto -eofchar \x1a
+ chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6098,7 +6109,7 @@ test chan-io-48.9 {crlf write, testing readability, ^Z in middle, auto read mode
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation auto
+ chan configure $f -translation auto -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6122,7 +6133,7 @@ test chan-io-48.10 {lf write, testing readability, ^Z in middle, lf read mode} -
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation lf
+ chan configure $f -translation lf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6146,7 +6157,7 @@ test chan-io-48.11 {lf write, testing readability, ^Z termination, lf read mode}
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation lf -eofchar \x1a
+ chan configure $f -translation lf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6170,7 +6181,7 @@ test chan-io-48.12 {cr write, testing readability, ^Z in middle, cr read mode} -
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation cr
+ chan configure $f -translation cr -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6194,7 +6205,7 @@ test chan-io-48.13 {cr write, testing readability, ^Z termination, cr read mode}
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation cr -eofchar \x1a
+ chan configure $f -translation cr -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6218,7 +6229,7 @@ test chan-io-48.14 {crlf write, testing readability, ^Z in middle, crlf read mod
chan puts -nonewline $f [format "abc\ndef\n%cfoo\nbar\n" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -eofchar \x1a -translation crlf
+ chan configure $f -translation crlf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6242,7 +6253,7 @@ test chan-io-48.15 {crlf write, testing readability, ^Z termi, crlf read mode} -
chan puts -nonewline $f [format "abc\ndef\n%c" 26]
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation crlf -eofchar \x1a
+ chan configure $f -translation crlf -eofchar \x1A
chan event $f readable [namespace code {
if {[chan eof $f]} {
set x done
@@ -6636,8 +6647,8 @@ test chan-io-52.3 {TclCopyChannel} -constraints {fcopy} -setup {
} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -blocking 0
- chan configure $f2 -translation cr -blocking 0
+ chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0
set s0 [chan copy $f1 $f2]
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
@@ -6667,8 +6678,8 @@ test chan-io-52.5 {TclCopyChannel, all} -constraints {fcopy} -setup {
} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -blocking 0
- chan configure $f2 -translation lf -blocking 0
+ chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
chan copy $f1 $f2 -size -1 ;# -1 means 'copy all', same as if no -size specified.
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
@@ -6683,8 +6694,8 @@ test chan-io-52.5a {TclCopyChannel, all, other negative value} -setup {
} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -blocking 0
- chan configure $f2 -translation lf -blocking 0
+ chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
chan copy $f1 $f2 -size -2 ;# < 0 behaves like -1, copy all
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
@@ -6699,8 +6710,8 @@ test chan-io-52.5b {TclCopyChannel, all, wrap to negative value} -setup {
} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -blocking 0
- chan configure $f2 -translation lf -blocking 0
+ chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
chan copy $f1 $f2 -size 3221176172 ;# Wrapped to < 0, behaves like -1, copy all
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
@@ -6715,8 +6726,8 @@ test chan-io-52.6 {TclCopyChannel} -setup {
} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -blocking 0
- chan configure $f2 -translation lf -blocking 0
+ chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
set s0 [chan copy $f1 $f2 -size [expr {[file size $thisScript] + 5}]]
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
chan close $f1
@@ -6733,8 +6744,8 @@ test chan-io-52.7 {TclCopyChannel} -constraints {fcopy} -setup {
} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -blocking 0
- chan configure $f2 -translation lf -blocking 0
+ chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f2 -translation lf -encoding iso8859-1 -blocking 0
chan copy $f1 $f2
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
if {[file size $thisScript] == [file size $path(test1)]} {
@@ -6779,7 +6790,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]
chan configure $out -encoding koi8-r -translation lf
-chan puts $out "\u0410\u0410"
+chan puts $out \u0410\u0410
chan close $out
test chan-io-52.9 {TclCopyChannel & encodings} {fcopy} {
# Copy kyrillic to UTF-8, using chan copy.
@@ -6817,7 +6828,7 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
test chan-io-52.11 {TclCopyChannel & encodings} -setup {
set f [open $path(utf8-fcopy.txt) w]
fconfigure $f -encoding utf-8 -translation lf
- puts $f "\u0410\u0410"
+ puts $f \u0410\u0410
close $f
} -constraints {fcopy} -body {
# binary to encoding => the input has to be in utf-8 to make sense to the
@@ -6851,8 +6862,8 @@ test chan-io-53.2 {CopyData} -setup {
} -constraints {fcopy} -body {
set f1 [open $thisScript]
set f2 [open $path(test1) w]
- chan configure $f1 -translation lf -blocking 0
- chan configure $f2 -translation cr -blocking 0
+ chan configure $f1 -translation lf -encoding iso8859-1 -blocking 0
+ chan configure $f2 -translation cr -encoding iso8859-1 -blocking 0
chan copy $f1 $f2 -command [namespace code {set s0}]
set result [list [chan configure $f1 -blocking] [chan configure $f2 -blocking]]
variable s0
@@ -7491,7 +7502,7 @@ test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
set out [open $path(script) w]
chan puts $out "catch {load $::tcltestlib Tcltest}"
chan puts $out {
- chan puts [testbytestring \xe2]
+ chan puts [testbytestring \xE2]
exit 1
}
proc readit {pipe} {
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index bb3ad98..8d36594 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -4,8 +4,8 @@
# commands. Sourcing this file into Tcl runs the tests and generates output
# for errors. No output means no errors were found.
#
-# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1996-1998 Sun Microsystems, Inc.
+# Copyright (c) 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.
@@ -30,6 +30,7 @@ testConstraint linkDirectory [expr {
($::tcl_platform(osVersion) >= 5.0
&& [lindex [file system [temporaryDirectory]] 1] eq "NTFS")
}]
+testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]
global env
set cmdAHwd [pwd]
@@ -148,10 +149,10 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
set dir [pwd]
} -returnCodes error -body {
- cd .\0
+ cd .\x00
} -cleanup {
cd $dir
-} -match glob -result "couldn't change working directory to \".\0\": *"
+} -match glob -result "couldn't change working directory to \".\x00\": *"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
@@ -261,7 +262,7 @@ test cmdAH-6.3 {Tcl_FileObjCmd: volumes} -constraints unix -body {
test cmdAH-6.4 {Tcl_FileObjCmd: volumes} -constraints win -body {
set volumeList [string tolower [file volumes]]
set element [lsearch -exact $volumeList "c:/"]
- list [expr {$element>-1}] [glob -nocomplain [lindex $volumeList $element]*]
+ list [expr {$element>=0}] [glob -nocomplain [lindex $volumeList $element]*]
} -match glob -result {1 *}
# attributes
@@ -849,7 +850,7 @@ test cmdAH-16.2 {Tcl_FileObjCmd: readable} {
-result 1
}
test cmdAH-16.3 {Tcl_FileObjCmd: readable} {
- -constraints {unix notRoot testchmod}
+ -constraints {unix notRoot testchmod notWsl}
-setup {testchmod 0o333 $gorpfile}
-body {file readable $gorpfile}
-result 0
@@ -882,7 +883,7 @@ set gorpfile [makeFile abcde gorp.file]
test cmdAH-18.1 {Tcl_FileObjCmd: executable} -returnCodes error -body {
file executable a b
} -result {wrong # args: should be "file executable name"}
-test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot} {
+test cmdAH-18.2 {Tcl_FileObjCmd: executable} {notRoot notWsl} {
file executable $gorpfile
} 0
test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
@@ -1430,7 +1431,7 @@ test cmdAH-28.4 {Tcl_FileObjCmd: stat} -setup {
file stat $gorpfile stat
list $stat(nlink) $stat(size) $stat(type)
} -result {1 12 file}
-test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix} -setup {
+test cmdAH-28.5 {Tcl_FileObjCmd: stat} -constraints {unix notWsl} -setup {
unset -nocomplain stat
} -body {
file stat $gorpfile stat
diff --git a/tests/fCmd.test b/tests/fCmd.test
index ecb1d04..fcf5cbe 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -5,7 +5,7 @@
# for errors. No output means no errors were found.
#
# Copyright (c) 1996-1997 Sun Microsystems, Inc.
-# Copyright (c) 1999 by Scriptics Corporation.
+# Copyright (c) 1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -29,7 +29,7 @@ testConstraint winLessThan10 0
testConstraint notNetworkFilesystem 0
testConstraint reg 0
if {[testConstraint win]} {
- catch {
+ if {[catch {
# Is the registry extension already static to this shell?
try {
load {} Registry
@@ -40,9 +40,14 @@ if {[testConstraint win]} {
load $::reglib Registry
}
testConstraint reg 1
+ } regError]} {
+ catch {package require registry; testConstraint reg 1}
}
}
+# File permissions broken on wsl without some "exotic" wsl configuration
+testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]
+
set tmpspace /tmp;# default value
# Find a group that exists on this Unix system, or else skip tests that
# require Unix groups.
@@ -281,7 +286,7 @@ test fCmd-3.14 {FileCopyRename: FileBasename fails} -setup {
file mkdir td1
file rename ~_totally_bogus_user td1
} -result {user "_totally_bogus_user" doesn't exist}
-test fCmd-3.15 {FileCopyRename: source[0] == '\0'} -setup {
+test fCmd-3.15 {FileCopyRename: source[0] == '\x00'} -setup {
cleanup
} -constraints {notRoot unixOrWin} -returnCodes error -body {
file mkdir td1
@@ -323,7 +328,7 @@ test fCmd-4.4 {TclFileMakeDirsCmd: Tcl_TranslateFileName fails} -setup {
} -constraints {notRoot} -returnCodes error -body {
file mkdir ~_totally_bogus_user
} -result {user "_totally_bogus_user" doesn't exist}
-test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\0'} -setup {
+test fCmd-4.5 {TclFileMakeDirsCmd: Tcl_SplitPath returns 0: *name == '\x00'} -setup {
cleanup
} -constraints {notRoot} -returnCodes error -body {
file mkdir ""
@@ -364,7 +369,7 @@ test fCmd-4.10 {TclFileMakeDirsCmd: exists, is dir} -setup {
} -result {1 1}
test fCmd-4.11 {TclFileMakeDirsCmd: doesn't exist: errno != ENOENT} -setup {
cleanup
-} -constraints {unix notRoot testchmod} -returnCodes error -body {
+} -constraints {unix notRoot testchmod notWsl} -returnCodes error -body {
file mkdir td1/td2/td3
testchmod 0 td1/td2
file mkdir td1/td2/td3/td4
@@ -382,7 +387,7 @@ test fCmd-4.13 {TclFileMakeDirsCmd: doesn't exist: errno == ENOENT} -setup {
test fCmd-4.14 {TclFileMakeDirsCmd: TclpCreateDirectory fails} -setup {
cleanup
file delete -force foo
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir foo
file attr foo -perm 0o40000
file mkdir foo/tf1
@@ -394,7 +399,7 @@ test fCmd-4.16 {TclFileMakeDirsCmd: TclpCreateDirectory succeeds} -setup {
} -constraints {notRoot} -body {
file mkdir tf1
file exists tf1
-} -result {1}
+} -result 1
test fCmd-5.1 {TclFileDeleteCmd: FileForceOption fails} -constraints {notRoot} -body {
file delete -xyz
@@ -507,7 +512,7 @@ test fCmd-6.5 {CopyRenameOneFile: lstat(target) != 0} -setup {
} -result {tf2}
test fCmd-6.6 {CopyRenameOneFile: errno != ENOENT} -setup {
cleanup
-} -constraints {unix notRoot testchmod} -body {
+} -constraints {unix notRoot testchmod notWsl} -body {
file mkdir td1
testchmod 0 td1
createfile tf1
@@ -626,7 +631,7 @@ test fCmd-6.22 {CopyRenameOneFile: copy/rename: !S_ISDIR(source)} -setup {
} -result [file join $tmpspace tf1]
test fCmd-6.23 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
cleanup $tmpspace
-} -constraints {xdev notRoot} -body {
+} -constraints {xdev notRoot notWsl} -body {
file mkdir td1/td2/td3
file attributes td1 -permissions 0o000
file rename td1 $tmpspace
@@ -678,7 +683,7 @@ test fCmd-6.27 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
} -match glob -result {error renaming "td1" to "/tmp/tcl*/td1": file already exists}
test fCmd-6.28 {CopyRenameOneFile: TclpCopyDirectory failed} -setup {
cleanup $tmpspace
-} -constraints {notRoot xdev} -body {
+} -constraints {notRoot xdev notWsl} -body {
file mkdir td1/td2/td3
file attributes td1/td2/td3 -permissions 0o000
file rename td1 $tmpspace
@@ -695,7 +700,7 @@ test fCmd-6.29 {CopyRenameOneFile: TclpCopyDirectory passed} -setup {
} -result [file join $tmpspace td1 td2]
test fCmd-6.30 {CopyRenameOneFile: TclpRemoveDirectory failed} -setup {
cleanup $tmpspace
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir foo/bar
file attr foo -perm 0o40555
file rename foo/bar $tmpspace
@@ -770,7 +775,7 @@ test fCmd-8.3 {file copy and path translation: ensure correct error} -body {
test fCmd-9.1 {file rename: comprehensive: EACCES} -setup {
cleanup
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir td1
file mkdir td2
file attr td2 -perm 0o40000
@@ -807,7 +812,7 @@ test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup {
} -result {{td3 td4} 1 0}
test fCmd-9.4.b {file rename: comprehensive: dir to new name} -setup {
cleanup
-} -constraints {unix notRoot testchmod notDarwin9} -body {
+} -constraints {unix notRoot testchmod notDarwin9 notWsl} -body {
file mkdir td1 td2
testchmod 0o555 td2
file rename td1 td3
@@ -838,7 +843,7 @@ test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
} -result {{td1 td2} 1 0}
test fCmd-9.6.b {file rename: comprehensive: dir to self} -setup {
cleanup
-} -constraints {unix notRoot testchmod} -body {
+} -constraints {unix notRoot testchmod notWsl} -body {
file mkdir td1
file mkdir td2
testchmod 0o555 td2
@@ -1046,7 +1051,7 @@ test fCmd-10.2 {file copy: comprehensive: file to new name} -setup {
} -result {{tf1 tf2 tf3 tf4} tf1 tf2 1 0}
test fCmd-10.3 {file copy: comprehensive: dir to new name} -setup {
cleanup
-} -constraints {unix notRoot testchmod} -body {
+} -constraints {unix notRoot testchmod notWsl} -body {
file mkdir [file join td1 tdx]
file mkdir [file join td2 tdy]
testchmod 0o555 td2
@@ -1133,7 +1138,7 @@ test fCmd-10.5 {file copy: comprehensive: dir to empty dir} -setup {
} -result [subst {{td1 td2 tdd1 tdd2 tdd3 tdd4 tds1 tds2 tds3 tds4} {1 {error copying "td1" to "[file join td2 td1]": file already exists}} {1 {error copying "tds1" to "[file join tdd1 tds1]": file already exists}} 1 1 1}]
test fCmd-10.6 {file copy: comprehensive: dir to non-empty dir} -setup {
cleanup
-} -constraints {notRoot unixOrWin testchmod} -body {
+} -constraints {notRoot unixOrWin testchmod notWsl} -body {
file mkdir tds1
file mkdir tds2
file mkdir [file join tdd1 tds1 xxx]
@@ -1157,7 +1162,7 @@ test fCmd-10.7 {file rename: comprehensive: file to new name and dir} -setup {
} -result [subst {{tf1 tf2} {[file join td1 tf3] [file join td1 tf4]} 1 0}]
test fCmd-10.8 {file rename: comprehensive: dir to new name and dir} -setup {
cleanup
-} -constraints {unix notRoot testchmod} -body {
+} -constraints {unix notRoot testchmod notWsl} -body {
file mkdir td1
file mkdir td2
file mkdir td3
@@ -1249,7 +1254,7 @@ test fCmd-11.5 {TclFileRenameCmd: > 1 source & target is not a dir} -setup {
catch {file rename tfa1 tfa2 tfa3}
} -cleanup {
file delete tfa1 tfa2 tfa3
-} -result {1}
+} -result 1
test fCmd-11.6 {TclFileRenameCmd: : single file into directory} -setup {
catch {file delete -force -- tfa1 tfad}
} -constraints {notRoot} -body {
@@ -1294,7 +1299,7 @@ test fCmd-12.1 {renamefile: source filename translation failing} -setup {
catch {file rename ~/tfa1 tfa2}
} -cleanup {
set ::env(HOME) $temp
-} -result {1}
+} -result 1
test fCmd-12.2 {renamefile: src filename translation failing} -setup {
set temp $::env(HOME)
} -constraints {notRoot} -body {
@@ -1306,7 +1311,7 @@ test fCmd-12.2 {renamefile: src filename translation failing} -setup {
} -cleanup {
set ::env(HOME) $temp
file delete -force tfad
-} -result {1}
+} -result 1
test fCmd-12.3 {renamefile: stat failing on source} -setup {
catch {file delete -force -- tfa1 tfa2}
} -constraints {notRoot} -body {
@@ -1351,10 +1356,10 @@ test fCmd-12.7 {renamefile: renaming directory into offspring} -setup {
catch {file rename tfad tfad/dir}
} -cleanup {
file delete -force tfad
-} -result {1}
+} -result 1
test fCmd-12.8 {renamefile: generic error} -setup {
catch {file delete -force -- tfa}
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir tfa
file mkdir tfa/dir
file attributes tfa -permissions 0o555
@@ -1362,7 +1367,7 @@ test fCmd-12.8 {renamefile: generic error} -setup {
} -cleanup {
catch {file attributes tfa -permissions 0o777}
file delete -force tfa
-} -result {1}
+} -result 1
test fCmd-12.9 {renamefile: moving a file across volumes} -setup {
cleanup $tmpspace
} -constraints {unix notRoot} -body {
@@ -1424,7 +1429,7 @@ test fCmd-13.5 {TclCopyFilesCmd: target filename translation failing} -setup {
catch { file copy tfa ~/foobar }
} -cleanup {
set ::env(HOME) $temp
-} -result {1}
+} -result 1
test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
catch {file delete -force -- tfa1 tfa2 tfa3}
} -constraints {notRoot} -body {
@@ -1434,7 +1439,7 @@ test fCmd-13.6 {TclCopyFilesCmd: > 1 source & target is not a dir} -setup {
catch {file copy tfa1 tfa2 tfa3}
} -cleanup {
file delete tfa1 tfa2 tfa3
-} -result {1}
+} -result 1
test fCmd-13.7 {TclCopyFilesCmd: single file into directory} -setup {
catch {file delete -force -- tfa1 tfad}
} -constraints {notRoot} -body {
@@ -1480,7 +1485,7 @@ test fCmd-14.1 {copyfile: source filename translation failing} -setup {
catch {file copy ~/tfa1 tfa2}
} -cleanup {
set ::env(HOME) $temp
-} -result {1}
+} -result 1
test fCmd-14.2 {copyfile: dst filename translation failing} -setup {
set temp $::env(HOME)
} -constraints {notRoot} -body {
@@ -1541,14 +1546,14 @@ test fCmd-14.7 {copyfile: copy directory succeeding} -setup {
} -result {1 1}
test fCmd-14.8 {copyfile: copy directory failing} -setup {
catch {file delete -force -- tfa}
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir tfa/dir/a/b/c
file attributes tfa/dir -permissions 0o000
catch {file copy tfa tfa2}
} -cleanup {
file attributes tfa/dir -permissions 0o777
file delete -force tfa tfa2
-} -result {1}
+} -result 1
#
# Coverage tests for TclMkdirCmd()
@@ -1561,7 +1566,7 @@ test fCmd-15.1 {TclMakeDirsCmd: target filename translation failing} -setup {
catch {file mkdir ~/tfa}
} -cleanup {
set ::env(HOME) $temp
-} -result {1}
+} -result 1
#
# Can Tcl_SplitPath return argc == 0? If so them we need a test for that code.
#
@@ -1572,7 +1577,7 @@ test fCmd-15.2 {TclMakeDirsCmd - one directory} -setup {
file isdirectory tfa
} -cleanup {
file delete tfa
-} -result {1}
+} -result 1
test fCmd-15.3 {TclMakeDirsCmd: - two directories} -setup {
catch {file delete -force -- tfa1 tfa2}
} -constraints {notRoot} -body {
@@ -1591,7 +1596,7 @@ test fCmd-15.4 {TclMakeDirsCmd - stat failing} -setup {
} -cleanup {
file attributes tfa -permissions 0o777
file delete -force tfa
-} -result {1}
+} -result 1
test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup {
catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
@@ -1599,7 +1604,7 @@ test fCmd-15.5 {TclMakeDirsCmd: - making a directory several levels deep} -setup
file isdir tfa/a/b/c
} -cleanup {
file delete -force tfa
-} -result {1}
+} -result 1
test fCmd-15.6 {TclMakeDirsCmd: - trying to overwrite a file} -setup {
catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
@@ -1623,7 +1628,7 @@ test fCmd-15.8 {TclFileMakeDirsCmd: trying to create an existing dir} -body {
file isdir tfa
} -constraints {notRoot} -cleanup {
file delete tfa
-} -result {1}
+} -result 1
# Coverage tests for TclDeleteFilesCommand()
test fCmd-16.1 {test the -- argument} -constraints {notRoot} -setup {
@@ -1647,7 +1652,7 @@ test fCmd-16.3 {test bad option} -constraints {notRoot} -setup {
catch {file delete -dog tfa}
} -cleanup {
file delete tfa
-} -result {1}
+} -result 1
test fCmd-16.4 {accept zero files (TIP 323)} -body {
file delete
} -result {}
@@ -1662,7 +1667,7 @@ test fCmd-16.6 {delete: source filename translation failing} -setup {
catch {file delete ~/tfa}
} -cleanup {
set ::env(HOME) $temp
-} -result {1}
+} -result 1
test fCmd-16.7 {remove a non-empty directory without -force} -setup {
catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
@@ -1671,7 +1676,7 @@ test fCmd-16.7 {remove a non-empty directory without -force} -setup {
catch {file delete tfa}
} -cleanup {
file delete -force tfa
-} -result {1}
+} -result 1
test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup {
catch {file delete -force -- tfa}
} -body {
@@ -1680,10 +1685,10 @@ test fCmd-16.8 {remove a normal file} -constraints {notRoot} -setup {
catch {file delete tfa}
} -cleanup {
file delete -force tfa
-} -result {1}
+} -result 1
test fCmd-16.9 {error while deleting file} -setup {
catch {file delete -force -- tfa}
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir tfa
createfile tfa/a
file attributes tfa -permissions 0o555
@@ -1696,7 +1701,7 @@ test fCmd-16.9 {error while deleting file} -setup {
} -cleanup {
file attributes tfa -permissions 0o777
file delete -force tfa
-} -result {1}
+} -result 1
test fCmd-16.10 {deleting multiple files} -constraints {notRoot} -setup {
catch {file delete -force -- tfa1 tfa2}
} -body {
@@ -1714,14 +1719,14 @@ test fCmd-16.11 {TclFileDeleteCmd: removing a nonexistant file} -setup {
# More coverage tests for mkpath()
test fCmd-17.1 {mkdir stat failing on target but not ENOENT} -setup {
catch {file delete -force -- tfa1}
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir tfa1
file attributes tfa1 -permissions 0o555
catch {file mkdir tfa1/tfa2}
} -cleanup {
file attributes tfa1 -permissions 0o777
file delete -force tfa1
-} -result {1}
+} -result 1
test fCmd-17.2 {mkdir several levels deep - relative} -setup {
catch {file delete -force -- tfa}
} -constraints {notRoot} -body {
@@ -1738,7 +1743,7 @@ test fCmd-17.3 {mkdir several levels deep - absolute} -setup {
file isdir $f
} -cleanup {
file delete $f [file join [pwd] tfa]
-} -result {1}
+} -result 1
#
# Functionality tests for TclFileRenameCmd()
@@ -1899,7 +1904,7 @@ test fCmd-18.15 {TclFileRenameCmd : rename a file to a symlink dir} -setup {
checkcontent tfa1/tfa2 $s
} -cleanup {
file delete -force tfa1 tfalink
-} -result {1}
+} -result 1
test fCmd-18.16 {TclFileRenameCmd: rename a dangling symlink} -setup {
catch {file delete -force -- tfa1 tfalink}
} -constraints {unix notRoot} -body {
@@ -1924,7 +1929,7 @@ test fCmd-19.1 {remove empty directory} -constraints {notRoot} -setup {
} -result {0}
test fCmd-19.2 {rmdir error besides EEXIST} -setup {
catch {file delete -force -- tfa}
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir tfa
file mkdir tfa/a
file attributes tfa -permissions 0o555
@@ -1932,7 +1937,7 @@ test fCmd-19.2 {rmdir error besides EEXIST} -setup {
} -cleanup {
file attributes tfa -permissions 0o777
file delete -force tfa
-} -result {1}
+} -result 1
test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
catch {file delete -force -- tfa}
} -body {
@@ -1952,7 +1957,7 @@ test fCmd-19.3 {recursive remove} -constraints {notRoot} -setup {
#
test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -setup {
catch {file delete -force -- tfa}
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir tfa
file mkdir tfa/a
file attributes tfa/a -permissions 0o000
@@ -1960,7 +1965,7 @@ test fCmd-20.1 {TraverseUnixTree : failure opening a subdirectory directory} -se
} -cleanup {
file attributes tfa/a -permissions 0o777
file delete -force tfa
-} -result {1}
+} -result 1
test fCmd-20.2 {TraverseUnixTree : recursive delete of large directory: Bug 1034337} -setup {
catch {file delete -force -- tfa}
} -constraints {unix notRoot} -body {
@@ -2013,7 +2018,7 @@ test fCmd-21.4 {copy : more than one source and target is not a directory} -setu
catch {file copy tfa1 tfa2 tfa3}
} -cleanup {
file delete tfa1 tfa2 tfa3
-} -result {1}
+} -result 1
test fCmd-21.5 {copy : multiple files into directory} -constraints {notRoot} -setup {
catch {file delete -force -- tfa1 tfa2 tfad}
} -body {
@@ -2138,7 +2143,7 @@ test fCmd-22.2 {TclpRenameFile: attempt to overwrite itself} -setup {
checkcontent tfa1 $s
} -cleanup {
file delete tfa1
-} -result {1}
+} -result 1
test fCmd-22.3 {TclpRenameFile: rename dir to existing dir} -setup {
catch {file delete -force -- d1 tfad}
} -constraints {notRoot} -body {
@@ -2598,7 +2603,7 @@ test fCmd-30.2 {file readable on 'NTUSER.DAT'} -constraints {win} -body {
expr {[info exists env(USERPROFILE)]
&& [file exists $env(USERPROFILE)/NTUSER.DAT]
&& [file readable $env(USERPROFILE)/NTUSER.DAT]}
-} -result {1}
+} -result 1
# At least one CI environment (GitHub Actions) is set up with the page file in
# an unusual location; skip the test if that is so.
test fCmd-30.3 {file readable on 'pagefile.sys'} -constraints {
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 9da14de..750a20d 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -2,8 +2,8 @@
# 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) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2000 by Ajuba Solutions
+# Copyright (c) 1998-1999 Scriptics Corporation.
+# Copyright (c) 2000 Ajuba Solutions
# All rights reserved.
# Note that there are several places where the value of
@@ -22,6 +22,9 @@ if {[catch {package require tcltest 2.1}]} {
return
}
+# File permissions broken on wsl without some "exotic" wsl configuration
+testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]
+
namespace eval ::tcltest::test {
namespace import ::tcltest::*
@@ -306,7 +309,7 @@ test tcltest-5.3 {testConstraint - constraint empty (tcltest::safeFetch)} {
#}
test tcltest-5.5 {InitConstraints: list of built-in constraints} \
- -constraints {!singleTestInterp} \
+ -constraints {!singleTestInterp notWsl} \
-setup {tcltest::InitConstraints} \
-body { lsort [array names ::tcltest::testConstraints] } \
-result [lsort {
@@ -556,7 +559,7 @@ switch -- $::tcl_platform(platform) {
}
}
test tcltest-8.3 {tcltest a.tcl -tmpdir notReadableDir} {
- -constraints {unix notRoot}
+ -constraints {unix notRoot notWsl}
-body {
child msg $a -tmpdir $notReadableDir
return $msg
@@ -572,7 +575,7 @@ testConstraint notFAT [expr {
}]
# FAT/NTFS permissions are fairly hopeless; ignore this test if that FS is used
test tcltest-8.4 {tcltest a.tcl -tmpdir notWriteableDir} {
- -constraints {unixOrWin notRoot notFAT}
+ -constraints {unixOrWin notRoot notFAT notWsl}
-body {
child msg $a -tmpdir $notWriteableDir
return $msg
@@ -645,7 +648,7 @@ test tcltest-8.11 {tcltest a.tcl -testdir thisdirectoryisafile} {
-result {*not a directory*}
}
test tcltest-8.12 {tcltest a.tcl -testdir notReadableDir} {
- -constraints {unix notRoot}
+ -constraints {unix notRoot notWsl}
-body {
child msg $a -testdir $notReadableDir
return $msg
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 4b1687f..7389cc7 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -18,6 +18,8 @@ if {"::tcltest" ni [namespace children]} {
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testchmod [llength [info commands testchmod]]
+# File permissions broken on wsl without some "exotic" wsl configuration
+testConstraint notWsl [expr {[llength [array names ::env *WSL*]] == 0}]
# These tests really need to be run from a writable directory, which
# it is assumed [temporaryDirectory] is.
@@ -94,7 +96,7 @@ if {[testConstraint unix] && [testConstraint notRoot]} {
test unixFCmd-1.1 {TclpRenameFile: EACCES} -setup {
cleanup
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir td1/td2/td3
file attributes td1/td2 -permissions 0o000
file rename td1/td2/td3 td2
@@ -135,7 +137,7 @@ test unixFCmd-1.6 {TclpRenameFile: ENOTDIR} {emptyTest unix notRoot} {
} {}
test unixFCmd-1.7 {TclpRenameFile: EXDEV} -setup {
cleanup
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
file mkdir foo/bar
file attr foo -perm 0o40555
file rename foo/bar /tmp
@@ -219,7 +221,7 @@ test unixFCmd-2.4 {TclpCopyFile: src is fifo} -setup {
} -result {fifo fifo}
test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup {
cleanup
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
close [open tf1 a]
file attributes tf1 -permissions 0o472
file copy tf1 tf2
@@ -334,7 +336,7 @@ test unixFCmd-16.3 {SetOwnerAttribute - invalid owner} -setup {
test unixFCmd-17.1 {SetPermissionsAttribute} -setup {
catch {file delete -force -- foo.test}
-} -constraints {unix notRoot} -body {
+} -constraints {unix notRoot notWsl} -body {
close [open foo.test w]
list [file attributes foo.test -permissions 0o000] \
[format 0o%03o [file attributes foo.test -permissions]]
@@ -366,7 +368,7 @@ test unixFCmd-17.4 {SetPermissionsAttribute} -setup {
close [open foo.test w]
set ::i 4
proc permcheck {testnum permList expected} {
- test $testnum {SetPermissionsAttribute} {unix notRoot} {
+ test $testnum {SetPermissionsAttribute} {unix notRoot notWsl} {
set result {}
foreach permstr $permList {
file attributes foo.test -permissions $permstr
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index 0b4c8f6..d70d217 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -31,21 +31,14 @@
* Forward declarations of functions defined later in this file:
*/
-static int TesteventloopCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
-static int TestvolumetypeCmd(ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
-static int TestwinclockCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
-static int TestwinsleepCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
-static int TestSizeCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
+static Tcl_ObjCmdProc TesteventloopCmd;
+static Tcl_ObjCmdProc TestvolumetypeCmd;
+static Tcl_ObjCmdProc TestwinclockCmd;
+static Tcl_ObjCmdProc TestwinsleepCmd;
+static Tcl_ObjCmdProc TestSizeCmd;
static Tcl_ObjCmdProc TestExceptionCmd;
static int TestplatformChmod(const char *nativePath, int pmode);
-static int TestchmodCmd(ClientData dummy, Tcl_Interp* interp,
- int objc, Tcl_Obj *const objv[]);
+static Tcl_ObjCmdProc TestchmodCmd;
/*
*----------------------------------------------------------------------
@@ -111,6 +104,7 @@ TesteventloopCmd(
static int *framePtr = NULL;/* Pointer to integer on stack frame of
* innermost invocation of the "wait"
* subcommand. */
+ (void)clientData;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ...");
@@ -300,6 +294,7 @@ TestwinsleepCmd(
Tcl_Obj *const * objv) /* Parameter vector */
{
int ms;
+ (void)clientData;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "ms");
@@ -385,6 +380,7 @@ TestExceptionCmd(
EXCEPTION_GUARD_PAGE, EXCEPTION_INVALID_HANDLE, CONTROL_C_EXIT
};
int cmd;
+ (void)dummy;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 0, objv, "<type-of-exception>");
@@ -411,7 +407,6 @@ TestExceptionCmd(
/* SMASH! */
RaiseException(exceptions[cmd], EXCEPTION_NONCONTINUABLE, 0, NULL);
- /* NOTREACHED */
return TCL_OK;
}
@@ -451,7 +446,6 @@ TestplatformChmod(
DWORD attr, newAclSize;
PACL newAcl = NULL;
int res = 0;
- SID_IDENTIFIER_AUTHORITY worldAuthority = SECURITY_WORLD_SID_AUTHORITY;
HANDLE hToken = NULL;
int i;
@@ -483,7 +477,7 @@ TestplatformChmod(
GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
goto done;
}
- pTokenUser = ckalloc(dw);
+ pTokenUser = (TOKEN_USER *)ckalloc(dw);
if (!GetTokenInformation(hToken, TokenUser, pTokenUser, dw, &dw)) {
goto done;
}
@@ -525,7 +519,7 @@ TestplatformChmod(
GetLastError() != ERROR_INSUFFICIENT_BUFFER) {
goto done;
}
- pTokenGroup = ckalloc(dw);
+ pTokenGroup = (TOKEN_PRIMARY_GROUP *)ckalloc(dw);
if (!GetTokenInformation(hToken, TokenPrimaryGroup, pTokenGroup, dw, &dw)) {
ckfree(pTokenGroup);
goto done;
@@ -592,7 +586,7 @@ TestplatformChmod(
newAclSize +=
offsetof(ACCESS_ALLOWED_ACE, SidStart) + aceEntry[i].sidLen;
}
- newAcl = ckalloc(newAclSize);
+ newAcl = (PACL)ckalloc(newAclSize);
if (!InitializeAcl(newAcl, newAclSize, ACL_REVISION)) {
goto done;
}
@@ -668,6 +662,7 @@ TestchmodCmd(
Tcl_Obj *const * objv) /* Parameter vector */
{
int i, mode;
+ (void)dummy;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "mode file ?file ...?");
generated by cgit v0.12 at 2024-11-14 05:37:46 (GMT)