Merge 8.7

Add Unsigned functions to the implementation. TIP text is still far behind describing what's going on here.

6 files changed, 51 insertions, 16 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index eb89958..7cb45b1 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1111,8 +1111,9 @@ typedef struct Tcl_DString {
  * Types for Tcl_GetValue():
  */
 
-#define TCL_TYPE_I(type) (0x100 | (int)sizeof(type)) /* signed integer */
-#define TCL_TYPE_D(type) (0x300 | (int)sizeof(type)) /* float/double/long double */
+#define TCL_TYPE_D(type) (0x100 | (int)sizeof(type)) /* float/double/long double */
+#define TCL_TYPE_I(type) (0x200 | (int)sizeof(type)) /* signed integer */
+#define TCL_TYPE_U(type) (0x300 | (int)sizeof(type)) /* unsigned integer */
 
 /*
  *----------------------------------------------------------------------------
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 0fb6722..6ee3a51 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -268,9 +268,9 @@ const Tcl_ObjType tclByteArrayType = {
  */
 
 typedef struct ByteArray {
-    unsigned int used;		/* The number of bytes used in the byte
+    int used;			/* The number of bytes used in the byte
 				 * array. */
-    unsigned int allocated;	/* The amount of space actually allocated
+    int allocated;		/* The amount of space actually allocated
 				 * minus 1 byte. */
     unsigned char bytes[1];	/* The array of bytes. The actual size of this
 				 * field depends on the 'allocated' field
@@ -278,7 +278,7 @@ typedef struct ByteArray {
 } ByteArray;
 
 #define BYTEARRAY_SIZE(len) \
-		(TclOffset(ByteArray, bytes) + (len))
+		((unsigned) (TclOffset(ByteArray, bytes) + (len)))
 #define GET_BYTEARRAY(objPtr) \
 		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
 #define SET_BYTEARRAY(objPtr, baPtr) \
@@ -478,7 +478,11 @@ Tcl_GetByteArrayFromObj2(
     baPtr = GET_BYTEARRAY(objPtr);
 
     if (lengthPtr != NULL) {
+#if TCL_MAJOR_VERSION > 8
 	*lengthPtr = baPtr->used;
+#else
+	*lengthPtr = (unsigned)baPtr->used;
+#endif
     }
     return (unsigned char *) baPtr->bytes;
 }
@@ -521,7 +525,7 @@ Tcl_SetByteArrayLength(
     }
 
     byteArrayPtr = GET_BYTEARRAY(objPtr);
-    if ((size_t)length > byteArrayPtr->allocated) {
+    if (length > byteArrayPtr->allocated) {
 	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
 	byteArrayPtr->allocated = length;
 	SET_BYTEARRAY(objPtr, byteArrayPtr);
@@ -739,7 +743,7 @@ TclAppendBytesToByteArray(
     int len)
 {
     ByteArray *byteArrayPtr;
-    size_t needed;
+    int needed;
 
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -758,7 +762,7 @@ TclAppendBytesToByteArray(
     }
     byteArrayPtr = GET_BYTEARRAY(objPtr);
 
-    if ((size_t)len + byteArrayPtr->used > INT_MAX) {
+    if (len > INT_MAX - byteArrayPtr->used) {
 	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
     }
 
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 1cf7145..c971abf 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -4049,6 +4049,8 @@ extern const TclStubs *tclStubsPtr;
 	(sizeof(*dblPtr) == sizeof(double) ? tclStubsPtr->tcl_GetDoubleFromObj(interp, objPtr, (double *)dblPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, dblPtr, TCL_TYPE_D(*dblPtr)))
 #define Tcl_GetIntFromObj(interp, objPtr, intPtr) \
 	(sizeof(*intPtr) == sizeof(int) ? tclStubsPtr->tcl_GetIntFromObj(interp, objPtr, (int *)intPtr) : tclStubsPtr->tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_I(*intPtr)))
+#define Tcl_GetUIntFromObj(interp, objPtr, intPtr) \
+	(tclStubsPtr->tcl_GetValue(interp, objPtr, intPtr, TCL_TYPE_U(*intPtr)))
 #define Tcl_GetStringFromObj(objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tcl_GetStringFromObj2(objPtr, (size_t *)sizePtr))
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 87f7879..50de937 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1757,7 +1757,7 @@ Tcl_GetStringFromObj2(
 	}
     }
     if (lengthPtr != NULL) {
-#if TK_MAJOR_VERSION > 8
+#if TCL_MAJOR_VERSION > 8
 	*lengthPtr = objPtr->length;
 #else
 	*lengthPtr = (unsigned)objPtr->length;
@@ -2587,18 +2587,46 @@ Tcl_GetValue(
     double value;
     int result;
     if (flags == TCL_TYPE_I(int)) {
-	return Tcl_GetIntFromObj(interp, objPtr, ptr);
+	result = Tcl_GetIntFromObj(interp, objPtr, ptr);
+	if ((result == TCL_OK) && (objPtr->typePtr != &tclIntType)) {
+	    goto toolarge;
+	}
+	return result;
+    }
+    if (flags == TCL_TYPE_U(int)) {
+	result = Tcl_GetIntFromObj(interp, objPtr, ptr);
+	if ((result == TCL_OK) && (objPtr->typePtr == &tclIntType)
+		&& (objPtr->internalRep.wideValue < 0)) {
+	    goto toolarge;
+	}
+	return result;
     }
     if (flags == TCL_TYPE_I(Tcl_WideInt)) {
-	return Tcl_GetWideIntFromObj(interp, objPtr, ptr);
+	return Tcl_GetIntFromObj(interp, objPtr, ptr);
+    }
+    if (flags == TCL_TYPE_U(Tcl_WideInt)) {
+	result = Tcl_GetIntFromObj(interp, objPtr, ptr);
+	if ((result == TCL_OK) && (objPtr->internalRep.wideValue < 0)) {
+	toolarge:
+		if (interp != NULL) {
+		    const char *s = "integer value too large to represent";
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+		    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+		}
+	    return TCL_ERROR;
+	}
+	return result;
     }
     result = Tcl_GetDoubleFromObj(interp, objPtr, &value);
     if (flags == TCL_TYPE_D(double)) {
 	*(double *)ptr = value;
     } else if (flags == TCL_TYPE_D(float)) {
 	*(float *)ptr = (float) value;
-    } else {
+    } else if (flags == TCL_TYPE_D(long double)) {
 	*(long double *)ptr = (long double) value;
+    } else {
+	Tcl_Panic("%s: invalid flags value: 0x%x", "Tcl_GetValue", flags);
+	return TCL_ERROR;
     }
     return result;
 }
diff --git a/generic/tclTest.c b/generic/tclTest.c
index c49521c..d9cd9bf 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1758,7 +1758,7 @@ TestdoubledigitsObjCmd(ClientData unused,
 	|| Tcl_GetIntFromObj(interp, objv[2], &ndigits) != TCL_OK
 	|| Tcl_GetIndexFromObj(interp, objv[3], options, "conversion type",
 			       TCL_EXACT, &type) != TCL_OK) {
-	fprintf(stderr, "bad value? %Lg\n", d);
+	fprintf(stderr, "bad value? %g\n", (double)d);
 	return TCL_ERROR;
     }
     type = types[type];
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 1742eb7..eec75bd 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -263,7 +263,7 @@ ThreadObjCmd(
 		arg++;
 	    }
 	}
-	if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
+	if (Tcl_GetIntFromObj(interp, objv[arg], &id) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	arg++;
@@ -361,7 +361,7 @@ ThreadObjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "id");
 	    return TCL_ERROR;
 	}
-	if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) {
+	if (Tcl_GetIntFromObj(interp, objv[2], &id) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 
@@ -402,7 +402,7 @@ ThreadObjCmd(
 	    wait = 1;
 	    arg = 2;
 	}
-	if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
+	if (Tcl_GetIntFromObj(interp, objv[arg], &id) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	arg++;