Fix bug [a173f922]: fcopy does not write leading correct chars on later encoding error.

2 files changed, 70 insertions, 1 deletions

diff --git a/generic/tclIO.c b/generic/tclIO.c
index d7b9513..b480377 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -9687,6 +9687,7 @@ CopyData(
     ChannelState *inStatePtr, *outStatePtr;
     int result = TCL_OK;
     Tcl_Size sizeb;
+    Tcl_Size sizePart;
     Tcl_WideInt total;
     Tcl_WideInt size;
     const char *buffer;
@@ -9768,6 +9769,23 @@ CopyData(
 		size = DoReadChars(inStatePtr->topChanPtr, bufObj, sizeb,
 			!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)
 			,0 /* No append */);
+		/*
+		 * In case of a recoverable encoding error, any data before
+		 * the error should be written. This data is in the bufObj.
+		 * Program flow for this case:
+		 * - Check, if there are any remaining bytes to write
+		 * - If yes, simulate a successful read to write them out
+		 * - Come back here by the outer loop and read again
+		 * - Do not enter in the if below, as there are no pending
+		 *  writes
+		 * - Fail below with a read error
+		 */
+		if (size < 0 && Tcl_GetErrno() == EILSEQ) {
+		    Tcl_GetStringFromObj(bufObj, &sizePart);
+		    if (sizePart > 0) {
+			size = sizePart;
+		    }
+		}
 	    }
 	    underflow = (size >= 0) && (size < sizeb);	/* Input underflow */
 	}
diff --git a/tests/io.test b/tests/io.test
index 5e650d5..8fb2a99 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7719,6 +7719,28 @@ test io-52.20 {TclCopyChannel & encodings} -setup {
     close $out
 } -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character}
 
+test io-52.20.2 {TclCopyChannel & encoding error on same encoding} -setup {
+    set out [open $path(utf8-fcopy.txt) w]
+    fconfigure $out -encoding utf-8 -translation lf
+    puts $out "AÁ"
+    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 -profile strict
+    fconfigure $out -encoding ascii -translation lf
+
+    fcopy $in $out
+} -cleanup {
+    close $in
+    close $out
+} -returnCodes 1 -match glob -result {error reading "file*": invalid or incomplete multibyte or wide character}
+
 test io-52.21 {TclCopyChannel & encodings} -setup {
     set out [open $path(utf8-fcopy.txt) w]
     fconfigure $out -encoding utf-8 -translation lf
@@ -7740,6 +7762,7 @@ test io-52.21 {TclCopyChannel & encodings} -setup {
     close $in
     close $out
 } -returnCodes 1 -match glob -result {error writing "file*": invalid or incomplete multibyte or wide character}
+
 test io-52.22 {TclCopyChannel & encodings} -setup {
     set out [open $path(utf8-fcopy.txt) w]
     fconfigure $out -encoding utf-8 -translation lf
@@ -7767,6 +7790,35 @@ test io-52.22 {TclCopyChannel & encodings} -setup {
     close $out
     unset ::s0
 } -match glob -result {0 {error reading "file*": invalid or incomplete multibyte or wide character}}
+
+test io-52.22.1 {TclCopyChannel & encodings & tell position} -setup {
+    set out [open $path(utf8-fcopy.txt) w]
+    fconfigure $out -encoding utf-8 -translation lf
+    puts $out "AÁ"
+    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 -profile strict
+    fconfigure $out -encoding koi8-r -translation lf
+    proc ::xxx args {
+	set ::s0 $args
+    }
+
+    fcopy $in $out -command ::xxx
+    vwait ::s0
+    list [tell $in] [tell $out] {*}[set ::s0]
+} -cleanup {
+    close $in
+    close $out
+    unset ::s0
+} -match glob -result {1 1 1 {error reading "file*": invalid or incomplete multibyte or wide character}}
+
 test io-52.23 {TclCopyChannel & encodings} -setup {
     set out [open $path(utf8-fcopy.txt) w]
     fconfigure $out -encoding utf-8 -translation lf
@@ -7818,7 +7870,6 @@ test io-52.24 {fcopy -size should always be characters} -setup {
     catch {file delete utf8-fcopy-52.24.out.txt}
 } -result Á
 
-
 test io-53.1 {CopyData} {fcopy} {
     file delete $path(test1)
     set f1 [open $thisScript]