Merge 8.7

DGP replies:

TclParseNumber() always generates and parses a string rep. This checkin prevents any
ability to benefit from objPtr->typePtr letting us know the value is an integer already --
especially important when objPtr is a pure value.

I will likely make this checkin the start of a new branch soon, or perhaps just
fork off my tip502 work into a different branch to avoid the change.

generic/tclCompCmdsGR.c

@@ -54,13 +54,21 @@ TclGetIndexFromToken(
 {
     Tcl_Obj *tmpObj = Tcl_NewObj();
     int result, idx;
+    Tcl_WideInt wide;
 
     if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj)) {
 	Tcl_DecrRefCount(tmpObj);
 	return TCL_ERROR;
     }
 
-    result = TclGetIntFromObj(NULL, tmpObj, &idx);
+    result = TclGetWideIntFromObj(NULL, tmpObj, &wide);
+    if (wide < INT_MIN) {
+	idx = INT_MIN;
+    } else if (wide > INT_MAX) {
+	idx = INT_MAX;
+    } else {
+	idx = (int) wide;
+    }
     if (result == TCL_OK) {
 	if (idx < 0) {
 	    result = TCL_ERROR;

generic/tclUtil.c

@@ -15,6 +15,7 @@
 #include "tclInt.h"
 #include "tclParse.h"
 #include "tclStringTrim.h"
+#include "tommath.h"
 #include <math.h>
 
 /*
@@ -3563,82 +3564,122 @@ TclFormatInt(
  */
 
 int
-TclGetIntForIndex(
+GetWideForIndex(
     Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
 				 * NULL, then no error message is left after
 				 * errors. */
     Tcl_Obj *objPtr,		/* Points to an object containing either "end"
 				 * or an integer. */
-    int endValue,		/* The value to be stored at "indexPtr" if
+    Tcl_WideInt endValue,	/* The value to be stored at "indexPtr" if
 				 * "objPtr" holds "end". */
-    int *indexPtr)		/* Location filled in with an integer
+    Tcl_WideInt *widePtr)	/* Location filled in with a wide integer
 				 * representing an index. */
 {
-    size_t length;
-    char *opPtr;
-    const char *bytes;
+    int length;
+    const char *opPtr;
 
-    if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
-	return TCL_OK;
+    if (TclParseNumber(NULL, objPtr, NULL, NULL, -1, NULL, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
+	if (objPtr->typePtr == &tclIntType) {
+	    *widePtr = objPtr->internalRep.wideValue;
+	    return TCL_OK;
+	} else if (objPtr->typePtr == &tclBignumType) {
+	    /* objPtr holds an integer outside the signed wide range */
+	    mp_int bigPtr;
+
+	    Tcl_GetBignumFromObj(NULL, objPtr, &bigPtr);
+	    *widePtr = mp_isneg(&bigPtr) ? LLONG_MIN : LLONG_MAX;
+	    return TCL_OK;
+	}
+
+	/* Must be a double -> not a valid index */
+	goto parseError;
     }
 
+    /* objPtr does not hold a number, check the end+/- format... */
+
     if (SetEndOffsetFromAny(NULL, objPtr) == TCL_OK) {
-	/*
-	 * If the object is already an offset from the end of the list, or can
-	 * be converted to one, use it.
-	 */
+	Tcl_WideInt offset = objPtr->internalRep.wideValue;
 
-	*indexPtr = endValue + (int)objPtr->internalRep.wideValue;
-	return TCL_OK;
-    }
-
-    bytes = TclGetString(objPtr);
-    length = objPtr->length;
-
-    /*
-     * Leading whitespace is acceptable in an index.
-     */
-
-    while (length && TclIsSpaceProc(*bytes)) {
-	bytes++;
-	length--;
-    }
-
-    if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
-	    TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
-	int code, first, second;
-	char savedOp = *opPtr;
-
-	if ((savedOp != '+') && (savedOp != '-')) {
-	    goto parseError;
-	}
-	if (TclIsSpaceProc(opPtr[1])) {
-	    goto parseError;
-	}
-	*opPtr = '\0';
-	code = Tcl_GetInt(interp, bytes, &first);
-	*opPtr = savedOp;
-	if (code == TCL_ERROR) {
-	    goto parseError;
-	}
-	if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) {
-	    goto parseError;
-	}
-	if (savedOp == '+') {
-	    *indexPtr = first + second;
+	if ((endValue ^ offset) < 0) {
+	    /* Different signs, sum cannot overflow */
+	    *widePtr = endValue + offset;
+	} else if (endValue >= 0) {
+	    if (endValue < LLONG_MAX - offset) {
+		*widePtr = endValue + offset;
+	    } else {
+		*widePtr = LLONG_MAX;
+	    }
 	} else {
-	    *indexPtr = first - second;
+	    if (endValue > LLONG_MIN - offset) {
+		*widePtr = endValue + offset;
+	    } else {
+		*widePtr = LLONG_MIN;
+	    }
 	}
 	return TCL_OK;
     }
 
-    /*
-     * Report a parse error.
-     */
+    if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1)
+	    && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length))
+	    && (length > 1)) {
+	goto parseError;
+    }
+ 
+    /* check the index arithmetic format... */
+    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr,
+	    TCL_PARSE_INTEGER_ONLY)) {
+	if (((*opPtr != '-') && (*opPtr != '+')) || objPtr->typePtr == &tclBignumType) {
+	    goto parseError;
+	}
+	if (objPtr->typePtr == &tclIntType) {
+	    Tcl_WideInt w1 = objPtr->internalRep.wideValue;
+	    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr+1, -1,
+		    NULL, TCL_PARSE_INTEGER_ONLY)) {
+		if (objPtr->typePtr == &tclBignumType) {
+		    goto parseError;
+		} else if (objPtr->typePtr == &tclIntType) {
+		    Tcl_WideInt w2 = objPtr->internalRep.wideValue;
 
+		    TclFreeIntRep(objPtr);
+		    if (*opPtr == '-') {
+			if (w2 == LLONG_MIN) {
+			    /* TODO: need bignum */
+			    goto parseError;
+			}
+			w2 = -w2;
+		    }
+
+		    if ((w1 ^ w2) < 0) {
+			*widePtr = w1 + w2;
+		    } else if (w1 >= 0) {
+			if (w1 < LLONG_MAX - w2) {
+			    *widePtr = w1 + w2;
+			} else {
+			    *widePtr = LLONG_MAX;
+			}
+		    } else {
+			if (w1 > LLONG_MIN - w2) {
+			    *widePtr = w1 + w2;
+			} else {
+			    *widePtr = LLONG_MIN;
+			}
+		    }
+		    return TCL_OK;
+		}
+		/* TODO: 2d half is bignum */
+		goto parseError;
+	    }
+	    goto parseError;
+	}
+	/* TODO: 1st half is bignum */
+	goto parseError;
+    }
+
+    /* Report a parse error. */
   parseError:
+    TclFreeIntRep(objPtr);
     if (interp != NULL) {
-	bytes = TclGetString(objPtr);
+	char * bytes = TclGetString(objPtr);
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"bad index \"%s\": must be integer?[+-]integer? or"
 		" end?[+-]integer?", bytes));
@@ -3651,6 +3692,32 @@ TclGetIntForIndex(
 
     return TCL_ERROR;
 }
+
+int
+TclGetIntForIndex(
+    Tcl_Interp *interp,		/* Interpreter to use for error reporting. If
+				 * NULL, then no error message is left after
+				 * errors. */
+    Tcl_Obj *objPtr,		/* Points to an object containing either "end"
+				 * or an integer. */
+    int endValue,		/* The value to be stored at "indexPtr" if
+				 * "objPtr" holds "end". */
+    int *indexPtr)		/* Location filled in with an integer
+				 * representing an index. */
+{
+    Tcl_WideInt wide;
+
+    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
+	return TCL_ERROR;
+    }
+    if (wide < INT_MIN) {
+	wide = INT_MIN;
+    } else if (wide > INT_MAX) {
+	wide = INT_MAX;
+    }
+    *indexPtr = (int) wide;
+    return TCL_OK;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -3687,6 +3754,15 @@ SetEndOffsetFromAny(
 	return TCL_OK;
     }
 
+    /*
+     * Multi-element lists cannot be permitted. Would confuse a single
+     * index of end[+-]$integer format with list of indices
+     */
+
+    if (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length) && (length > 1)) {
+	goto badIndexFormat;
+    }
+     
     /*
      * Check for a string rep of the right form.
      */
@@ -3694,12 +3770,7 @@ SetEndOffsetFromAny(
     bytes = TclGetStringFromObj(objPtr, &length);
     if ((*bytes != 'e') || (strncmp(bytes, "end",
 	    (size_t)((length > 3) ? 3 : length)) != 0)) {
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "bad index \"%s\": must be end?[+-]integer?", bytes));
-	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
-	}
-	return TCL_ERROR;
+	goto badIndexFormat;
     }
 
     /*
@@ -3721,12 +3792,25 @@ SetEndOffsetFromAny(
 		TCL_PARSE_INTEGER_ONLY) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr != &tclIntType) {
-		goto badIndexFormat;
+	if (objPtr->typePtr == &tclBignumType) {
+	    /* objPtr holds an integer outside the signed wide range */
+	    mp_int bigPtr;
+
+	    Tcl_GetBignumFromObj(NULL, objPtr, &bigPtr);
+	    offset = mp_isneg(&bigPtr) ? LLONG_MIN : LLONG_MAX;
+	    TclFreeIntRep(objPtr);
+	} else if (objPtr->typePtr == &tclIntType) {
+	    offset = objPtr->internalRep.wideValue;
+	} else {
+	    /* Can't happen? */
+	    goto badIndexFormat;
 	}
-	offset = objPtr->internalRep.wideValue;
 	if (bytes[3] == '-') {
-	    offset = -offset;
+	    if (offset == LLONG_MIN) {
+		offset = LLONG_MAX;
+	    } else {
+		offset = -offset;
+	    }
 	}
     } else {
 	/*
@@ -3735,6 +3819,7 @@ SetEndOffsetFromAny(
 
     badIndexFormat:
 	if (interp != NULL) {
+	    bytes = TclGetStringFromObj(objPtr, &length);
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "bad index \"%s\": must be end?[+-]integer?", bytes));
 	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);

tests/util.test

@@ -689,13 +689,13 @@ test util-9.31.1 {TclGetIntForIndex} -body {
 } -returnCodes error -match glob -result *
 test util-9.32 {TclGetIntForIndex} -body {
     string index a 0x1FFFFFFFF+0
-} -returnCodes error -match glob -result *
+} -result {}
 test util-9.33 {TclGetIntForIndex} -body {
     string index a 100000000000+0
-} -returnCodes error -match glob -result *
+} -result {}
 test util-9.33.1 {TclGetIntForIndex} -body {
     string index a 0d100000000000+0
-} -returnCodes error -match glob -result *
+} -result {}
 test util-9.34 {TclGetIntForIndex} -body {
     string index a 1.0
 } -returnCodes error -match glob -result *
@@ -728,7 +728,13 @@ test util-9.43 {TclGetIntForIndex} -body {
 } -returnCodes error -match glob -result *
 test util-9.44 {TclGetIntForIndex} -body {
     string index a 0+1000000000000
-} -returnCodes error -match glob -result *
+} -result {}
+test util-9.45 {TclGetIntForIndex} {
+    string index abcd end+2305843009213693950
+} {}
+test util-9.46 {TclGetIntForIndex} {
+    string index abcd end+4294967294
+} {}
 
 test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
     convertDouble 0x0000000000000000