From 09d84621760cae053b7278ef3dbfdbb66d0ffd23 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Thu, 6 Mar 2025 12:50:36 +0000
Subject: fixes another variant of [73bb42fb3f35cd61] (BUFFER_PADDING panic)
 with more tests; increases coverage for profile strict

---
 generic/tclIO.c |  3 ++-
 tests/io.test   | 80 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 82 insertions(+), 1 deletion(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 60e558c..d6eff8f 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -6144,7 +6144,8 @@ DoReadChars(
 	}
 
 	if (copiedNow < 0) {
-	    if (GotFlag(statePtr, CHANNEL_EOF)) {
+	    if (GotFlag(statePtr, CHANNEL_EOF) || 
+	        GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
 		break;
 	    }
 	    if ((GotFlag(statePtr, CHANNEL_NONBLOCKING) || allowShortReads)
diff --git a/tests/io.test b/tests/io.test
index 12cf8a9..04afe82 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -9828,6 +9828,86 @@ test io-76.10 {channel mode dropping} -setup {
 } -match glob -result {Tcl_RemoveChannelMode error:\
     Bad mode, would make channel inacessible. Channel: "*"}
 
+proc read_blocked {args} {
+    global e
+    set timer [after 10000 {set ::e timeout}]
+    set e ""
+    set l 1; if {[llength $args] > 1} {set l [lindex $args 1]}
+    try {
+	while {[string length $e] < $l} {
+	    append e [read {*}$args]
+	    after 10; update
+	}
+	set e
+    } finally {
+	after cancel $timer
+	unset -nocomplain e
+    }
+}
+test io-bug-73bb42fb-1 {
+    Non-blocking+buffer size+encoding error panic - TCL bug 73bb42fb.
+    Verify error at offset 0.
+} -setup {
+    writeFile $path(test1) binary \xD6[string repeat _ 20]
+} -body {
+    set fd [open $path(test1)]
+    fconfigure $fd -profile strict -blocking 0 -buffersize 10 -translation lf -eofchar {}
+    list [catch {read_blocked $fd 1} e d] $e [dict getd $d -code ""] [dict getd $d -errorcode ""] [tell $fd]
+} -cleanup {
+    close $fd
+} -match glob -result {1 {error reading *} 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}} 0}
+
+test io-bug-73bb43fb-2 {
+    Non-blocking+buffer size+encoding error panic - TCL bug 73bb42fb.
+    Verify valid data returned before error generated.
+} -setup {
+    writeFile $path(test1) binary X\xD6[string repeat _ 20]
+} -body {
+    set fd [open $path(test1)]
+    fconfigure $fd -profile strict -blocking 0 -buffersize 10 -translation lf -eofchar {}
+    set result {}
+    lappend result [read_blocked $fd]
+    lappend result [tell $fd]
+    lappend result [catch {read_blocked $fd} e d] $e [dict getd $d -code ""] [dict getd $d -errorcode ""] [tell $fd]
+} -cleanup {
+    close $fd
+} -match glob -result {X 1 1 {error reading *} 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}} 1}
+
+test io-bug-73bb43fb-3 {
+    Non-blocking+buffer size+encoding error panic - TCL bug 73bb42fb.
+    Modified Sergey's repro script from ticket. Check no crash / error.
+} -setup {
+    set f ""
+} -body {
+    set f [open [list | [info nameofexecutable] << {fconfigure stdout -translation binary; puts \xD6[string repeat _ 20]}]]
+    fconfigure $f -profile strict -blocking 0 -buffersize 10 -translation lf -eofchar {}
+    list [catch { read_blocked $f } e d] $e [dict getd $d -code ""] [dict getd $d -errorcode ""]
+} -cleanup {
+    if {$f ne ""} {close $f}
+} -match glob -result {1 {error reading *} 1 {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}}
+
+test io-bug-73bb43fb-4 {
+    Non-blocking+buffer size+encoding error panic - TCL bug 73bb42fb.
+    (PoC) Delay between bytes of single utf-8 char doesn't cause encoding error with profile strict.
+} -setup {
+    set f ""
+} -body {
+    set f [open [list | [info nameofexecutable] << {
+      fconfigure stdout -translation binary
+      puts -nonewline "START-"; flush stdout
+      foreach {ch} [split [encoding convertto \u30B3] ""] {; # 3 bytes E3 82 B3
+        puts -nonewline $ch; flush stdout; if {$ch ne "\xB3"} {after 100}
+      }
+      puts -nonewline "-DONE"; flush stdout
+    }]]
+    fconfigure $f -profile strict -blocking 0 -buffersize 10 -translation lf -eofchar {}
+    list [catch { read_blocked $f 12 } e d] $e [dict getd $d -code ""] [dict getd $d -errorcode ""]
+} -cleanup {
+    if {$f ne ""} {close $f}
+} -result "0 START-\u30B3-DONE 0 {}"
+
+rename read_blocked {}
+
 # 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] {
-- 
cgit v0.12