diff options
| -rw-r--r-- | generic/tclIO.c | 18 | ||||
| -rw-r--r-- | tests/io.test | 53 |
2 files changed, 70 insertions, 1 deletions
diff --git a/generic/tclIO.c b/generic/tclIO.c index bc1b1c6..884f4a8 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -9802,6 +9802,7 @@ CopyData( ChannelState *inStatePtr, *outStatePtr; int result = TCL_OK; Tcl_Size sizeb; + Tcl_Size sizePart; Tcl_WideInt total; int size; const char *buffer; @@ -9888,6 +9889,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 f3402f3..1525d39 100644 --- a/tests/io.test +++ b/tests/io.test @@ -7685,6 +7685,28 @@ test io-52.20.1 {TclCopyChannel & read encoding error & tell position} -setup { close $out } -returnCodes 0 -result {1 1 1} +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 @@ -7706,6 +7728,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 @@ -7733,6 +7756,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 @@ -7761,7 +7813,6 @@ test io-52.23 {TclCopyChannel & encodings} -setup { unset ::s0 } -match glob -result {0 {error writing "file*": invalid or incomplete multibyte or wide character}} - test io-53.1 {CopyData} {fcopy} { file delete $path(test1) set f1 [open $thisScript] |