Merge 9.0core-tip-661-candidate

10 files changed, 88 insertions, 94 deletions

diff --git a/.github/workflows/linux-build.yml b/.github/workflows/linux-build.yml
index f97ec63..0379ce6 100644
--- a/.github/workflows/linux-build.yml
+++ b/.github/workflows/linux-build.yml
@@ -23,6 +23,8 @@ jobs:
           - "--enable-symbols=mem"
           - "--enable-symbols=all"
           - "CFLAGS=-ftrapv"
+          # Duplicated below
+          - "CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit"
     defaults:
       run:
         shell: bash
@@ -31,6 +33,11 @@ jobs:
       - name: Checkout
         uses: actions/checkout@v4
         timeout-minutes: 5
+      - name: Install 32-bit dependencies if needed
+        # Duplicated from above
+        if: ${{ matrix.cfgopt == 'CFLAGS=-m32 CPPFLAGS=-m32 LDFLAGS=-m32 --disable-64bit' }}
+        run: |
+          sudo apt install gcc-multilib libc6-dev-i386
       - name: Prepare
         run: |
           touch tclStubInit.c tclOOStubInit.c tclOOScript.h
diff --git a/doc/read.n b/doc/read.n
index 2add683..7c0c155 100644
--- a/doc/read.n
+++ b/doc/read.n
@@ -61,13 +61,15 @@ An encoding error is reported by the POSIX error code \fBEILSEQ\fR.
 In blocking mode, the error is directly thrown, even, if there is a
 leading decodable data portion.
 The file pointer is advanced just before the encoding error.
-An eventual well decoded data chunk before the encoding error is lost.
-It is proposed to return this portion within the additional key \fB-data\fR
-in the error dictionary.
+An eventual well decoded data chunk before the encoding error is returned
+in the error option dictionary key \fB-data\fR.
+The value of the key contains the empty string, if the error arises at the
+first data position.
 .PP
 In non blocking mode, first, any data without encoding error is returned
 (without error state).
 In the next call, no data is returned and the \fBEILSEQ\fR error state is set.
+The key \fB-data\fR is not present.
 .PP
 Here is an example with an encoding error in UTF-8 encoding, which is then
 introspected by a switch to the binary encoding. The test file contains a not
@@ -87,7 +89,7 @@ file35a65a0
 % catch {read $f} e d
 1
 % set d
--code 1 -level 0
+-data A -code 1 -level 0
 -errorstack {INNER {invokeStk1 read file35a65a0}}
 -errorcode {POSIX EILSEQ {invalid or incomplete multibyte or wide character}}
 -errorinfo {...} -errorline 1
@@ -98,6 +100,11 @@ file35a65a0
 ÃB
 % close $f
 .CE
+The already decoded data "A" is returned in the error options dictionary key
+\fB-data\fR.
+The file position is advanced on the encoding error position 1.
+The data at the error position is thus recovered by the next \fBread\fR command.
+.PP
 Non blocking example
 .
 .CS
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 338ac33..ad81de9 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4314,7 +4314,7 @@ extern const TclStubs *tclStubsPtr;
 #   ifdef TCL_NO_DEPRECATED
 #       undef Tcl_GetByteArrayFromObj
 #       define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
-                tclStubsPtr->tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr))
+                Tcl_GetBytesFromObj(NULL, (objPtr), (sizePtr))
 #   endif
 #endif
 
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 635144f..d7b9513 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -7546,6 +7546,33 @@ Tcl_Eof(
     return GotFlag(statePtr, CHANNEL_EOF) ? 1 : 0;
 }
 
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclChannelGetBlockingMode --
+ *
+ *	Returns 1 if the channel is in blocking mode (default), 0 otherwise.
+ *
+ * Results:
+ *	1 or 0, always.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclChannelGetBlockingMode(
+    Tcl_Channel chan)
+{
+    ChannelState *statePtr = ((Channel *) chan)->state;
+				/* State of real channel structure. */
+
+    return GotFlag(statePtr, CHANNEL_NONBLOCKING) ? 0 : 1;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -8170,7 +8197,7 @@ Tcl_SetChannelOption(
 	obj.length = strlen(newValue);
 	obj.typePtr = NULL;
 
-	code = TclGetWideIntFromObj(interp, &obj, &newBufferSize);
+	code = Tcl_GetWideIntFromObj(interp, &obj, &newBufferSize);
 	TclFreeInternalRep(&obj);
 
 	if (code == TCL_ERROR) {
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 7a180e6..b6fd799 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -433,7 +433,12 @@ Tcl_ReadObjCmd(
     TclChannelPreserve(chan);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead == TCL_IO_FAILURE) {
-	Tcl_DecrRefCount(resultPtr);
+	Tcl_Obj *returnOptsPtr = NULL;
+	if (TclChannelGetBlockingMode(chan)) {
+	    returnOptsPtr = Tcl_NewDictObj();
+	    Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-data", -1),
+		    resultPtr);
+	}
 	/*
 	 * TIP #219.
 	 * Capture error messages put by the driver into the bypass area and
@@ -447,6 +452,9 @@ Tcl_ReadObjCmd(
 		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	}
 	TclChannelRelease(chan);
+	if (returnOptsPtr) {
+	    Tcl_SetReturnOptions(interp, returnOptsPtr);
+	}
 	return TCL_ERROR;
     }
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 6dc35c3..f3c3f91 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3235,6 +3235,7 @@ MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
 MODULE_SCOPE double	TclCeil(const void *a);
 MODULE_SCOPE void	TclChannelPreserve(Tcl_Channel chan);
 MODULE_SCOPE void	TclChannelRelease(Tcl_Channel chan);
+MODULE_SCOPE int	TclChannelGetBlockingMode(Tcl_Channel chan);
 MODULE_SCOPE int	TclCheckArrayTraces(Tcl_Interp *interp, Var *varPtr,
 			    Var *arrayPtr, Tcl_Obj *name, int index);
 MODULE_SCOPE int	TclCheckEmptyString(Tcl_Obj *objPtr);
diff --git a/generic/tclTest.c b/generic/tclTest.c
index e5f3650..450ff12 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -2130,7 +2130,6 @@ static int UtfExtWrapper(
     } flagMap[] = {
 	{"start", TCL_ENCODING_START},
 	{"end", TCL_ENCODING_END},
-	{"stoponerror", TCL_ENCODING_STOPONERROR},
 	{"noterminate", TCL_ENCODING_NO_TERMINATE},
 	{"charlimit", TCL_ENCODING_CHAR_LIMIT},
 	{"profiletcl8", TCL_ENCODING_PROFILE_TCL8},
@@ -5769,20 +5768,7 @@ TestbytestringObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    struct {
-#if !defined(TCL_NO_DEPRECATED)
-#   if defined(_MSC_VER) && !defined(NDEBUG)
-#	pragma warning(disable:4133)
-#   elif defined(__clang__)
-#	pragma clang diagnostic push
-#	pragma clang diagnostic ignored "-Wincompatible-pointer-types"
-#   endif
-	int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */
-#else
-	Tcl_Size n;
-#endif
-	int m; /* This variable should not be overwritten */
-    } x = {0, 1};
+    Tcl_Size n;
     const char *p;
 
     if (objc != 2) {
@@ -5790,21 +5776,11 @@ TestbytestringObjCmd(
 	return TCL_ERROR;
     }
 
-    /* Next line produces a "warning: passing argument 3 of ... from incompatible pointer type",
-     * but that's on purpose: It's exactly what we are testing here */
-    p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n);
+    p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n);
     if (p == NULL) {
 	return TCL_ERROR;
     }
-#if !defined(TCL_NO_DEPRECATED) && defined(__clang__)
-#   pragma clang diagnostic pop
-#endif
-
-    if (x.m != 1) {
-	Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", (void *)NULL);
-	return TCL_ERROR;
-    }
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n));
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
     return TCL_OK;
 }
 
diff --git a/tests/binary.test b/tests/binary.test
index 299e1e0..d6a8195 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -3048,9 +3048,6 @@ test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes
 test binary-80.4 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
     testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"]
 } -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)"
-test binary-80.5 {Tcl_GetBytesFromObj} -constraints {testbytestring pointerIs64bit deprecated} -body {
-    testbytestring [string repeat A [expr 2**31]]
-} -returnCodes 1 -result "byte sequence length exceeds INT_MAX"
 
 # ----------------------------------------------------------------------
 # cleanup
diff --git a/tests/io.test b/tests/io.test
index a9e98ed..5e650d5 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -7719,36 +7719,6 @@ 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.1 {TclCopyChannel & read encoding error & 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
-
-    set l {}
-	# should fail, so 1 is added
-    lappend l [catch {fcopy $in $out}]
-	# should be at position 1, after the first correct byte, so 1 is read.
-    lappend l [tell $in]
-    # not sure, if flush required, but anyway
-    flush $out
-	# should be at position 1, after the first correct byte, so 1 is written.
-    lappend l [tell $out]
-} -cleanup {
-    close $in
-    close $out
-} -returnCodes 0 -result {1 1 1}
-
 test io-52.21 {TclCopyChannel & encodings} -setup {
     set out [open $path(utf8-fcopy.txt) w]
     fconfigure $out -encoding utf-8 -translation lf
@@ -9420,13 +9390,13 @@ test io-75.7 {
     fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf \
 	    -profile strict
 } -body {
-    list [catch {read $f} msg] $msg
+    list [catch {read $f} msg data] $msg [dict get $data -data]
 } -cleanup {
     close $f
     removeFile io-75.7
-    unset msg f fn
+    unset msg data f fn
 } -match glob -result {1 {error reading "file*":\
-    invalid or incomplete multibyte or wide character}}
+    invalid or incomplete multibyte or wide character} A}
 
 test io-75.8 {invalid utf-8 encoding eof first handling (-profile strict)} -setup {
     set fn [makeFile {} io-75.8]
@@ -9444,10 +9414,11 @@ test io-75.8 {invalid utf-8 encoding eof first handling (-profile strict)} -setu
     binary scan $d H* hd
     lappend hd [eof $f]
     lappend hd [read $f]
-    close $f
     set hd
 } -cleanup {
+    close $f
     removeFile io-75.8
+    unset f d hd
 } -result {41 1 {}}
 
 test io-75.8.eoflater {invalid utf-8 encoding eof after handling (-profile strict)} -setup {
@@ -9462,17 +9433,17 @@ test io-75.8.eoflater {invalid utf-8 encoding eof after handling (-profile stric
     fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
 	-translation lf -profile strict
 } -body {
-    set res [list [catch {read $f} msg] [eof $f]]
+    set res [list [catch {read $f} msg data] [eof $f] [dict get $data -data]]
     chan configure $f -encoding iso8859-1
     lappend res [read $f 1]
     chan configure $f -encoding utf-8
-    lappend res [catch {read $f 1} msg] $msg
+    lappend res [catch {read $f 1} msg data] $msg [dict get $data -data]
 } -cleanup {
     close $f
     removeFile io-75.8
-    unset res msg fn f
-} -match glob -result "1 0 \x81 1 {error reading \"*\":\
-    invalid or incomplete multibyte or wide character}"
+    unset res msg data fn f
+} -match glob -result "1 0 A \x81 1 {error reading \"*\":\
+    invalid or incomplete multibyte or wide character} {}"
 
 
 test io-strict-multibyte-eof {
@@ -9487,12 +9458,12 @@ test io-strict-multibyte-eof {
     seek $chan 0
     chan configure $chan -encoding utf-8 -profile strict
 } -body {
-    list [catch {read $chan 1} msg] $msg
+    list [catch {read $chan 1} msg data] $msg [dict get $data -data]
 } -cleanup {
     close $chan
-    unset msg chan
+    unset msg chan data
 } -match glob -result {1 {error reading "*":\
-    invalid or incomplete multibyte or wide character}}
+    invalid or incomplete multibyte or wide character} {}}
 
 test io-75.9 {unrepresentable character write throws error in strict profile} -setup {
     set fn [makeFile {} io-75.9]
@@ -9557,13 +9528,13 @@ test io-75.11 {shiftjis encoding error read results in error (strict profile)} -
 } -body {
     set d [read $f]
     binary scan $d H* hd
-    lappend hd [catch {set d [read $f]} msg] $msg
+    lappend hd [catch {set d [read $f]} msg data] $msg [dict exists $data -data]
 } -cleanup {
     close $f
     removeFile io-75.11
-    unset d hd msg f
+    unset d hd msg data f
 } -match glob -result {41 1 {error reading "file*":\
-    invalid or incomplete multibyte or wide character}}
+    invalid or incomplete multibyte or wide character} 0}
 
 test io-75.12 {
     invalid utf-8 encoding read is not ignored because setting the encoding to
@@ -9609,13 +9580,13 @@ test io-75.13 {
 } -body {
     set d [read $f]
     binary scan $d H* hd
-    lappend hd [catch {read $f} msg] $msg
+    lappend hd [catch {read $f} msg data] $msg [dict exists $data -data]
 } -cleanup {
     close $f
     removeFile io-75.13
-    unset d hd msg f fn
+    unset d hd msg data f fn
 } -match glob -result {41 1 {error reading "file*":\
-    invalid or incomplete multibyte or wide character}}
+    invalid or incomplete multibyte or wide character} 0}
 
 test io-75.14 {
 	[gets] succesfully returns lines prior to error
@@ -9633,16 +9604,16 @@ test io-75.14 {
 } -body {
     set res [gets $chan]
     lappend res [gets $chan]
-    lappend res [catch {gets $chan} msg] $msg
+    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
     chan configure $chan -profile tcl8
     lappend res [gets $chan]
     lappend res [gets $chan]
     return $res
 } -cleanup {
     close $chan
-    unset chan res msg
+    unset chan res msg data
 } -match glob -result {a b 1 {error reading "*":\
-    invalid or incomplete multibyte or wide character} cÀ d}
+    invalid or incomplete multibyte or wide character} 0 cÀ d}
 
 test io-75.15 {
     invalid utf-8 encoding strict
@@ -9660,8 +9631,8 @@ test io-75.15 {
     fconfigure $chan -encoding utf-8 -profile strict
     lappend res [gets $chan]
     lappend res [gets $chan]
-    lappend res [catch {gets $chan} msg] $msg
-    lappend res [catch {gets $chan} msg] $msg
+    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
+    lappend res [catch {gets $chan} msg data] $msg [dict exists $data -data]
 	chan configure $chan -translation binary
 	set data [read $chan 4]
 	foreach char [split $data {}] {
@@ -9676,7 +9647,7 @@ test io-75.15 {
     close $chan
     unset chan res msg data
 } -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
-    1 {error reading "*": invalid or incomplete multibyte or wide character} 43 44 c0 40 EF GHI}
+    0 1 {error reading "*": invalid or incomplete multibyte or wide character} 0 43 44 c0 40 EF GHI}
 
 # ### ### ### ######### ######### #########
 
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 6823a26..94129a2 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -3985,7 +3985,7 @@ test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup {
 	return $text
     }} $f]
 } -cleanup {
-    removeFile $f
+    file delete $f
 } -result [list {} "File\nContents\n"]
 test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup {
     set f [makeFile "" writeFile22.txt]
@@ -3999,7 +3999,7 @@ test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup {
 	return $text
     }} $f
 } -cleanup {
-    removeFile $f
+    file delete $f
 } -result "File\nContents\n"
 test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup {
     set f [makeFile "" writeFile23.txt]
@@ -4014,7 +4014,7 @@ test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup {
 	return $x
     }} $f
 } -cleanup {
-    removeFile $f
+    file delete $f
 } -result {0 1 2 3 4 26 27 13 10 0}
 
 # Tests of foreachLine