Merge 9.0core-tip-661-candidate

5 files changed, 42 insertions, 30 deletions

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;
 }