merge 8.5bug_io_32_11

5 files changed, 54 insertions, 18 deletions

diff --git a/tests/chanio.test b/tests/chanio.test
index b195f7b..2f2540e 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -41,7 +41,7 @@ namespace eval ::tcl::test::io {
 
     # You need a *very* special environment to do some tests.  In
     # particular, many file systems do not support large-files...
-    testConstraint largefileSupport 0
+    testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]
 
     # some tests can only be run is umask is 2
     # if "umask" cannot be run, the tests will be skipped.
@@ -4427,10 +4427,10 @@ test chan-io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
     chan puts -nonewline $f abcdef
     lappend l [chan tell $f]
     chan close $f
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     # truncate...
     chan close [open $path(test3) w]
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     set l
 } {0 6 6 4294967296 4294967302 4294967302 0}
 
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index dc61ac6..4ca90c6 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -104,6 +104,9 @@ test cmdAH-2.6.1 {Tcl_CdObjCmd} {
     list [catch {cd ""} msg] $msg
 } {1 {couldn't change working directory to "": no such file or directory}}
 
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+    cd .\0
+} -result "couldn't change working directory to \".\0\": no such file or directory"
 test cmdAH-2.7 {Tcl_ConcatObjCmd} {
     concat
 } {}
diff --git a/tests/io.test b/tests/io.test
index ff5554e..5f31d8e 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -41,7 +41,7 @@ testConstraint testthread       [llength [info commands testthread]]
 
 # You need a *very* special environment to do some tests.  In
 # particular, many file systems do not support large-files...
-testConstraint largefileSupport 0
+testConstraint largefileSupport [expr {$::tcl_platform(os) ne "Darwin"}]
 
 # some tests can only be run is umask is 2
 # if "umask" cannot be run, the tests will be skipped.
@@ -4019,6 +4019,26 @@ test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
 } {{hello
 } {hello
 }}
+test io-32.11.1 {Tcl_Read from a pipe} {stdio openpipe} {
+    file delete $path(pipe)
+    set f1 [open $path(pipe) w]
+    puts $f1 {chan configure stdout -translation crlf}
+    puts $f1 {puts [gets stdin]}
+    puts $f1 {puts [gets stdin]}
+    close $f1
+    set f1 [open "|[list [interpreter] $path(pipe)]" r+]
+    puts $f1 hello
+    flush $f1
+    set x ""
+    lappend x [read $f1 6]
+    puts $f1 hello
+    flush $f1
+    lappend x [read $f1]
+    close $f1
+    set x
+} {{hello
+} {hello
+}}
 test io-32.12 {Tcl_Read, -nonewline} {
     file delete $path(test1)
     set f1 [open $path(test1) w]
@@ -4492,10 +4512,10 @@ test io-34.21 {Tcl_Seek and Tcl_Tell on large files} {largefileSupport} {
     puts -nonewline $f abcdef
     lappend l [tell $f]
     close $f
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     # truncate...
     close [open $path(test3) w]
-    lappend l [file size $f]
+    lappend l [file size $path(test3)]
     set l
 } {0 6 6 4294967296 4294967302 4294967302 0}
 
@@ -4788,7 +4808,7 @@ test io-35.18a {Tcl_Eof, eof char, cr write, crlf read} -body {
     close $f
     list $s $l $e [scan [string index $in end] %c]
 } -result {9 8 1 13}
-test io-35.18b {Tcl_Eof, eof char, cr write, crlf read} -constraints knownBug -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
@@ -6884,6 +6904,7 @@ test io-52.12 {coverage of -translation auto} {
     set in [open $path(test1)]
     chan configure $in -buffersize 8
     set out [open $path(test2) w]
+    chan configure $out -translation lf
     fcopy $in $out
     close $in
     close $out
@@ -6898,6 +6919,7 @@ test io-52.13 {coverage of -translation cr} {
     set in [open $path(test1)]
     chan configure $in -buffersize 8 -translation cr
     set out [open $path(test2) w]
+    chan configure $out -translation lf
     fcopy $in $out
     close $in
     close $out
@@ -6912,6 +6934,7 @@ test io-52.14 {coverage of -translation crlf} {
     set in [open $path(test1)]
     chan configure $in -buffersize 8 -translation crlf
     set out [open $path(test2) w]
+    chan configure $out -translation lf
     fcopy $in $out
     close $in
     close $out
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index bb133f9..5a76d48 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -2038,13 +2038,13 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
 	proc foo {args} {
 	    oninit; onfinal; track;
 	    # destroy interpreter during channel access
-	    # Actually not possible for an interp to destroy itself.
-	    interp delete {}
-	    return}
+	    suicide
+	}
 	set chan [chan create {r w} foo]
 	fconfigure $chan -buffering none
 	set chan
     }]
+    interp alias $ida suicide {} interp delete $ida
 
     # Move channel to 2nd thread.
     interp eval $ida [list testchannel cut    $chan]
@@ -2063,8 +2063,7 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
 	set res
     }]
     set res
-} -constraints {testchannel impossible} \
-    -result {Owner lost}
+} -constraints {testchannel} -result {Owner lost}
 
 test iocmd-32.2 {delete interp of reflected chan} {
     # Bug 3034840
diff --git a/tests/iogt.test b/tests/iogt.test
index d4291b3..0e2eb3c 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -159,8 +159,8 @@ proc fevent {fdelay idelay blocks script data} {
 
     #puts stdout ">>>>>" ; flush stdout
 
-    uplevel #0 set sock $sk
-    set res [uplevel #0 $script]
+    uplevel 1 set sock $sk
+    set res [uplevel 1 $script]
 
     catch {close $sk}
     return $res
@@ -686,7 +686,7 @@ test iogt-2.5 {basic I/O, mixed trail} {testchannel} {
 } {}
 
 test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
-	{testchannel unknownFailure} {
+	{testchannel knownBug} {
     # This test to check the validity of aquired Tcl_Channel references is
     # not possible because even a backgrounded fcopy will immediately start
     # to copy data, without waiting for the event loop. This is done only in
@@ -703,6 +703,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
     set fin  [open $path(dummy) r]
 
     fevent 1000 500 {20 20 20 10 1 1} {
+	variable copy
 	close $fin
 
 	set          fout [open dummyout w]
@@ -740,7 +741,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} \
 } {1 {create/write create/read write flush/write flush/read delete/write delete/read}}
 
 
-test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure} {
+test iogt-4.0 {fileevent readable, after transform} {testchannel knownBug} {
     set fin  [open $path(dummy) r]
     set data [read $fin]
     close $fin
@@ -770,10 +771,11 @@ test iogt-4.0 {fileevent readable, after transform} {testchannel unknownFailure}
     }
 
     fevent 1000 500 {20 20 20 10 1} {
+	variable stop
 	audit_flow trail   -attach $sock
 	rblocks_t  rbuf trail 23 -attach $sock
 
-	fileevent $sock readable [list Get $sock]
+	fileevent $sock readable [namespace code [list Get $sock]]
 
 	flush $sock ; # now, or fcopy will error us out
 	# But the 1 second delay should be enough to
@@ -871,7 +873,7 @@ delete/write {} *ignored*
 delete/read {} *ignored*}  ; # catch unescaped quote "
 
 
-test iogt-5.0 {EOF simulation} {testchannel unknownFailure} {
+test iogt-5.0 {EOF simulation} {testchannel knownBug} {
     set fin  [open $path(dummy)    r]
     set fout [open $path(dummyout) w]
 
@@ -968,6 +970,15 @@ test iogt-6.0 {Push back} testchannel {
 } {xxx}
 
 test iogt-6.1 {Push back and up} {testchannel knownBug} {
+
+    # This test demonstrates the bug/misfeature in the stacked
+    # channel implementation that data can be discarded if it is
+    # read into the buffers of one channel in the stack, and then
+    # that channel is popped before anything above it reads.
+    #
+    # This bug can be worked around by always setting -buffersize
+    # to 1, but who wants to do that?
+
     set f [open $path(dummy) r]
 
     # contents of dummy = "abcdefghi..."