From 45e61515f2278abcbc8ba2b7e2ac2dcf40c1eaf9 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 20 Mar 2023 22:53:33 +0000
Subject: [PATCH] Proposed fix for [154ed7ce56]: Tcl 9: [gets] on
 -strictencoding 1 configured channel. Extracted from TIP #657 branch (better
 keeping bug-fix separate from enhancements)

---
 generic/tclIO.c | 26 +++++++++++++++++++-------
 generic/tclIO.h |  2 --
 tests/io.test   | 20 ++++++++++++++++++--
 3 files changed, 37 insertions(+), 11 deletions(-)

diff --git a/generic/tclIO.c b/generic/tclIO.c
index 3f7fe86803f..9944787d4e9 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -4914,6 +4914,19 @@ Tcl_GetsObj(
 		goto done;
 	    }
 	    goto gotEOL;
+	} else if (gs.bytesWrote == 0
+		&& GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
+		&& !GotFlag(statePtr, CHANNEL_NONBLOCKING)) {
+	    /* Set eol to the position that caused the encoding error, and then
+	     * coninue to gotEOL, which stores the data that was decoded
+	     * without error to objPtr.  This allows the caller to do something
+	     * useful with the data decoded so far, and also results in the
+	     * position of the file being the first byte that was not
+	     * succesfully decoded, allowing further processing at exactly that
+	     * point, if desired.
+	     */
+	    eol = dstEnd;
+	    goto gotEOL;
 	}
 	dst = dstEnd;
     }
@@ -5030,6 +5043,11 @@ Tcl_GetsObj(
     }
     UpdateInterest(chanPtr);
     TclChannelRelease((Tcl_Channel)chanPtr);
+    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR) &&
+	    (copiedTotal == 0 || !GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
+	Tcl_SetErrno(EILSEQ);
+	copiedTotal = -1;
+    }
     return copiedTotal;
 }
 
@@ -7534,8 +7552,7 @@ Tcl_Eof(
     ChannelState *statePtr = ((Channel *) chan)->state;
 				/* State of real channel structure. */
 
-    if (GotFlag(statePtr, CHANNEL_NONBLOCKING|CHANNEL_FCOPY)
-	    && GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
+    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)) {
 	return 0;
     }
     return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0;
@@ -9751,7 +9768,6 @@ CopyData(
      * the bottom of the stack.
      */
 
-    SetFlag(inStatePtr, CHANNEL_FCOPY);
     inBinary = (inStatePtr->encoding == NULL);
     outBinary = (outStatePtr->encoding == NULL);
     sameEncoding = inStatePtr->encoding == outStatePtr->encoding
@@ -9867,7 +9883,6 @@ CopyData(
 		    TclDecrRefCount(bufObj);
 		    bufObj = NULL;
 		}
-		ResetFlag(inStatePtr, CHANNEL_FCOPY);
 		return TCL_OK;
 	    }
 	}
@@ -9959,7 +9974,6 @@ CopyData(
 		TclDecrRefCount(bufObj);
 		bufObj = NULL;
 	    }
-	    ResetFlag(inStatePtr, CHANNEL_FCOPY);
 	    return TCL_OK;
 	}
 
@@ -9982,7 +9996,6 @@ CopyData(
 		TclDecrRefCount(bufObj);
 		bufObj = NULL;
 	    }
-	    ResetFlag(inStatePtr, CHANNEL_FCOPY);
 	    return TCL_OK;
 	}
     } /* while */
@@ -10035,7 +10048,6 @@ CopyData(
 	    }
 	}
     }
-    ResetFlag(inStatePtr, CHANNEL_FCOPY);
     return result;
 }
 
diff --git a/generic/tclIO.h b/generic/tclIO.h
index 109c7702c0d..cdd96ff450b 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -236,8 +236,6 @@ typedef struct ChannelState {
 					 * flushed after every newline. */
 #define CHANNEL_UNBUFFERED	(1<<5)	/* Output to the channel must always
 					 * be flushed immediately. */
-#define CHANNEL_FCOPY	(1<<6)	/* Channel is currently doing an fcopy
-					 * mode. */
 #define BG_FLUSH_SCHEDULED	(1<<7)	/* A background flush of the queued
 					 * output buffers has been
 					 * scheduled. */
diff --git a/tests/io.test b/tests/io.test
index c3c0cddd437..cf90936f4ac 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -9155,6 +9155,22 @@ test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup {
     removeFile io-75.5
 } -result 4181
 
+test io-75.6 {invalid utf-8 encoding gets is not ignored (-profile strict)} -setup {
+    set fn [makeFile {} io-75.6]
+    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 -profile strict
+} -body {
+    gets $f
+} -cleanup {
+    close $f
+    removeFile io-75.6
+} -match glob -returnCodes 1 -result {error reading "*": illegal byte sequence}
+
 test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
     set fn [makeFile {} io-75.8]
     set f [open $fn w+]
@@ -9243,10 +9259,10 @@ test io-75.12 {invalid utf-8 encoding read is ignored} -setup {
     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 {
+    close $f
     removeFile io-75.12
 } -result 4181
 test io-75.13 {invalid utf-8 encoding read is not ignored (-profile strict)} -setup {
@@ -9262,9 +9278,9 @@ test io-75.13 {invalid utf-8 encoding read is not ignored (-profile strict)} -se
     set d [read $f]
     binary scan $d H* hd
     lappend hd [catch {read $f} msg]
-    close $f
     lappend hd $msg
 } -cleanup {
+    close $f
     removeFile io-75.13
 } -match glob -result {41 1 {error reading "*": illegal byte sequence}}